; ; aofGen.s ; ; Generate AOF files from BASIC ; ; © 1994-1998 Straylight ; ;----- Licensing note ------------------------------------------------------- ; ; This file is part of Straylight's BASIC Assembler Supplement. ; ; BAS is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2, or (at your option) ; any later version. ; ; BAS is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with BAS. If not, write to the Free Software Foundation, ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;----- Standard Header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ GET sh.bas GET sh.basTalk GET sh.flex GET sh.insert GET sh.lit GET sh.messages GET sh.string GET sh.workspace ;----- Main code ------------------------------------------------------------ AREA |BAS$$Code|,CODE,READONLY ; --- aof_init --- ; ; On entry: R7 == address of workspace ; R8-R12 set up by BASIC ; ; On exit: -- ; ; CALL syntax: asmCode% ; ; Use: Initialises workspace for generation of AOF code. Remembers ; that code generation will start at asmCode%. EXPORT aof_init aof_init ROUT STMFD R13!,{R0-R6,R9,R10,R12,R14} STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Get my workspace address LDR R14,aof__objHead ;Load the header area address CMP R14,#0 ;Is it created already? ADRNEL R0,msg_errInitTwice ;Yes -- point to error SWINE OS_GenerateError ;And inform the user ; --- First, save the start address --- SUBS R10,R10,#1 ;Decrement argument counter BCC bas_badCall ;If none there, complain LDMIA R9!,{R0,R1} ;Load the argument types BL bTalk_load ;Load value into R2 STR R2,aof__base ;Save this base address ; --- Set up initial indices --- MOV R0,#0 ;Zero some locations STR R0,aof__area ;No current area either STR R0,aof__pass ;Not done any passes yet STR R0,aof__relocCount ;Clear the flags word ; --- Now initialise our memory structures --- MOV R2,#0 ;Initial space used MOV R3,#256 ;Initial space allocated MOV R1,#256 ;Allocate this space ADR R0,aof__objHead ;Point to header area block BL flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it ADRCC R0,aof__objReloc ;Point to relocation block BLCC flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it ADRCC R0,aof__objSymT ;Point to symbol table block BLCC flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it ADRCC R0,aof__objStrT ;Point to string table block BLCC flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it ADRCC R0,aof__imports ;Point to import table block BLCC flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it ADRCC R0,aof__noReloc ;Point to non-reloc anchor BLCC flex_alloc ;Allocate the block STMCCIB R0,{R2,R3} ;Save values after it BCS bas_noMem ;If no memory, complain ; --- Build the header chunk --- LDR R0,aof__objHead ;Find the header area LDR R1,=&C5E2D080 ;The really odd magic number MOV R2,#150 ;Version of AOF we like MOV R3,#0 ;No areas yet MOV R4,#0 ;No symbols either MOV R5,#0 ;No entry area yet MOV R6,#0 ;No entry offset, then STMIA R0,{R1-R6} ;Build most of the header MOV R14,#24 ;Now used 24 bytes STR R14,aof__objHead+4 ;Save this in the info MOV R14,#4 ;Length of string table LDR R0,aof__objStrT ;Find the string table STR R14,[R0,#0] ;Save that in the string tbl STR R14,aof__objStrT+4 ;And as the size used BL lit_init ;Initialise Literal Manager LDMFD R13!,{R0-R6,R9,R10,R12,PC}^ LTORG ; --- aof_pass --- ; ; On entry: -- ; ; On exit: -- ; ; Use: Signals the start of a new assembly pass. EXPORT aof_pass aof_pass ROUT STMFD R13!,{R0,R1,R12,R14} ;Save some registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace ; --- Bump the pass counter --- LDR R1,aof__pass ;Load the pass counter ADD R1,R1,#1 ;Increment it CMP R1,#2 ;Is this the second pass? BLEQ lit_ltorg ;Yes -- insert lit pool STR R1,aof__pass ;And store it back again BNE %10aof_pass ;No -- skip ahead then ; --- Make sure the AREA addresses are OK --- LDR R0,aof__area ;Load the number of AREAs CMP R0,#0 ;Are there any defined? ADREQL R0,msg_errNoAreas ;No -- point to an error SWIEQ OS_GenerateError ;And raise an error LDR R14,aof__objHead ;Find the header chunk LDR R14,[R14,#24+16] ;Load base of first AREA CMP R14,#&FC000000 ;Is this an OK value ADRNEL R0,msg_errNotInArea ;No -- point to error SWINE OS_GenerateError ;And raise it ; --- Work out end address --- BL aof__findArea ;Look up its header info LDR R14,be__percents ;Load % variable base address LDR R1,[R14,#('P'-'A')*4] ;Load current location count ADD R1,R1,#3 ;Word align this nicely BIC R1,R1,#3 ;To keep link happy STR R1,aof__limit ;Save as the code limit LDR R14,[R0,#16] ;Load AREA base address SUB R1,R1,R14 ;Work out the AREA's size STR R1,[R0,#8] ;Store it in the block ; --- Now set up O% and P% correctly --- 10aof_pass LDR R0,aof__base ;Load assembly base address LDR R14,be__percents ;Load % variable base address STR R0,[R14,#('O'-'A')*4] ;Save in correct variable MOV R0,#&FC000000 ;Start assembly here (!) STR R0,[R14,#('P'-'A')*4] ;Save that in P% LDMFD R13!,{R0,R1,R12,PC}^ ;And return to caller LTORG ; --- aof_firstPass --- ; ; On entry: -- ; ; On exit: CS if on first pass, CC otherwise ; ; Use: Informs the caller whether we're on the first or second pass. EXPORT aof_firstPass aof_firstPass ROUT STMFD R13!,{R14} ;Save a register LDR R14,aof__pass ;Which pass are we on? CMP R14,#1 ;Is this the first one? LDMFD R13!,{R14} ;Restore link register ORRLES PC,R14,#C_flag ;Yes -- return CS then BICGTS PC,R14,#C_flag ;No -- return CC then LTORG ; --- aof_ensure --- ; ; On entry: R0 == address of anchor and size info ; R1 == free space required ; ; On exit: R0 == address of first free byte in area ; ; Use: Ensures that there is the requested quantity of memory free ; in the given block. If not, bas_noMem is called. EXPORT aof_ensure aof_ensure ROUT STMFD R13!,{R1,R2,R14} ;Save some registers LDMIB R0,{R2,R14} ;Load used and size words ADD R1,R1,R2 ;Find new total size STR R1,[R0,#4] ;Save this back ADD R1,R1,#255 ;Align up to next 256 BIC R1,R1,#255 ;For niceness's sake CMP R1,R14 ;Do we already have enough? BHI %50aof_ensure ;No -- allocate some more 10aof_ensure STR R1,[R0,#8] ;Save new total size LDR R0,[R0,#0] ;Load address of block ADD R0,R0,R2 ;Point to first free byte LDMFD R13!,{R1,R2,PC}^ ;And return to caller 50aof_ensure BL flex_extend ;No -- then extend the block BCS bas_noMem ;If we couldn't, we die B %10aof_ensure ;Rejoin the main program LTORG ; --- aof__addString --- ; ; On entry: R0 == pointer to string to add ; ; On exit: R0 == offset of string in string table ; ; Use: Adds a string to the string table chunk and returns its ; offset. aof__addString ROUT STMFD R13!,{R1,R2,R14} ;Save some registers LDR R2,aof__objStrT+4 ;Load free offset FSAVE R0 ;Save the string address BL str_len ;Find the string length ADD R1,R0,#1 ;Remember the terminator ADR R0,aof__objStrT ;Point to string table anchor BL aof_ensure ;Make sure there's enough FLOAD R1 ;Load the source string BL str_cpy ;Copy string into area MOV R0,R2 ;Return offset in R0 LDMFD R13!,{R1,R2,PC}^ ;Return to caller LTORG ; --- aof_area --- ; ; On entry: R0 == AREA attributes word ; R7 == address of workspace ; R8-R12 set up by BASIC ; ; On exit: -- ; ; CALL syntax: name$ ; ; Use: Makes a new AREA start at the current location. EXPORT aof_area aof_area ROUT STMFD R13!,{R0-R6,R9,R10,R12,R14} BL insert_align ;Word align current position BL lit_ltorg ;Insert a literal pool STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find workspace address BL aof_firstPass ;Which pass am I on? BCC %90aof_area ;If not the first, quit now ; --- Insert new AREA block in header --- MOV R3,R0 ;Keep the AREA attributes BL str_buffer ;Find a string buffer BL bas_argString ;Read the AREA's name MOV R0,R1 ;Point to the string BL aof__addString ;Put it in the string table MOV R2,R0 ;Keep the string offset ADR R0,aof__objHead ;Find the header chunk MOV R1,#20 ;Want 20 bytes of data BL aof_ensure ;Make sure it's there MOV R4,#0 ;Don't know the size yet MOV R5,#0 ;Don't know about relocations LDR R14,be__percents ;Find the % variables LDR R6,[R14,#('P'-'A')*4] ;Load current loc counter STMIA R0,{R2-R6} ;Save this in the header ; --- Now try to fix up old AREA --- LDR R14,aof__area ;Which area are we on? CMP R14,#0 ;Is this the dummy area? LDRNE R5,[R0,#-4] ;No -- load old start pos SUBNE R5,R6,R5 ;Get the AREA's size STRNE R5,[R0,#-12] ;Save the AREA's size ADD R14,R14,#1 ;Increment AREA count STR R14,aof__area ;And save that back LDR R14,aof__relocCount ;Load current flags CMP R14,#0 ;Is relocation enabled? BEQ %90aof_area ;Relocation enabled -- skip MOV R14,#0 ;Clear the counter nicely STR R14,aof__relocCount ;Save counter back again ; --- If noReloc is at current address, remove it --- LDR R2,be__percents ;Find the % variables LDR R2,[R2,#('O'-'A')*4] ;Load current address ADR R0,aof__noReloc ;Find noreloc table LDMIA R0,{R0,R1} ;Load the size and base SUB R1,R1,#4 ;Find the end value LDR R14,[R0,R1] ;Load the value out CMP R14,R2 ;Is this a match? STREQ R1,aof__noReloc+4 ;Yes -- chop one off size 90aof_area LDMFD R13!,{R0-R6,R9,R10,R12,PC}^ LTORG ; --- aof_entry --- ; ; On entry: -- ; ; On exit: -- ; ; Use: Sets the image entry point to be the current location. EXPORT aof_entry aof_entry ROUT STMFD R13!,{R0-R2,R12,R14} ;Save some registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace address BL insert_align ;Word align current pos BL aof_firstPass ;Is this the first pass? BCC %90aof_entry ;No -- then do nothing ; --- Make sure we have an AREA --- LDR R14,aof__area ;Find the current AREA CMP R14,#0 ;Is this sensible? ADREQL R0,msg_errNoArea ;No -- then point to error SWIEQ OS_GenerateError ;And report an error ; --- Set up the entry AREA number --- LDR R0,aof__objHead ;Find the header chunk LDR R1,[R0,#16] ;Load current entry area CMP R1,#0 ;Is this defined yet? ADRNEL R0,msg_errMultiEntry ;Yes -- point to error SWINE OS_GenerateError ;And report an error STR R14,[R0,#16] ;Save our AREA number ; --- Work out the entry offset --- ADD R14,R14,R14,LSL #2 ;Multiply index by 5 MOV R14,R14,LSL #2 ;Multiply index by 4 (x20) ADD R14,R14,#20 ;Get offset of AREA start LDR R1,[R0,R14] ;Load AREA start address LDR R2,be__percents ;Find the % variables LDR R2,[R2,#('P'-'A')*4] ;Get current location ptr SUB R1,R1,R2 ;Get offset into AREA STR R1,[R0,#20] ;Save the entry offset 90aof_entry LDMFD R13!,{R0-R2,R12,PC}^ ;Return to caller LTORG ; --- aof_import --- ; ; On entry: R0 == pointer to variable name ; R1 == pointer to symbol name ; R3 == attribute bits (not including bits 0,1) ; ; On exit: -- ; ; Use: Imports a symbol, and sets the given variable to point to ; it. If the symbol is already imported, another alias is ; set up, but no actual symbol is created. EXPORT aof_import aof_import ROUT STMFD R13!,{R0-R6,R14} ;Save some registers FSAVE R0 ;Save pointer to alias ; --- See if it's already been IMPORTed --- ADR R2,aof__imports ;Find the symbol table LDMIA R2,{R2,R5} ;Load address and size ADD R5,R2,R5 ;Find limit address LDR R4,aof__objStrT ;And find the string table LDR R6,aof__objSymT ;And the symbol table 00aof_import CMP R2,R5 ;Reached the end yet? BCS %10aof_import ;Yes -- carry on then LDR R0,[R2],#4 ;Load the symbol index LDR R0,[R6,R0] ;Load the name offset ADD R0,R4,R0 ;Find the string address BL str_cmp ;Does the string match? BNE %00aof_import ;No -- ignore it then ; --- Found a match -- use this symbol then --- LDR R14,aof__imports ;Find the base of the table SUB R2,R2,R14 ;Turn address into offset B %20aof_import ;Rejoin the main routine ; --- Couldn't find the symbol -- create it then --- 10aof_import MOV R0,R1 ;Point to the symbol name BL aof__addString ;Put it in the string table MOV R2,R0 ;Remember string's offset ADR R0,aof__objSymT ;Point to symbol table MOV R1,#16 ;Size of a symbol BL aof_ensure ;Make that amount of space ORR R3,R3,#2 ;Get the symbol attributes MOV R4,#0 ;Symbol has no sensible value MOV R5,#0 ;Symbol has no area name STMIA R0,{R2-R5} ;Save symbol definition ; --- Now set up the imports table --- SUB R2,R0,R6 ;Get the symbol table offset ADR R0,aof__imports ;Point to imports table MOV R1,#4 ;Entries are 4 bytes each BL aof_ensure ;Get the memory I want STR R2,[R0],#4 ;Save the symbol index ; --- Work out the import entry offset --- LDR R2,aof__imports ;Find the imports table base SUB R2,R0,R2 ;Find the table offset ; --- Write this into the variable --- 20aof_import RSB R2,R2,#&FD000000 ;Work out the dummy value FLOAD R0 ;Get variable name back BL bTalk_create ;Create the variable BL bTalk_store ;Save the value in it LDMFD R13!,{R0-R6,PC}^ ;Return to caller LTORG ; --- aof_iImport --- ; ; On entry: R0 == WEAK flag ; R7 == address of workspace ; R8-R12 set up by BASIC ; ; On exit: -- ; ; CALL syntax: name$,alias$ ; ; Use: Imports a symbol name$, and makes the variable whose name ; is in alias$ refer to it. EXPORT aof_iImport aof_iImport ROUT STMFD R13!,{R0,R1,R9,R10,R12,R14} STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Get my workspace address BL aof_firstPass ;Is this the first pass? BCC %90aof_iImport ;No -- ignore it then MOV R3,R0,LSL #4 ;Set up WEAK bit BL str_buffer ;Find a string buffer BL bas_argString ;Read variable name string MOV R0,R1 ;Pass this in R0 BL str_buffer ;Find another string buffer BL bas_argString ;Read symbol name string BL aof_import ;Import this symbol 90aof_iImport LDMFD R13!,{R0,R1,R9,R10,R12,PC}^ LTORG ; --- aof__findArea --- ; ; On entry: R0 == index of AREA ; ; On exit: R0 == pointer to AREA description in header chunk ; ; Use: Locates a given AREA's data. aof__findArea ROUT STMFD R13!,{R14} ;Save a register LDR R14,aof__objHead ;Find the header chunk ADD R0,R0,R0,LSL #2 ;Multiply index by 5 ADD R0,R14,R0,LSL #2 ;And again by 4 (x20) ADD R0,R0,#4 ;Add on a bit to find block LDMFD R13!,{PC}^ ;Return to caller LTORG ; --- aof__findSym --- ; ; On entry: R0 == symbol value ; ; On exit: CS if symbol recognised, and ; VS if symbol is external reference, and ; R0 == index of symbol in symbol table ; R1 corrupted ; else VC if symbol is internal reference, and ; R0 == offset of symbol within AREA ; R1 == AREA index ; else CC if symbol is absolute (i.e. not recognised) and ; R0 preserved ; R1 corrupted ; ; Use: Looks up a 32-bit value and tries to interpret it as a ; symbol, returning information about it as required. This ; routine attempts to be as quick as it can, but it can't ; promise anything. aof__findSym ROUT ; --- Make sure it can be anything other than absolute --- MOV R1,R0,LSR #24 ;Get the top byte CMP R1,#&FC ;Is this our magic range? BICNES PC,R14,#C_flag ;No -- clear C and exit ; --- See if it's an external symbol --- LDR R1,aof__objSymT+4 ;Get size of symbol table RSB R1,R1,#&FD000000 ;Work out lowest import addr CMP R0,R1 ;Is this an imported symbol? BCS %50aof__findSym ;Yes -- find symbol index ; --- See if it's an internal reference --- LDR R1,aof__limit ;Load the limit address CMP R0,R1 ;Is this within the code? BICCSS PC,R14,#C_flag ;No -- then ignore it ; --- Work out which AREA it's in --- BIC R14,R14,#V_flag ;Clear V for internal ref ORR R14,R14,#C_flag ;Set C for symbol match STMFD R13!,{R2,R14} ;Save some registers SUB R0,R0,#&FC000000 ;Get the symbol's offset MOV R1,#1 ;Start at index 1 LDR R2,aof__objHead ;Find the header chunk ADD R2,R2,#24 ;Find first AREA block 10aof__findSym LDR R14,[R2,#8] ;Load the AREA's size CMP R0,R14 ;Is this within the AREA? LDMCCFD R13!,{R2,PC}^ ;Yes -- then return it SUB R0,R0,R14 ;Move into next AREA ADD R1,R1,#1 ;Increment AREA index ADD R2,R2,#20 ;Move to next AREA block B %10aof__findSym ;And loop back round again ; --- Find the appropriate symbol --- 50aof__findSym RSB R0,R0,#&FD000000 ;Find the import table index LDR R1,aof__imports ;Find the import table SUB R0,R0,#4 ;Compensate for strangeness LDR R0,[R1,R0] ;Load the symbol index MOV R0,R0,LSR #4 ;And divide by symbol size ORRS PC,R14,#C_flag + V_flag ;Return, setting C and V LTORG ; --- aof_export --- ; ; On entry: R0 == STRONG flag ; R7 == pointer to workspace ; R8-R12 as set up by BASIC ; ; On exit: -- ; ; CALL syntax: alias$,name$ ; ; Use: Exports the value held in the given alias as the symbol ; name$. EXPORT aof_export aof_export ROUT STMFD R13!,{R0-R6,R9,R10,R12,R14} STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace address BL aof_firstPass ;Is this the first pass? BCS %90aof_export ;Yes -- may not be set up MOV R3,R0,LSL #5 ;Keep the STRONG flag safe ; --- Put the symbol name in the string table --- BL str_buffer ;Get a string buffer BL bas_argString ;Read the symbol name out MOV R0,R1 ;Point to the symbol name BL aof__addString ;Put it in the string table MOV R4,R0 ;Remember this offset ; --- Now find the symbol value --- BL str_buffer ;Get a string buffer BL bas_argString ;Read the string's value MOV R0,R1 ;Point to the string BL bTalk_lvblnk ;Find the lvalue BL bTalk_load ;And load its value ; --- Create a block for the symbol --- ADR R0,aof__objSymT ;Point to the symbol table MOV R1,#16 ;Make space for a symbol BL aof_ensure ;Make sure there's space MOV R6,R0 ;Remember this address ; --- Now build the symbol --- MOV R0,R2 ;Get the symbol value BL aof__findSym ;Work out its meaning BCC %20aof_export ;If it's absolute, skip on ADRVSL R0,msg_errExpImported ;If imported, say it's silly SWIVS OS_GenerateError ;And complain to the user ; --- Create a program-relative symbol --- MOV R2,R4 ;Get the symbol name offset ORR R3,R3,#3 ;Get the symbol attributes MOV R4,R0 ;Get the symbol offset MOV R0,R1 ;Put AREA index in R0 BL aof__findArea ;Find the AREA data LDR R5,[R0,#0] ;Get the AREA's name offset STMIA R6,{R2-R5} ;Save the symbol info B %90aof_export ;Return to caller ; --- Create an absolute symbol --- 20aof_export MOV R2,R4 ;Get the symbol name offset ORR R3,R3,#&07 ;Get the symbol attributes MOV R4,R0 ;Get the symbol value MOV R5,#0 ;Say that the AREA is 0 STMIA R6,{R2-R5} ;Save the symbol info 90aof_export LDMFD R13!,{R0-R6,R9,R10,R12,PC}^ LTORG ; --- aof_reloc --- ; ; On entry: R7 == workspace address ; ; On exit: -- ; ; Use: Marks the current address as being the start of a relocation ; block. If a relocation block is current, this is a no-op. EXPORT aof_reloc aof_reloc ROUT STMFD R13!,{R0-R2,R12,R14} ;Save some registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace pointer BL insert_align ;Word align current pos ; --- Only accept reloc/noReloc directives on first pass --- BL aof_firstPass ;Is this the first pass? LDMCCFD R13!,{R0-R2,R12,PC}^ ;No -- do nothing then ; --- Check that we're alternating states --- LDR R14,aof__relocCount ;Load current counter SUBS R14,R14,#1 ;Decrement counter STRGE R14,aof__relocCount ;If was >0, store it LDMNEFD R13!,{R0-R2,R12,PC}^ ;If state still same, return ; --- Check we need to do this --- ; ; If the last entry is at the current address, we remove it ; and return. LDR R2,be__percents ;Load the percents table LDR R2,[R2,#('O'-'A')*4] ;Load current real address ADR R0,aof__noReloc ;Point to noReloc table LDMIA R0,{R1,R14} ;Load size and address SUBS R14,R14,#4 ;Find previous entry BLT %10aof_reloc ;If none defined, skip on LDR R1,[R1,R14] ;Load the value out CMP R1,R2 ;Do the entries match? STREQ R14,aof__noReloc+4 ;Yes -- decrement used size LDMEQFD R13!,{R0-R2,R12,PC}^ ;And return to caller ; --- Add in the item --- 10aof_reloc MOV R1,#4 ;Entries are 4 bytes each BL aof_ensure ;Extend the table STR R2,[R0],#4 ;Save this in the table LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller LTORG ; --- aof_noReloc --- ; ; On entry: R7 == workspace address ; ; On exit: -- ; ; Use: Marks the current address as being the start of a non- ; relocation block. If a non-relocation block is current, ; this is a no-op. EXPORT aof_noReloc aof_noReloc ROUT STMFD R13!,{R0-R2,R12,R14} ;Save some registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace pointer BL insert_align ;Word align current pos ; --- Only accept reloc/noReloc directives on first pass --- BL aof_firstPass ;Is this the first pass? LDMCCFD R13!,{R0-R2,R12,PC}^ ;No -- do nothing then ; --- Check that we're alternating states --- LDR R14,aof__relocCount ;Load current counter value ADD R14,R14,#1 ;Increment the value STR R14,aof__relocCount ;Save value back again CMP R14,#1 ;Was relocation enabled? LDMNEFD R13!,{R0-R2,R12,PC}^ ;No -- return to caller ; --- Check we need to do this --- ; ; If the last entry is at the current address, we remove it ; and return. LDR R2,be__percents ;Load the percents table LDR R2,[R2,#('O'-'A')*4] ;Load current real address ADR R0,aof__noReloc ;Point to noReloc table LDMIA R0,{R1,R14} ;Load size and address SUBS R14,R14,#4 ;Find previous entry BLT %10aof_noReloc ;If none defined, skip on LDR R1,[R1,R14] ;Load the value out CMP R1,R2 ;Do the entries match? STREQ R14,aof__noReloc+4 ;Yes -- decrement used size LDMEQFD R13!,{R0-R2,R12,PC}^ ;And return to caller ; --- Add in the item --- 10aof_noReloc MOV R1,#4 ;Entries are 4 bytes each BL aof_ensure ;Extend the table STR R2,[R0],#4 ;Save this in the table LDMFD R13!,{R0-R2,R12,PC}^ ;And return to caller LTORG ; --- aof_save --- ; ; On entry: R7 == workspace address ; R8-R12 set up by BASIC ; ; On exit: -- ; ; CALL syntax: file$ ; ; Use: Saves the current AOF file. It also resets all the AOF ; state, so that another AOF file can be built subsequently. EXPORT aof_save aof_save ROUT STMFD R13!,{R0-R12,R14} ;Save loads of registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Find my workspace pointer BL aof_firstPass ;Is this the first pass? ADRCSL R0,msg_errNotDone ;Yes -- point to error SWICS OS_GenerateError ;And make an error BL lit_end ;Turn off the literal system ADR R0,aof__noReloc ;Point to noReloc table MOV R1,#4 ;Entries are 4 bytes each BL aof_ensure ;Extend the table MOV R14,#-1 ;Add a terminator STR R14,[R0],#4 ;Save this in the table MOV R0,#0 ;Zero NOINIT size count STMFD R13!,{R0,R9,R10} ;Save argument pointers ; --- Build relocation directives --- ; ; Also fix up relocation counts for area defs MOV R11,#1 ;Current AREA number LDR R10,aof__objHead ;Find the header chunk ADD R10,R10,#24 ;Point to first AREA info LDR R9,aof__area ;Load the number of AREAs LDR R8,aof__base ;Find the code base address LDR R4,aof__noReloc ;Find non-relocation block LDR R3,[R4],#4 ;Load next value out 05aof_save SUBS R9,R9,#1 ;Decrement the AREA counter BCC %20aof_save ;If all done, skip onwards STMFD R13!,{R9} ;Save AREA counter MOV R9,R3 ;Look after next reloc value MOV R7,#0 ;No relocations created yet LDR R6,[R10,#8] ;Load the AREA size MOV R5,#-4 ;Start at offset 0 LDR R14,[R10,#4] ;Load AREA attributes TST R14,#&1000 ;Is it NOINITed? BEQ %10aof_save ;No -- deal with normally LDR R14,[R13,#4] ;Load current NOINIT size ADD R14,R14,R6 ;Add on size of this AREA STR R14,[R13,#4] ;Save new size back again ADD R8,R8,R6 ;Move pointer past AREA B %19aof_save ;And skip out relocations ; --- Scan an AREA for relocations --- 07aof_save ADD R6,R6,#4 ;Decremented down below CMP R8,R9 ;Is this in reloc block? LDRCS R9,[R4],#4 ;Yes -- load next value BCS %10aof_save ;And relocate data nicely ADD R14,R8,R6 ;Find end of AREA CMP R14,R9 ;Any data to relocate? ADDCC R8,R8,R6 ;No -- skip on to AREA end BCC %19aof_save ;And move to next AREA SUB R14,R9,R8 ;Find out how much to skip ADD R8,R8,R14 ;Move on AREA address ADD R5,R5,R14 ;And move on the offset SUB R6,R6,R14 ;And decrement AREA size LDR R9,[R4],#4 ;Load next reloc value 10aof_save SUBS R6,R6,#4 ;Decrement AREA size BCC %19aof_save ;If all done, move to next CMP R8,R9 ;Is this in non-reloc block? LDRCS R9,[R4],#4 ;Yes -- load next value BCS %07aof_save ;And skip on until reloc LDR R0,[R8],#4 ;Load the next word out ADD R5,R5,#4 ;Bump current offset AND R14,R0,#&0E000000 ;Get opcode field CMP R14,#&0A000000 ;Is it a branch or BL? BEQ %15aof_save ;Yes -- handle this then BL aof__findSym ;Try and interpret the value BCC %10aof_save ;If no match, ignore it BVS %13aof_save ;If symbol relocation, skip ; --- Build an internal additive relocation --- STR R0,[R8,#-4] ;Save offset back into code SUB R3,R1,#1 ;And the AREA index ADR R0,aof__objReloc ;Point to relocation chunk MOV R1,#8 ;Need 8 bytes for relocation BL aof_ensure ;Make sure there's enough ORR R14,R3,#&82000000 ;Set up relocation info STMIA R0,{R5,R14} ;Make the directive ADD R7,R7,#1 ;Bump the relocation count B %10aof_save ;Go back round for more ; --- Build a symbol additive relocation --- 13aof_save MOV R14,#0 ;Make word reference symbol STR R14,[R8,#-4] ;By zeroing the word MOV R3,R0 ;Look after symbol index ADR R0,aof__objReloc ;Point to relocation chunk MOV R1,#8 ;Need 8 bytes for relocation BL aof_ensure ;Make sure there's enough ORR R14,R3,#&000A0000 ;Set up relocation info STMIA R0,{R5,R14} ;Make the directive ADD R7,R7,#1 ;Bump the relocation count B %10aof_save ;Go back round for more ; --- Handle a B or BL instruction --- 15aof_save AND R2,R0,#&FF000000 ;Get condition and type BIC R0,R0,#&FF000000 ;Get branch offset value ADD R0,R0,#2 ;Add on the required offset LDR R3,[R10,#16] ;Load the AREA base address ADD R3,R3,R5 ;Add on current offset ADD R0,R3,R0,LSL #2 ;Work out branch destination BL aof__findSym ;Look up the symbol type BCC %10aof_save ;It's absolute -- ignore it BVS %17aof_save ;It's symbol relative -- skip ; --- Handle an internal PCRelative relocation --- CMP R1,R11 ;Is it to this AREA? BEQ %10aof_save ;Yes -- don't bother then SUB R0,R0,R3 ;Work out the branch offset MOV R0,R0,LSR #2 ;Shift it right by 2 nicely SUB R0,R0,#2 ;And account for pipeline BIC R0,R0,#&FF000000 ;Clear the top bits ORR R0,R0,R2 ;And put in old opcode bits STR R0,[R8,#-4] ;Write this instruction back SUB R3,R1,#1 ;Look after AREA index ADR R0,aof__objReloc ;Point to relocation chunk MOV R1,#8 ;Need 8 bytes for relocation BL aof_ensure ;Make sure there's enough ORR R14,R3,#&86000000 ;Set up relocation flags STMIA R0,{R5,R14} ;Save relocation directive ADD R7,R7,#1 ;Bump the relocation count B %10aof_save ;And try the next word ; --- Handle a symbol PCRelative relocation --- 17aof_save STR R2,[R8,#-4] ;B/BL all bits zero MOV R3,R0 ;Keep the symbol index ADR R0,aof__objReloc ;Point to relocation chunk MOV R1,#8 ;Need 8 bytes for relocation BL aof_ensure ;Make sure there's enough ORR R14,R3,#&000E0000 ;Set up relocation flags STMIA R0,{R5,R14} ;Save relocation directive ADD R7,R7,#1 ;Bump the relocation count B %10aof_save ;And try the next word ; --- Reached end of the AREA --- 19aof_save STR R7,[R10,#12] ;Save the relocation count MOV R14,#0 ;A zero word STR R14,[R10,#16] ;Write over reserved word ADD R10,R10,#20 ;Move to next AREA block ADD R11,R11,#1 ;Increment the AREA counter MOV R3,R9 ;Look after noReloc address LDMFD R13!,{R9} ;Load the AREA countdown B %05aof_save ;And branch back for the rest ; --- Work out chunk file header format --- ; ; Pointless comment for separation, 'cos Tim said so. 20aof_save LDMFD R13!,{R4} ;Load NOINIT size SUB R13,R13,#5*4*4 + 3*4 ;Allocate space from stack MOV R14,R13 ;Point to base of this area LDR R0,=&C3CBC6C5 ;Strange magic guard word MOV R1,#5 ;We have 5 chunks MOV R2,#5 ;We will always have 5 chunks STMIA R14!,{R0-R2} ;Save this away LDR R0,aof__objName ;Load string `OBJ_' MOV R2,#5*4*4 + 3*4 ;Where the chunks start ; --- Set up the OBJ_IDFN entry --- LDR R1,aof__idfnName ;Load string `IDFN' MOV R3,# ? aof__objIdfn ;Find length of identifier STMIA R14!,{R0-R3} ;Save chunk information ADD R2,R2,R3 ;Work out next offset ADD R2,R2,#3 ;Size may not be word aligned BIC R2,R2,#3 ;It is now ; --- Set up the OBJ_HEAD entry --- LDR R1,aof__headName ;Load string `HEAD' LDR R3,aof__objHead+4 ;Point to header anchor STMIA R14!,{R0-R3} ;Save chunk information ADD R2,R2,R3 ;Work out next offset ; --- Set up the OBJ_AREA entry --- LDR R1,aof__areaName ;Load string `AREA' LDR R3,aof__objReloc+4 ;Load size of reloc block SUB R3,R3,R4 ;Subtract NOINIT size LDR R4,aof__limit ;Load end of code BIC R4,R4,#&FF000000 ;Mask off strange marker bits ADD R3,R3,R4 ;And work out chunk size STMIA R14!,{R0-R3} ;Save chunk information ADD R2,R2,R3 ;Work out next offset ; --- Set up the OBJ_SYMT entry --- LDR R1,aof__symTName ;Load string `SYMT' LDR R3,aof__objSymT+4 ;Point to table anchor STMIA R14!,{R0-R3} ;Save chunk information ADD R2,R2,R3 ;Work out next offset ; --- Set up the OBJ_STRT entry --- LDR R1,aof__strTName ;Load string `STRT' LDR R3,aof__objStrT+4 ;Point to table anchor STMIA R14!,{R0-R3} ;Save chunk information ADD R2,R2,R3 ;Work out next offset ADD R2,R2,#3 ;Size may not be word aligned BIC R2,R2,#3 ;It is now ; --- Open the output file --- LDMIA R14,{R9,R10} ;Load BASIC's arguments BL str_buffer ;Find a string buffer BL bas_argString ;Copy the name string here MOV R10,R1 ;Look after name pointer MOV R0,#&8C ;Make lots of errors SWI OS_Find ;Open the file MOV R11,R0 ;Look after the file handle ; --- Write individual chunks to output file --- MOV R0,#2 ;Write bytes to file MOV R1,R11 ;Get the file handle MOV R2,R13 ;Point to header block MOV R3,#5*4*4 + 3*4 ;Size of the header block SWI XOS_GBPB ;Write that out to the file BVS %90aof_save ;If that failed, tidy up ADR R2,aof__objIdfn ;Point to identification str MOV R3,# ? aof__objIdfn ;And read the length of it ADD R3,R3,#3 ;Word align this size BIC R3,R3,#3 ;To keep everything nice SWI XOS_GBPB ;Write that out to the file BVS %90aof_save ;If that failed, tidy up ; --- Set up the header and write it --- ADR R2,aof__objHead ;Point to header chunk data LDMIA R2,{R2,R3} ;Load address and size LDR R14,aof__area ;Get the number of AREAs STR R14,[R2,#8] ;Save this in the header LDR R14,aof__objSymT+4 ;Load symbol table size MOV R14,R14,LSR #4 ;Divide by symbol block size STR R14,[R2,#12] ;Save this in the header SWI XOS_GBPB ;Write that out to the file BVS %90aof_save ;If that failed, tidy up ; --- Write the AREA chunk (yuk) --- LDR R5,aof__base ;Find AREA data base address LDR R6,aof__objHead ;Find the header chunk ADD R6,R6,#24 ;Find the first AREA block LDR R7,aof__objReloc ;Find the relocation chunk LDR R8,aof__area ;Get the AREAs counter 50aof_save SUBS R8,R8,#1 ;Decrement AREA counter BCC %60aof_save ;If all done, skip onwards LDR R14,[R6,#4] ;Load AREA attributes MOV R2,R5 ;Point to AREA base LDR R3,[R6,#8] ;Load AREA size ADD R5,R5,R3 ;Move on the AREA pointer TST R14,#&1000 ;Should we include the data? SWIEQ XOS_GBPB ;Write bytes to file BVS %90aof_save ;If that failed, tidy up MOV R2,R7 ;Point to relocation data LDR R3,[R6,#12] ;Load number of relocations MOV R3,R3,LSL #3 ;Multiply by directive size ADD R7,R7,R3 ;Move on relocation pointer TST R14,#&1000 ;Should we include the data? SWIEQ XOS_GBPB ;Write bytes to file BVS %90aof_save ;If that failed, tidy up ADD R6,R6,#20 ;Move on to next AREA B %50aof_save ;And go round for the rest ; --- And now for the rest --- 60aof_save ADR R2,aof__objSymT ;Point to symbol table data LDMIA R2,{R2,R3} ;Load address and size SWI XOS_GBPB ;Write that out to the file BVS %90aof_save ;If that failed, tidy up ADR R2,aof__objStrT ;Point to string table data LDMIA R2,{R2,R3} ;Load address and size STR R3,[R2,#0] ;Fill in the size word ADD R3,R3,#3 ;Word align this size BIC R3,R3,#3 ;To keep everything nice SWI XOS_GBPB ;Write that out to the file BVS %90aof_save ;If that failed, tidy up ; --- Close the file --- MOV R0,#0 ;Close a file MOV R1,R11 ;Get the file handle SWI OS_Find ;Close the file ADD R13,R13,#5*4*4 + 3*4 ;Reclaim that stack space MOV R0,#9 ;Stamp the file MOV R1,R10 ;Point to the filename SWI OS_File ;Update the datestamp ; --- Free all of our flex blocks --- ADR R0,aof__objHead ;Point to header anchor BL flex_free ;Free it ADR R0,aof__objSymT ;Point to symbol table anchor BL flex_free ;Free it ADR R0,aof__objStrT ;Point to string table anchor BL flex_free ;Free it ADR R0,aof__objReloc ;Point to reloc chunk anchor BL flex_free ;Free it ADR R0,aof__imports ;Point to import table anchor BL flex_free ;Free it ADR R0,aof__noReloc ;Point to non-reloc anchor BL flex_free ;Free it MOV R14,#0 ;Say we're now happy again STR R14,aof__objHead ;By zeroing header pointer BL flex_compact ;Ensure heap is compacted ADD R13,R13,#8 ;Skip past saved R9, R10 LDMFD R13!,{R0-R12,PC}^ ;Return to caller finally ; --- Something went wrong during the write --- 90aof_save MOV R9,R0 ;Keep the error pointer MOV R0,#0 ;Close the file MOV R1,R11 ;Get the file handle SWI OS_Find ;Try hard to close the file MOV R0,#6 ;Delete named object MOV R1,R10 ;Point to the file name SWI OS_File ;Delete it happily MOV R0,R9 ;Point to the error again SWI OS_GenerateError ;And raise the error aof__objName DCB "OBJ_" aof__idfnName DCB "IDFN" aof__headName DCB "HEAD" aof__areaName DCB "AREA" aof__symTName DCB "SYMT" aof__strTName DCB "STRT" aof__objIdfn DCB "Straylight Basic Assembler Supplement v. 1.00",0 ALIGN LTORG ;----- That's all, folks ---------------------------------------------------- END