;
; 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
