~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / BAS / src / s / aofGen
1 ;
2 ; aofGen.s
3 ;
4 ; Generate AOF files from BASIC
5 ;
6 ; © 1994-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's BASIC Assembler Supplement.
12 ;
13 ; BAS is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; BAS is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with BAS. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard Header ------------------------------------------------------
28
29 GET libs:header
30 GET libs:swis
31
32 GET libs:stream
33
34 ;----- External dependencies ------------------------------------------------
35
36 GET sh.bas
37 GET sh.basTalk
38 GET sh.flex
39 GET sh.insert
40 GET sh.lit
41 GET sh.messages
42 GET sh.string
43 GET sh.workspace
44
45 ;----- Main code ------------------------------------------------------------
46
47 AREA |BAS$$Code|,CODE,READONLY
48
49 ; --- aof_init ---
50 ;
51 ; On entry: R7 == address of workspace
52 ; R8-R12 set up by BASIC
53 ;
54 ; On exit: --
55 ;
56 ; CALL syntax: asmCode%
57 ;
58 ; Use: Initialises workspace for generation of AOF code. Remembers
59 ; that code generation will start at asmCode%.
60
61 EXPORT aof_init
62 aof_init ROUT
63
64 STMFD R13!,{R0-R6,R9,R10,R12,R14}
65 STR R12,[R7,#:INDEX:be__line] ;Store line value
66 MOV R12,R7 ;Get my workspace address
67
68 LDR R14,aof__objHead ;Load the header area address
69 CMP R14,#0 ;Is it created already?
70 ADRNEL R0,msg_errInitTwice ;Yes -- point to error
71 SWINE OS_GenerateError ;And inform the user
72
73 ; --- First, save the start address ---
74
75 SUBS R10,R10,#1 ;Decrement argument counter
76 BCC bas_badCall ;If none there, complain
77 LDMIA R9!,{R0,R1} ;Load the argument types
78 BL bTalk_load ;Load value into R2
79 STR R2,aof__base ;Save this base address
80
81 ; --- Set up initial indices ---
82
83 MOV R0,#0 ;Zero some locations
84 STR R0,aof__area ;No current area either
85 STR R0,aof__pass ;Not done any passes yet
86 STR R0,aof__relocCount ;Clear the flags word
87
88 ; --- Now initialise our memory structures ---
89
90 MOV R2,#0 ;Initial space used
91 MOV R3,#256 ;Initial space allocated
92 MOV R1,#256 ;Allocate this space
93
94 ADR R0,aof__objHead ;Point to header area block
95 BL flex_alloc ;Allocate the block
96 STMCCIB R0,{R2,R3} ;Save values after it
97 ADRCC R0,aof__objReloc ;Point to relocation block
98 BLCC flex_alloc ;Allocate the block
99 STMCCIB R0,{R2,R3} ;Save values after it
100 ADRCC R0,aof__objSymT ;Point to symbol table block
101 BLCC flex_alloc ;Allocate the block
102 STMCCIB R0,{R2,R3} ;Save values after it
103 ADRCC R0,aof__objStrT ;Point to string table block
104 BLCC flex_alloc ;Allocate the block
105 STMCCIB R0,{R2,R3} ;Save values after it
106 ADRCC R0,aof__imports ;Point to import table block
107 BLCC flex_alloc ;Allocate the block
108 STMCCIB R0,{R2,R3} ;Save values after it
109 ADRCC R0,aof__noReloc ;Point to non-reloc anchor
110 BLCC flex_alloc ;Allocate the block
111 STMCCIB R0,{R2,R3} ;Save values after it
112 BCS bas_noMem ;If no memory, complain
113
114 ; --- Build the header chunk ---
115
116 LDR R0,aof__objHead ;Find the header area
117 LDR R1,=&C5E2D080 ;The really odd magic number
118 MOV R2,#150 ;Version of AOF we like
119 MOV R3,#0 ;No areas yet
120 MOV R4,#0 ;No symbols either
121 MOV R5,#0 ;No entry area yet
122 MOV R6,#0 ;No entry offset, then
123 STMIA R0,{R1-R6} ;Build most of the header
124 MOV R14,#24 ;Now used 24 bytes
125 STR R14,aof__objHead+4 ;Save this in the info
126
127 MOV R14,#4 ;Length of string table
128 LDR R0,aof__objStrT ;Find the string table
129 STR R14,[R0,#0] ;Save that in the string tbl
130 STR R14,aof__objStrT+4 ;And as the size used
131
132 BL lit_init ;Initialise Literal Manager
133
134 LDMFD R13!,{R0-R6,R9,R10,R12,PC}^
135
136 LTORG
137
138 ; --- aof_pass ---
139 ;
140 ; On entry: --
141 ;
142 ; On exit: --
143 ;
144 ; Use: Signals the start of a new assembly pass.
145
146 EXPORT aof_pass
147
148 aof_pass ROUT
149
150 STMFD R13!,{R0,R1,R12,R14} ;Save some registers
151 STR R12,[R7,#:INDEX:be__line] ;Store line value
152 MOV R12,R7 ;Find my workspace
153
154 ; --- Bump the pass counter ---
155
156 LDR R1,aof__pass ;Load the pass counter
157 ADD R1,R1,#1 ;Increment it
158 CMP R1,#2 ;Is this the second pass?
159 BLEQ lit_ltorg ;Yes -- insert lit pool
160 STR R1,aof__pass ;And store it back again
161 BNE %10aof_pass ;No -- skip ahead then
162
163 ; --- Make sure the AREA addresses are OK ---
164
165 LDR R0,aof__area ;Load the number of AREAs
166 CMP R0,#0 ;Are there any defined?
167 ADREQL R0,msg_errNoAreas ;No -- point to an error
168 SWIEQ OS_GenerateError ;And raise an error
169 LDR R14,aof__objHead ;Find the header chunk
170 LDR R14,[R14,#24+16] ;Load base of first AREA
171 CMP R14,#&FC000000 ;Is this an OK value
172 ADRNEL R0,msg_errNotInArea ;No -- point to error
173 SWINE OS_GenerateError ;And raise it
174
175 ; --- Work out end address ---
176
177 BL aof__findArea ;Look up its header info
178 LDR R14,be__percents ;Load % variable base address
179 LDR R1,[R14,#('P'-'A')*4] ;Load current location count
180 ADD R1,R1,#3 ;Word align this nicely
181 BIC R1,R1,#3 ;To keep link happy
182 STR R1,aof__limit ;Save as the code limit
183 LDR R14,[R0,#16] ;Load AREA base address
184 SUB R1,R1,R14 ;Work out the AREA's size
185 STR R1,[R0,#8] ;Store it in the block
186
187 ; --- Now set up O% and P% correctly ---
188
189 10aof_pass LDR R0,aof__base ;Load assembly base address
190 LDR R14,be__percents ;Load % variable base address
191 STR R0,[R14,#('O'-'A')*4] ;Save in correct variable
192 MOV R0,#&FC000000 ;Start assembly here (!)
193 STR R0,[R14,#('P'-'A')*4] ;Save that in P%
194
195 LDMFD R13!,{R0,R1,R12,PC}^ ;And return to caller
196
197 LTORG
198
199 ; --- aof_firstPass ---
200 ;
201 ; On entry: --
202 ;
203 ; On exit: CS if on first pass, CC otherwise
204 ;
205 ; Use: Informs the caller whether we're on the first or second pass.
206
207 EXPORT aof_firstPass
208 aof_firstPass ROUT
209
210 STMFD R13!,{R14} ;Save a register
211 LDR R14,aof__pass ;Which pass are we on?
212 CMP R14,#1 ;Is this the first one?
213 LDMFD R13!,{R14} ;Restore link register
214 ORRLES PC,R14,#C_flag ;Yes -- return CS then
215 BICGTS PC,R14,#C_flag ;No -- return CC then
216
217 LTORG
218
219 ; --- aof_ensure ---
220 ;
221 ; On entry: R0 == address of anchor and size info
222 ; R1 == free space required
223 ;
224 ; On exit: R0 == address of first free byte in area
225 ;
226 ; Use: Ensures that there is the requested quantity of memory free
227 ; in the given block. If not, bas_noMem is called.
228
229 EXPORT aof_ensure
230 aof_ensure ROUT
231
232 STMFD R13!,{R1,R2,R14} ;Save some registers
233 LDMIB R0,{R2,R14} ;Load used and size words
234 ADD R1,R1,R2 ;Find new total size
235 STR R1,[R0,#4] ;Save this back
236 ADD R1,R1,#255 ;Align up to next 256
237 BIC R1,R1,#255 ;For niceness's sake
238 CMP R1,R14 ;Do we already have enough?
239 BHI %50aof_ensure ;No -- allocate some more
240 10aof_ensure STR R1,[R0,#8] ;Save new total size
241 LDR R0,[R0,#0] ;Load address of block
242 ADD R0,R0,R2 ;Point to first free byte
243 LDMFD R13!,{R1,R2,PC}^ ;And return to caller
244
245 50aof_ensure BL flex_extend ;No -- then extend the block
246 BCS bas_noMem ;If we couldn't, we die
247 B %10aof_ensure ;Rejoin the main program
248
249 LTORG
250
251 ; --- aof__addString ---
252 ;
253 ; On entry: R0 == pointer to string to add
254 ;
255 ; On exit: R0 == offset of string in string table
256 ;
257 ; Use: Adds a string to the string table chunk and returns its
258 ; offset.
259
260 aof__addString ROUT
261
262 STMFD R13!,{R1,R2,R14} ;Save some registers
263 LDR R2,aof__objStrT+4 ;Load free offset
264 FSAVE R0 ;Save the string address
265 BL str_len ;Find the string length
266 ADD R1,R0,#1 ;Remember the terminator
267 ADR R0,aof__objStrT ;Point to string table anchor
268 BL aof_ensure ;Make sure there's enough
269 FLOAD R1 ;Load the source string
270 BL str_cpy ;Copy string into area
271 MOV R0,R2 ;Return offset in R0
272 LDMFD R13!,{R1,R2,PC}^ ;Return to caller
273
274 LTORG
275
276 ; --- aof_area ---
277 ;
278 ; On entry: R0 == AREA attributes word
279 ; R7 == address of workspace
280 ; R8-R12 set up by BASIC
281 ;
282 ; On exit: --
283 ;
284 ; CALL syntax: name$
285 ;
286 ; Use: Makes a new AREA start at the current location.
287
288 EXPORT aof_area
289 aof_area ROUT
290
291 STMFD R13!,{R0-R6,R9,R10,R12,R14}
292 BL insert_align ;Word align current position
293 BL lit_ltorg ;Insert a literal pool
294 STR R12,[R7,#:INDEX:be__line] ;Store line value
295 MOV R12,R7 ;Find workspace address
296 BL aof_firstPass ;Which pass am I on?
297 BCC %90aof_area ;If not the first, quit now
298
299 ; --- Insert new AREA block in header ---
300
301 MOV R3,R0 ;Keep the AREA attributes
302 BL str_buffer ;Find a string buffer
303 BL bas_argString ;Read the AREA's name
304 MOV R0,R1 ;Point to the string
305 BL aof__addString ;Put it in the string table
306 MOV R2,R0 ;Keep the string offset
307
308 ADR R0,aof__objHead ;Find the header chunk
309 MOV R1,#20 ;Want 20 bytes of data
310 BL aof_ensure ;Make sure it's there
311
312 MOV R4,#0 ;Don't know the size yet
313 MOV R5,#0 ;Don't know about relocations
314 LDR R14,be__percents ;Find the % variables
315 LDR R6,[R14,#('P'-'A')*4] ;Load current loc counter
316 STMIA R0,{R2-R6} ;Save this in the header
317
318 ; --- Now try to fix up old AREA ---
319
320 LDR R14,aof__area ;Which area are we on?
321 CMP R14,#0 ;Is this the dummy area?
322 LDRNE R5,[R0,#-4] ;No -- load old start pos
323 SUBNE R5,R6,R5 ;Get the AREA's size
324 STRNE R5,[R0,#-12] ;Save the AREA's size
325
326 ADD R14,R14,#1 ;Increment AREA count
327 STR R14,aof__area ;And save that back
328
329 LDR R14,aof__relocCount ;Load current flags
330 CMP R14,#0 ;Is relocation enabled?
331 BEQ %90aof_area ;Relocation enabled -- skip
332 MOV R14,#0 ;Clear the counter nicely
333 STR R14,aof__relocCount ;Save counter back again
334
335 ; --- If noReloc is at current address, remove it ---
336
337 LDR R2,be__percents ;Find the % variables
338 LDR R2,[R2,#('O'-'A')*4] ;Load current address
339 ADR R0,aof__noReloc ;Find noreloc table
340 LDMIA R0,{R0,R1} ;Load the size and base
341 SUB R1,R1,#4 ;Find the end value
342 LDR R14,[R0,R1] ;Load the value out
343 CMP R14,R2 ;Is this a match?
344 STREQ R1,aof__noReloc+4 ;Yes -- chop one off size
345
346 90aof_area LDMFD R13!,{R0-R6,R9,R10,R12,PC}^
347
348 LTORG
349
350 ; --- aof_entry ---
351 ;
352 ; On entry: --
353 ;
354 ; On exit: --
355 ;
356 ; Use: Sets the image entry point to be the current location.
357
358 EXPORT aof_entry
359 aof_entry ROUT
360
361 STMFD R13!,{R0-R2,R12,R14} ;Save some registers
362 STR R12,[R7,#:INDEX:be__line] ;Store line value
363 MOV R12,R7 ;Find my workspace address
364 BL insert_align ;Word align current pos
365 BL aof_firstPass ;Is this the first pass?
366 BCC %90aof_entry ;No -- then do nothing
367
368 ; --- Make sure we have an AREA ---
369
370 LDR R14,aof__area ;Find the current AREA
371 CMP R14,#0 ;Is this sensible?
372 ADREQL R0,msg_errNoArea ;No -- then point to error
373 SWIEQ OS_GenerateError ;And report an error
374
375 ; --- Set up the entry AREA number ---
376
377 LDR R0,aof__objHead ;Find the header chunk
378 LDR R1,[R0,#16] ;Load current entry area
379 CMP R1,#0 ;Is this defined yet?
380 ADRNEL R0,msg_errMultiEntry ;Yes -- point to error
381 SWINE OS_GenerateError ;And report an error
382 STR R14,[R0,#16] ;Save our AREA number
383
384 ; --- Work out the entry offset ---
385
386 ADD R14,R14,R14,LSL #2 ;Multiply index by 5
387 MOV R14,R14,LSL #2 ;Multiply index by 4 (x20)
388 ADD R14,R14,#20 ;Get offset of AREA start
389 LDR R1,[R0,R14] ;Load AREA start address
390 LDR R2,be__percents ;Find the % variables
391 LDR R2,[R2,#('P'-'A')*4] ;Get current location ptr
392 SUB R1,R1,R2 ;Get offset into AREA
393 STR R1,[R0,#20] ;Save the entry offset
394
395 90aof_entry LDMFD R13!,{R0-R2,R12,PC}^ ;Return to caller
396
397 LTORG
398
399 ; --- aof_import ---
400 ;
401 ; On entry: R0 == pointer to variable name
402 ; R1 == pointer to symbol name
403 ; R3 == attribute bits (not including bits 0,1)
404 ;
405 ; On exit: --
406 ;
407 ; Use: Imports a symbol, and sets the given variable to point to
408 ; it. If the symbol is already imported, another alias is
409 ; set up, but no actual symbol is created.
410
411 EXPORT aof_import
412 aof_import ROUT
413
414 STMFD R13!,{R0-R6,R14} ;Save some registers
415 FSAVE R0 ;Save pointer to alias
416
417 ; --- See if it's already been IMPORTed ---
418
419 ADR R2,aof__imports ;Find the symbol table
420 LDMIA R2,{R2,R5} ;Load address and size
421 ADD R5,R2,R5 ;Find limit address
422 LDR R4,aof__objStrT ;And find the string table
423 LDR R6,aof__objSymT ;And the symbol table
424
425 00aof_import CMP R2,R5 ;Reached the end yet?
426 BCS %10aof_import ;Yes -- carry on then
427 LDR R0,[R2],#4 ;Load the symbol index
428 LDR R0,[R6,R0] ;Load the name offset
429 ADD R0,R4,R0 ;Find the string address
430 BL str_cmp ;Does the string match?
431 BNE %00aof_import ;No -- ignore it then
432
433 ; --- Found a match -- use this symbol then ---
434
435 LDR R14,aof__imports ;Find the base of the table
436 SUB R2,R2,R14 ;Turn address into offset
437 B %20aof_import ;Rejoin the main routine
438
439 ; --- Couldn't find the symbol -- create it then ---
440
441 10aof_import MOV R0,R1 ;Point to the symbol name
442 BL aof__addString ;Put it in the string table
443 MOV R2,R0 ;Remember string's offset
444 ADR R0,aof__objSymT ;Point to symbol table
445 MOV R1,#16 ;Size of a symbol
446 BL aof_ensure ;Make that amount of space
447
448 ORR R3,R3,#2 ;Get the symbol attributes
449 MOV R4,#0 ;Symbol has no sensible value
450 MOV R5,#0 ;Symbol has no area name
451 STMIA R0,{R2-R5} ;Save symbol definition
452
453 ; --- Now set up the imports table ---
454
455 SUB R2,R0,R6 ;Get the symbol table offset
456 ADR R0,aof__imports ;Point to imports table
457 MOV R1,#4 ;Entries are 4 bytes each
458 BL aof_ensure ;Get the memory I want
459 STR R2,[R0],#4 ;Save the symbol index
460
461 ; --- Work out the import entry offset ---
462
463 LDR R2,aof__imports ;Find the imports table base
464 SUB R2,R0,R2 ;Find the table offset
465
466 ; --- Write this into the variable ---
467
468 20aof_import RSB R2,R2,#&FD000000 ;Work out the dummy value
469 FLOAD R0 ;Get variable name back
470 BL bTalk_create ;Create the variable
471 BL bTalk_store ;Save the value in it
472
473 LDMFD R13!,{R0-R6,PC}^ ;Return to caller
474
475 LTORG
476
477 ; --- aof_iImport ---
478 ;
479 ; On entry: R0 == WEAK flag
480 ; R7 == address of workspace
481 ; R8-R12 set up by BASIC
482 ;
483 ; On exit: --
484 ;
485 ; CALL syntax: name$,alias$
486 ;
487 ; Use: Imports a symbol name$, and makes the variable whose name
488 ; is in alias$ refer to it.
489
490 EXPORT aof_iImport
491 aof_iImport ROUT
492
493 STMFD R13!,{R0,R1,R9,R10,R12,R14}
494 STR R12,[R7,#:INDEX:be__line] ;Store line value
495 MOV R12,R7 ;Get my workspace address
496 BL aof_firstPass ;Is this the first pass?
497 BCC %90aof_iImport ;No -- ignore it then
498
499 MOV R3,R0,LSL #4 ;Set up WEAK bit
500 BL str_buffer ;Find a string buffer
501 BL bas_argString ;Read variable name string
502 MOV R0,R1 ;Pass this in R0
503 BL str_buffer ;Find another string buffer
504 BL bas_argString ;Read symbol name string
505 BL aof_import ;Import this symbol
506
507 90aof_iImport LDMFD R13!,{R0,R1,R9,R10,R12,PC}^
508
509 LTORG
510
511 ; --- aof__findArea ---
512 ;
513 ; On entry: R0 == index of AREA
514 ;
515 ; On exit: R0 == pointer to AREA description in header chunk
516 ;
517 ; Use: Locates a given AREA's data.
518
519 aof__findArea ROUT
520
521 STMFD R13!,{R14} ;Save a register
522 LDR R14,aof__objHead ;Find the header chunk
523 ADD R0,R0,R0,LSL #2 ;Multiply index by 5
524 ADD R0,R14,R0,LSL #2 ;And again by 4 (x20)
525 ADD R0,R0,#4 ;Add on a bit to find block
526 LDMFD R13!,{PC}^ ;Return to caller
527
528 LTORG
529
530 ; --- aof__findSym ---
531 ;
532 ; On entry: R0 == symbol value
533 ;
534 ; On exit: CS if symbol recognised, and
535 ; VS if symbol is external reference, and
536 ; R0 == index of symbol in symbol table
537 ; R1 corrupted
538 ; else VC if symbol is internal reference, and
539 ; R0 == offset of symbol within AREA
540 ; R1 == AREA index
541 ; else CC if symbol is absolute (i.e. not recognised) and
542 ; R0 preserved
543 ; R1 corrupted
544 ;
545 ; Use: Looks up a 32-bit value and tries to interpret it as a
546 ; symbol, returning information about it as required. This
547 ; routine attempts to be as quick as it can, but it can't
548 ; promise anything.
549
550 aof__findSym ROUT
551
552 ; --- Make sure it can be anything other than absolute ---
553
554 MOV R1,R0,LSR #24 ;Get the top byte
555 CMP R1,#&FC ;Is this our magic range?
556 BICNES PC,R14,#C_flag ;No -- clear C and exit
557
558 ; --- See if it's an external symbol ---
559
560 LDR R1,aof__objSymT+4 ;Get size of symbol table
561 RSB R1,R1,#&FD000000 ;Work out lowest import addr
562 CMP R0,R1 ;Is this an imported symbol?
563 BCS %50aof__findSym ;Yes -- find symbol index
564
565 ; --- See if it's an internal reference ---
566
567 LDR R1,aof__limit ;Load the limit address
568 CMP R0,R1 ;Is this within the code?
569 BICCSS PC,R14,#C_flag ;No -- then ignore it
570
571 ; --- Work out which AREA it's in ---
572
573 BIC R14,R14,#V_flag ;Clear V for internal ref
574 ORR R14,R14,#C_flag ;Set C for symbol match
575 STMFD R13!,{R2,R14} ;Save some registers
576 SUB R0,R0,#&FC000000 ;Get the symbol's offset
577 MOV R1,#1 ;Start at index 1
578 LDR R2,aof__objHead ;Find the header chunk
579 ADD R2,R2,#24 ;Find first AREA block
580 10aof__findSym LDR R14,[R2,#8] ;Load the AREA's size
581 CMP R0,R14 ;Is this within the AREA?
582 LDMCCFD R13!,{R2,PC}^ ;Yes -- then return it
583 SUB R0,R0,R14 ;Move into next AREA
584 ADD R1,R1,#1 ;Increment AREA index
585 ADD R2,R2,#20 ;Move to next AREA block
586 B %10aof__findSym ;And loop back round again
587
588 ; --- Find the appropriate symbol ---
589
590 50aof__findSym RSB R0,R0,#&FD000000 ;Find the import table index
591 LDR R1,aof__imports ;Find the import table
592 SUB R0,R0,#4 ;Compensate for strangeness
593 LDR R0,[R1,R0] ;Load the symbol index
594 MOV R0,R0,LSR #4 ;And divide by symbol size
595 ORRS PC,R14,#C_flag + V_flag ;Return, setting C and V
596
597 LTORG
598
599 ; --- aof_export ---
600 ;
601 ; On entry: R0 == STRONG flag
602 ; R7 == pointer to workspace
603 ; R8-R12 as set up by BASIC
604 ;
605 ; On exit: --
606 ;
607 ; CALL syntax: alias$,name$
608 ;
609 ; Use: Exports the value held in the given alias as the symbol
610 ; name$.
611
612 EXPORT aof_export
613 aof_export ROUT
614
615 STMFD R13!,{R0-R6,R9,R10,R12,R14}
616 STR R12,[R7,#:INDEX:be__line] ;Store line value
617 MOV R12,R7 ;Find my workspace address
618 BL aof_firstPass ;Is this the first pass?
619 BCS %90aof_export ;Yes -- may not be set up
620 MOV R3,R0,LSL #5 ;Keep the STRONG flag safe
621
622 ; --- Put the symbol name in the string table ---
623
624 BL str_buffer ;Get a string buffer
625 BL bas_argString ;Read the symbol name out
626 MOV R0,R1 ;Point to the symbol name
627 BL aof__addString ;Put it in the string table
628 MOV R4,R0 ;Remember this offset
629
630 ; --- Now find the symbol value ---
631
632 BL str_buffer ;Get a string buffer
633 BL bas_argString ;Read the string's value
634 MOV R0,R1 ;Point to the string
635 BL bTalk_lvblnk ;Find the lvalue
636 BL bTalk_load ;And load its value
637
638 ; --- Create a block for the symbol ---
639
640 ADR R0,aof__objSymT ;Point to the symbol table
641 MOV R1,#16 ;Make space for a symbol
642 BL aof_ensure ;Make sure there's space
643 MOV R6,R0 ;Remember this address
644
645 ; --- Now build the symbol ---
646
647 MOV R0,R2 ;Get the symbol value
648 BL aof__findSym ;Work out its meaning
649 BCC %20aof_export ;If it's absolute, skip on
650 ADRVSL R0,msg_errExpImported ;If imported, say it's silly
651 SWIVS OS_GenerateError ;And complain to the user
652
653 ; --- Create a program-relative symbol ---
654
655 MOV R2,R4 ;Get the symbol name offset
656 ORR R3,R3,#3 ;Get the symbol attributes
657 MOV R4,R0 ;Get the symbol offset
658 MOV R0,R1 ;Put AREA index in R0
659 BL aof__findArea ;Find the AREA data
660 LDR R5,[R0,#0] ;Get the AREA's name offset
661 STMIA R6,{R2-R5} ;Save the symbol info
662 B %90aof_export ;Return to caller
663
664 ; --- Create an absolute symbol ---
665
666 20aof_export MOV R2,R4 ;Get the symbol name offset
667 ORR R3,R3,#&07 ;Get the symbol attributes
668 MOV R4,R0 ;Get the symbol value
669 MOV R5,#0 ;Say that the AREA is 0
670 STMIA R6,{R2-R5} ;Save the symbol info
671
672 90aof_export LDMFD R13!,{R0-R6,R9,R10,R12,PC}^
673
674 LTORG
675
676 ; --- aof_reloc ---
677 ;
678 ; On entry: R7 == workspace address
679 ;
680 ; On exit: --
681 ;
682 ; Use: Marks the current address as being the start of a relocation
683 ; block. If a relocation block is current, this is a no-op.
684
685 EXPORT aof_reloc
686 aof_reloc ROUT
687
688 STMFD R13!,{R0-R2,R12,R14} ;Save some registers
689 STR R12,[R7,#:INDEX:be__line] ;Store line value
690 MOV R12,R7 ;Find my workspace pointer
691 BL insert_align ;Word align current pos
692
693 ; --- Only accept reloc/noReloc directives on first pass ---
694
695 BL aof_firstPass ;Is this the first pass?
696 LDMCCFD R13!,{R0-R2,R12,PC}^ ;No -- do nothing then
697
698 ; --- Check that we're alternating states ---
699
700 LDR R14,aof__relocCount ;Load current counter
701 SUBS R14,R14,#1 ;Decrement counter
702 STRGE R14,aof__relocCount ;If was >0, store it
703 LDMNEFD R13!,{R0-R2,R12,PC}^ ;If state still same, return
704
705 ; --- Check we need to do this ---
706 ;
707 ; If the last entry is at the current address, we remove it
708 ; and return.
709
710 LDR R2,be__percents ;Load the percents table
711 LDR R2,[R2,#('O'-'A')*4] ;Load current real address
712 ADR R0,aof__noReloc ;Point to noReloc table
713 LDMIA R0,{R1,R14} ;Load size and address
714 SUBS R14,R14,#4 ;Find previous entry
715 BLT %10aof_reloc ;If none defined, skip on
716 LDR R1,[R1,R14] ;Load the value out
717 CMP R1,R2 ;Do the entries match?
718 STREQ R14,aof__noReloc+4 ;Yes -- decrement used size
719 LDMEQFD R13!,{R0-R2,R12,PC}^ ;And return to caller
720
721 ; --- Add in the item ---
722
723 10aof_reloc MOV R1,#4 ;Entries are 4 bytes each
724 BL aof_ensure ;Extend the table
725 STR R2,[R0],#4 ;Save this in the table
726
727 LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller
728
729 LTORG
730
731 ; --- aof_noReloc ---
732 ;
733 ; On entry: R7 == workspace address
734 ;
735 ; On exit: --
736 ;
737 ; Use: Marks the current address as being the start of a non-
738 ; relocation block. If a non-relocation block is current,
739 ; this is a no-op.
740
741 EXPORT aof_noReloc
742 aof_noReloc ROUT
743
744 STMFD R13!,{R0-R2,R12,R14} ;Save some registers
745 STR R12,[R7,#:INDEX:be__line] ;Store line value
746 MOV R12,R7 ;Find my workspace pointer
747 BL insert_align ;Word align current pos
748
749 ; --- Only accept reloc/noReloc directives on first pass ---
750
751 BL aof_firstPass ;Is this the first pass?
752 LDMCCFD R13!,{R0-R2,R12,PC}^ ;No -- do nothing then
753
754 ; --- Check that we're alternating states ---
755
756 LDR R14,aof__relocCount ;Load current counter value
757 ADD R14,R14,#1 ;Increment the value
758 STR R14,aof__relocCount ;Save value back again
759 CMP R14,#1 ;Was relocation enabled?
760 LDMNEFD R13!,{R0-R2,R12,PC}^ ;No -- return to caller
761
762 ; --- Check we need to do this ---
763 ;
764 ; If the last entry is at the current address, we remove it
765 ; and return.
766
767 LDR R2,be__percents ;Load the percents table
768 LDR R2,[R2,#('O'-'A')*4] ;Load current real address
769 ADR R0,aof__noReloc ;Point to noReloc table
770 LDMIA R0,{R1,R14} ;Load size and address
771 SUBS R14,R14,#4 ;Find previous entry
772 BLT %10aof_noReloc ;If none defined, skip on
773 LDR R1,[R1,R14] ;Load the value out
774 CMP R1,R2 ;Do the entries match?
775 STREQ R14,aof__noReloc+4 ;Yes -- decrement used size
776 LDMEQFD R13!,{R0-R2,R12,PC}^ ;And return to caller
777
778 ; --- Add in the item ---
779
780 10aof_noReloc MOV R1,#4 ;Entries are 4 bytes each
781 BL aof_ensure ;Extend the table
782 STR R2,[R0],#4 ;Save this in the table
783
784 LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller
785
786 LTORG
787
788 ; --- aof_save ---
789 ;
790 ; On entry: R7 == workspace address
791 ; R8-R12 set up by BASIC
792 ;
793 ; On exit: --
794 ;
795 ; CALL syntax: file$
796 ;
797 ; Use: Saves the current AOF file. It also resets all the AOF
798 ; state, so that another AOF file can be built subsequently.
799
800 EXPORT aof_save
801 aof_save ROUT
802
803 STMFD R13!,{R0-R12,R14} ;Save loads of registers
804 STR R12,[R7,#:INDEX:be__line] ;Store line value
805 MOV R12,R7 ;Find my workspace pointer
806
807 BL aof_firstPass ;Is this the first pass?
808 ADRCSL R0,msg_errNotDone ;Yes -- point to error
809 SWICS OS_GenerateError ;And make an error
810
811 BL lit_end ;Turn off the literal system
812
813 ADR R0,aof__noReloc ;Point to noReloc table
814 MOV R1,#4 ;Entries are 4 bytes each
815 BL aof_ensure ;Extend the table
816 MOV R14,#-1 ;Add a terminator
817 STR R14,[R0],#4 ;Save this in the table
818
819 MOV R0,#0 ;Zero NOINIT size count
820 STMFD R13!,{R0,R9,R10} ;Save argument pointers
821
822 ; --- Build relocation directives ---
823 ;
824 ; Also fix up relocation counts for area defs
825
826 MOV R11,#1 ;Current AREA number
827 LDR R10,aof__objHead ;Find the header chunk
828 ADD R10,R10,#24 ;Point to first AREA info
829 LDR R9,aof__area ;Load the number of AREAs
830 LDR R8,aof__base ;Find the code base address
831 LDR R4,aof__noReloc ;Find non-relocation block
832 LDR R3,[R4],#4 ;Load next value out
833
834 05aof_save SUBS R9,R9,#1 ;Decrement the AREA counter
835 BCC %20aof_save ;If all done, skip onwards
836 STMFD R13!,{R9} ;Save AREA counter
837 MOV R9,R3 ;Look after next reloc value
838 MOV R7,#0 ;No relocations created yet
839 LDR R6,[R10,#8] ;Load the AREA size
840 MOV R5,#-4 ;Start at offset 0
841
842 LDR R14,[R10,#4] ;Load AREA attributes
843 TST R14,#&1000 ;Is it NOINITed?
844 BEQ %10aof_save ;No -- deal with normally
845
846 LDR R14,[R13,#4] ;Load current NOINIT size
847 ADD R14,R14,R6 ;Add on size of this AREA
848 STR R14,[R13,#4] ;Save new size back again
849 ADD R8,R8,R6 ;Move pointer past AREA
850 B %19aof_save ;And skip out relocations
851
852 ; --- Scan an AREA for relocations ---
853
854 07aof_save ADD R6,R6,#4 ;Decremented down below
855 CMP R8,R9 ;Is this in reloc block?
856 LDRCS R9,[R4],#4 ;Yes -- load next value
857 BCS %10aof_save ;And relocate data nicely
858
859 ADD R14,R8,R6 ;Find end of AREA
860 CMP R14,R9 ;Any data to relocate?
861 ADDCC R8,R8,R6 ;No -- skip on to AREA end
862 BCC %19aof_save ;And move to next AREA
863
864 SUB R14,R9,R8 ;Find out how much to skip
865 ADD R8,R8,R14 ;Move on AREA address
866 ADD R5,R5,R14 ;And move on the offset
867 SUB R6,R6,R14 ;And decrement AREA size
868 LDR R9,[R4],#4 ;Load next reloc value
869
870 10aof_save SUBS R6,R6,#4 ;Decrement AREA size
871 BCC %19aof_save ;If all done, move to next
872
873 CMP R8,R9 ;Is this in non-reloc block?
874 LDRCS R9,[R4],#4 ;Yes -- load next value
875 BCS %07aof_save ;And skip on until reloc
876
877 LDR R0,[R8],#4 ;Load the next word out
878 ADD R5,R5,#4 ;Bump current offset
879
880 AND R14,R0,#&0E000000 ;Get opcode field
881 CMP R14,#&0A000000 ;Is it a branch or BL?
882 BEQ %15aof_save ;Yes -- handle this then
883
884 BL aof__findSym ;Try and interpret the value
885 BCC %10aof_save ;If no match, ignore it
886 BVS %13aof_save ;If symbol relocation, skip
887
888 ; --- Build an internal additive relocation ---
889
890 STR R0,[R8,#-4] ;Save offset back into code
891 SUB R3,R1,#1 ;And the AREA index
892 ADR R0,aof__objReloc ;Point to relocation chunk
893 MOV R1,#8 ;Need 8 bytes for relocation
894 BL aof_ensure ;Make sure there's enough
895 ORR R14,R3,#&82000000 ;Set up relocation info
896 STMIA R0,{R5,R14} ;Make the directive
897 ADD R7,R7,#1 ;Bump the relocation count
898 B %10aof_save ;Go back round for more
899
900 ; --- Build a symbol additive relocation ---
901
902 13aof_save MOV R14,#0 ;Make word reference symbol
903 STR R14,[R8,#-4] ;By zeroing the word
904 MOV R3,R0 ;Look after symbol index
905 ADR R0,aof__objReloc ;Point to relocation chunk
906 MOV R1,#8 ;Need 8 bytes for relocation
907 BL aof_ensure ;Make sure there's enough
908 ORR R14,R3,#&000A0000 ;Set up relocation info
909 STMIA R0,{R5,R14} ;Make the directive
910 ADD R7,R7,#1 ;Bump the relocation count
911 B %10aof_save ;Go back round for more
912
913 ; --- Handle a B or BL instruction ---
914
915 15aof_save AND R2,R0,#&FF000000 ;Get condition and type
916 BIC R0,R0,#&FF000000 ;Get branch offset value
917 ADD R0,R0,#2 ;Add on the required offset
918 LDR R3,[R10,#16] ;Load the AREA base address
919 ADD R3,R3,R5 ;Add on current offset
920 ADD R0,R3,R0,LSL #2 ;Work out branch destination
921 BL aof__findSym ;Look up the symbol type
922 BCC %10aof_save ;It's absolute -- ignore it
923 BVS %17aof_save ;It's symbol relative -- skip
924
925 ; --- Handle an internal PCRelative relocation ---
926
927 CMP R1,R11 ;Is it to this AREA?
928 BEQ %10aof_save ;Yes -- don't bother then
929
930 SUB R0,R0,R3 ;Work out the branch offset
931 MOV R0,R0,LSR #2 ;Shift it right by 2 nicely
932 SUB R0,R0,#2 ;And account for pipeline
933 BIC R0,R0,#&FF000000 ;Clear the top bits
934 ORR R0,R0,R2 ;And put in old opcode bits
935 STR R0,[R8,#-4] ;Write this instruction back
936 SUB R3,R1,#1 ;Look after AREA index
937 ADR R0,aof__objReloc ;Point to relocation chunk
938 MOV R1,#8 ;Need 8 bytes for relocation
939 BL aof_ensure ;Make sure there's enough
940 ORR R14,R3,#&86000000 ;Set up relocation flags
941 STMIA R0,{R5,R14} ;Save relocation directive
942 ADD R7,R7,#1 ;Bump the relocation count
943 B %10aof_save ;And try the next word
944
945 ; --- Handle a symbol PCRelative relocation ---
946
947 17aof_save STR R2,[R8,#-4] ;B/BL all bits zero
948 MOV R3,R0 ;Keep the symbol index
949 ADR R0,aof__objReloc ;Point to relocation chunk
950 MOV R1,#8 ;Need 8 bytes for relocation
951 BL aof_ensure ;Make sure there's enough
952 ORR R14,R3,#&000E0000 ;Set up relocation flags
953 STMIA R0,{R5,R14} ;Save relocation directive
954 ADD R7,R7,#1 ;Bump the relocation count
955 B %10aof_save ;And try the next word
956
957 ; --- Reached end of the AREA ---
958
959 19aof_save STR R7,[R10,#12] ;Save the relocation count
960 MOV R14,#0 ;A zero word
961 STR R14,[R10,#16] ;Write over reserved word
962 ADD R10,R10,#20 ;Move to next AREA block
963 ADD R11,R11,#1 ;Increment the AREA counter
964 MOV R3,R9 ;Look after noReloc address
965 LDMFD R13!,{R9} ;Load the AREA countdown
966 B %05aof_save ;And branch back for the rest
967
968 ; --- Work out chunk file header format ---
969 ;
970 ; Pointless comment for separation, 'cos Tim said so.
971
972 20aof_save LDMFD R13!,{R4} ;Load NOINIT size
973 SUB R13,R13,#5*4*4 + 3*4 ;Allocate space from stack
974 MOV R14,R13 ;Point to base of this area
975
976 LDR R0,=&C3CBC6C5 ;Strange magic guard word
977 MOV R1,#5 ;We have 5 chunks
978 MOV R2,#5 ;We will always have 5 chunks
979 STMIA R14!,{R0-R2} ;Save this away
980
981 LDR R0,aof__objName ;Load string `OBJ_'
982 MOV R2,#5*4*4 + 3*4 ;Where the chunks start
983
984 ; --- Set up the OBJ_IDFN entry ---
985
986 LDR R1,aof__idfnName ;Load string `IDFN'
987 MOV R3,# ? aof__objIdfn ;Find length of identifier
988 STMIA R14!,{R0-R3} ;Save chunk information
989 ADD R2,R2,R3 ;Work out next offset
990 ADD R2,R2,#3 ;Size may not be word aligned
991 BIC R2,R2,#3 ;It is now
992
993 ; --- Set up the OBJ_HEAD entry ---
994
995 LDR R1,aof__headName ;Load string `HEAD'
996 LDR R3,aof__objHead+4 ;Point to header anchor
997 STMIA R14!,{R0-R3} ;Save chunk information
998 ADD R2,R2,R3 ;Work out next offset
999
1000 ; --- Set up the OBJ_AREA entry ---
1001
1002 LDR R1,aof__areaName ;Load string `AREA'
1003 LDR R3,aof__objReloc+4 ;Load size of reloc block
1004 SUB R3,R3,R4 ;Subtract NOINIT size
1005 LDR R4,aof__limit ;Load end of code
1006 BIC R4,R4,#&FF000000 ;Mask off strange marker bits
1007 ADD R3,R3,R4 ;And work out chunk size
1008
1009 STMIA R14!,{R0-R3} ;Save chunk information
1010 ADD R2,R2,R3 ;Work out next offset
1011
1012 ; --- Set up the OBJ_SYMT entry ---
1013
1014 LDR R1,aof__symTName ;Load string `SYMT'
1015 LDR R3,aof__objSymT+4 ;Point to table anchor
1016 STMIA R14!,{R0-R3} ;Save chunk information
1017 ADD R2,R2,R3 ;Work out next offset
1018
1019 ; --- Set up the OBJ_STRT entry ---
1020
1021 LDR R1,aof__strTName ;Load string `STRT'
1022 LDR R3,aof__objStrT+4 ;Point to table anchor
1023 STMIA R14!,{R0-R3} ;Save chunk information
1024 ADD R2,R2,R3 ;Work out next offset
1025 ADD R2,R2,#3 ;Size may not be word aligned
1026 BIC R2,R2,#3 ;It is now
1027
1028 ; --- Open the output file ---
1029
1030 LDMIA R14,{R9,R10} ;Load BASIC's arguments
1031 BL str_buffer ;Find a string buffer
1032 BL bas_argString ;Copy the name string here
1033 MOV R10,R1 ;Look after name pointer
1034 MOV R0,#&8C ;Make lots of errors
1035 SWI OS_Find ;Open the file
1036 MOV R11,R0 ;Look after the file handle
1037
1038 ; --- Write individual chunks to output file ---
1039
1040 MOV R0,#2 ;Write bytes to file
1041 MOV R1,R11 ;Get the file handle
1042 MOV R2,R13 ;Point to header block
1043 MOV R3,#5*4*4 + 3*4 ;Size of the header block
1044 SWI XOS_GBPB ;Write that out to the file
1045 BVS %90aof_save ;If that failed, tidy up
1046
1047 ADR R2,aof__objIdfn ;Point to identification str
1048 MOV R3,# ? aof__objIdfn ;And read the length of it
1049 ADD R3,R3,#3 ;Word align this size
1050 BIC R3,R3,#3 ;To keep everything nice
1051 SWI XOS_GBPB ;Write that out to the file
1052 BVS %90aof_save ;If that failed, tidy up
1053
1054 ; --- Set up the header and write it ---
1055
1056 ADR R2,aof__objHead ;Point to header chunk data
1057 LDMIA R2,{R2,R3} ;Load address and size
1058 LDR R14,aof__area ;Get the number of AREAs
1059 STR R14,[R2,#8] ;Save this in the header
1060 LDR R14,aof__objSymT+4 ;Load symbol table size
1061 MOV R14,R14,LSR #4 ;Divide by symbol block size
1062 STR R14,[R2,#12] ;Save this in the header
1063 SWI XOS_GBPB ;Write that out to the file
1064 BVS %90aof_save ;If that failed, tidy up
1065
1066 ; --- Write the AREA chunk (yuk) ---
1067
1068 LDR R5,aof__base ;Find AREA data base address
1069 LDR R6,aof__objHead ;Find the header chunk
1070 ADD R6,R6,#24 ;Find the first AREA block
1071 LDR R7,aof__objReloc ;Find the relocation chunk
1072 LDR R8,aof__area ;Get the AREAs counter
1073
1074 50aof_save SUBS R8,R8,#1 ;Decrement AREA counter
1075 BCC %60aof_save ;If all done, skip onwards
1076
1077 LDR R14,[R6,#4] ;Load AREA attributes
1078
1079 MOV R2,R5 ;Point to AREA base
1080 LDR R3,[R6,#8] ;Load AREA size
1081 ADD R5,R5,R3 ;Move on the AREA pointer
1082 TST R14,#&1000 ;Should we include the data?
1083 SWIEQ XOS_GBPB ;Write bytes to file
1084 BVS %90aof_save ;If that failed, tidy up
1085
1086 MOV R2,R7 ;Point to relocation data
1087 LDR R3,[R6,#12] ;Load number of relocations
1088 MOV R3,R3,LSL #3 ;Multiply by directive size
1089 ADD R7,R7,R3 ;Move on relocation pointer
1090 TST R14,#&1000 ;Should we include the data?
1091 SWIEQ XOS_GBPB ;Write bytes to file
1092 BVS %90aof_save ;If that failed, tidy up
1093
1094 ADD R6,R6,#20 ;Move on to next AREA
1095 B %50aof_save ;And go round for the rest
1096
1097 ; --- And now for the rest ---
1098
1099 60aof_save ADR R2,aof__objSymT ;Point to symbol table data
1100 LDMIA R2,{R2,R3} ;Load address and size
1101 SWI XOS_GBPB ;Write that out to the file
1102 BVS %90aof_save ;If that failed, tidy up
1103
1104 ADR R2,aof__objStrT ;Point to string table data
1105 LDMIA R2,{R2,R3} ;Load address and size
1106 STR R3,[R2,#0] ;Fill in the size word
1107 ADD R3,R3,#3 ;Word align this size
1108 BIC R3,R3,#3 ;To keep everything nice
1109 SWI XOS_GBPB ;Write that out to the file
1110 BVS %90aof_save ;If that failed, tidy up
1111
1112 ; --- Close the file ---
1113
1114 MOV R0,#0 ;Close a file
1115 MOV R1,R11 ;Get the file handle
1116 SWI OS_Find ;Close the file
1117 ADD R13,R13,#5*4*4 + 3*4 ;Reclaim that stack space
1118
1119 MOV R0,#9 ;Stamp the file
1120 MOV R1,R10 ;Point to the filename
1121 SWI OS_File ;Update the datestamp
1122
1123 ; --- Free all of our flex blocks ---
1124
1125 ADR R0,aof__objHead ;Point to header anchor
1126 BL flex_free ;Free it
1127 ADR R0,aof__objSymT ;Point to symbol table anchor
1128 BL flex_free ;Free it
1129 ADR R0,aof__objStrT ;Point to string table anchor
1130 BL flex_free ;Free it
1131 ADR R0,aof__objReloc ;Point to reloc chunk anchor
1132 BL flex_free ;Free it
1133 ADR R0,aof__imports ;Point to import table anchor
1134 BL flex_free ;Free it
1135 ADR R0,aof__noReloc ;Point to non-reloc anchor
1136 BL flex_free ;Free it
1137 MOV R14,#0 ;Say we're now happy again
1138 STR R14,aof__objHead ;By zeroing header pointer
1139 BL flex_compact ;Ensure heap is compacted
1140
1141 ADD R13,R13,#8 ;Skip past saved R9, R10
1142 LDMFD R13!,{R0-R12,PC}^ ;Return to caller finally
1143
1144 ; --- Something went wrong during the write ---
1145
1146 90aof_save MOV R9,R0 ;Keep the error pointer
1147 MOV R0,#0 ;Close the file
1148 MOV R1,R11 ;Get the file handle
1149 SWI OS_Find ;Try hard to close the file
1150 MOV R0,#6 ;Delete named object
1151 MOV R1,R10 ;Point to the file name
1152 SWI OS_File ;Delete it happily
1153 MOV R0,R9 ;Point to the error again
1154 SWI OS_GenerateError ;And raise the error
1155
1156 aof__objName DCB "OBJ_"
1157 aof__idfnName DCB "IDFN"
1158 aof__headName DCB "HEAD"
1159 aof__areaName DCB "AREA"
1160 aof__symTName DCB "SYMT"
1161 aof__strTName DCB "STRT"
1162
1163 aof__objIdfn DCB "Straylight Basic Assembler Supplement v. 1.00",0
1164 ALIGN
1165
1166 LTORG
1167
1168 ;----- That's all, folks ----------------------------------------------------
1169
1170 END
The Straylight Source Distribution (obsolete software for RISC OS)