;
; get.s
;
; Parsing of simple objasm header files
;
;  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.aofGen
		GET	sh.bas
		GET	sh.basTalk
		GET	sh.flex
		GET	sh.string
		GET	sh.workspace

;----- Main code ------------------------------------------------------------

		AREA	|BAS$$Code|,CODE,READONLY

; --- get ---
;
; On entry:	R7 == pointer to workspace
;		R8-R12 as set up by BASIC
;
; On exit:	--
;
; CALL syntax:	filename
;
; Use:		Parses a Straylight format objasm header file and sets up
;		BASIC variables appropriately.

		EXPORT	get
get		ROUT

		STMFD	R13!,{R0-R12,R14}	;Save some registers
		STR	R12,[R7,#:INDEX:be__line] ;Save BASIC's LINE value
		MOV	R12,R7			;Set up my workspace pointer

		; --- Find out if we need to do anything ---

		BL	aof_firstPass		;Is this the first pass?
		LDMCCFD	R13!,{R0-R12,PC}^	;No -- then return to caller

		; --- Load the file into a flex block ---

		BL	str_buffer		;Find a string buffer
		BL	bas_argString		;Read a string argument
		MOV	R7,R1			;Look after this pointer
		MOV	R0,#17			;Read information about file
		SWI	OS_File			;Find out the file info
		TST	R0,#1			;Is this a file?
		BEQ	%80get			;No -- then report error

		MOV	R0,#0			;Clear a flags word
		STR	R0,[R13,#-4]!		;Save it on the stack
		SUB	R13,R13,#8		;Make a flex anchor
		MOV	R0,R13			;Point at the anchor
		ADD	R1,R4,#1		;Bump file size by 1
		BL	flex_alloc		;Allocate lots of memory
		BCS	bas_noMem		;If it failed, complain

		MOV	R0,#16			;Load a file name
		MOV	R1,R7			;Point to the file name
		LDR	R2,[R13,#0]		;Load the flex pointer
		MOV	R3,#0			;Load file right here
		SWI	XOS_File		;Load the file
		BVS	%90get			;If it failed, tidy up

		; --- Set up for parsing the file ---
		;
		; Register allocation:
		;
		;   R12 == workspace
		;   R11 == pointer to end of file
		;   R10 == pointer to current position
		;   R9 == pointer to next line start

		MOV	R14,#&10		;Put a newline at the end
		LDR	R9,[R13,#0]		;Load flex block base
		STRB	R14,[R9,R4]		;Save at end of the file
		ADD	R11,R9,R4		;Find the end of the file

		; --- Loop throught the lines of the file ---

10get		BL	get__nextLine		;Get the next line
		BCS	%70get			;If now finished, return

		; --- See if there's a comment here ---

		MOV	R8,R10			;Remember current position
		BL	get__byte		;Read a character
		BCS	%10get			;If end of line, loop back
		MOVMI	R8,#0			;If whitespace, no label
		BMI	%12get			;And skip on a little
		CMP	R0,#';'			;Is this a line comment?
		BEQ	%20get			;Yes -- may be active comment

11get		BL	get__byte		;Read a character
		BPL	%11get			;And wait for whitespace

		; --- Skip whitespace and find opcode ---

12get		MOV	R7,R10			;Remember current position
		BL	get__byte		;Read a character
		BCS	%10get			;If end of line, loop back
		BMI	%12get			;If whitespace, loop back

		; --- Find end of opcode ---

13get		MOV	R6,R10			;Remember current position
		BL	get__byte		;Read a character
		BPL	%13get			;And wait for whitespace
		MOV	R14,#0			;Mark end of opcode
		STRB	R14,[R6,#0]		;Terminate opcode string

		; --- Attempt to match the opcode ---

		MOV	R1,R7			;Point to the opcode
		ADR	R0,get__table		;Point to opcode table
		BL	get__match		;Try to find a match
		MOV	R14,PC			;Set up return address
		ADDCS	PC,PC,R0,LSL #2		;Do dispatch table things
		B	%10get			;And get the next line

		; --- The dispatch table ---

		B	get__hash		;Hash (#) directive
		B	get__hat		;Hat (^) directive
		B	get__equ		;EQU directive
		B	get__equ		;EQU directive
		B	get__import		;IMPORT dirctive
		B	get__macro		;MACRO directive
		B	get__mend		;MEND directive

		; --- The directive table ---

get__table	DCB	"#",0
		DCB	"^",0
		DCB	"EQU",0
		DCB	"*",0
		DCB	"IMPORT",0
		DCB	"MACRO",0
		DCB	"MEND",0
		DCB	0

		; --- Found an active comment ---
		;
		; We use active comments to give this specific parser
		; instructions, of which objasm should be blissfully
		; unaware.  This is used to load BASIC macro libraries
		; which we use instead of the objasm ones.

20get		BL	get__byte		;Read the next byte
		BCS	%10get			;If end-of-line, move on
		CMP	R0,#'+'			;Is it a BAS active comment?
		BNE	%10get			;No -- ignore this line

		; --- Find start of directive ---

21get		MOV	R7,R10			;Remember this position
		BL	get__byte		;Get another byte
		BCS	%10get			;If end-of-line, ignore it
		BMI	%21get			;If whitespace, skip on

22get		MOV	R6,R10			;Remember end of directive
		BL	get__byte		;Get another byte
		BPL	%22get			;If nonwhitespace, skip
		MOV	R14,#0			;Null terminate the directive
		STRB	R14,[R6,#0]		;Save the null byte then

		; --- Call the correct directive ---

		ADR	R0,get__actComm		;Point to directive table
		MOV	R1,R7			;Point to this directive
		BL	get__match		;Try to match the name
		MOV	R14,PC			;Set up a return address
		ADDCS	PC,PC,R0,LSL #2		;Dispatch through the table
		B	%10get			;And get the next line

		; --- The dispatch table ---

		B	get__lib		;Include BASIC macro lib

		; --- Active comment directives ---

get__actComm	DCB	"LIB",0
		DCB	0

		; --- Close the file and return ---

70get		MOV	R0,R13			;Point to flex anchor
		BL	flex_free		;Free the block
		BL	flex_compact		;And reduce memory usage
		ADD	R13,R13,#12		;Restore the stack pointer
		LDMFD	R13!,{R0-R12,PC}^	;Return to caller

90get		MOV	R10,R0			;Look after error pointer
		MOV	R0,R13			;Point to flex anchor
		BL	flex_free		;Free the block
		BL	flex_compact		;And reduce memory usage
		ADD	R13,R13,#12		;Restore the stack pointer
		MOV	R0,R10			;Get error back again
		SWI	OS_GenerateError	;And raise the error

80get		MOV	R2,R0			;Get returned object type
		MOV	R0,#19			;Return error message
		SWI	OS_File			;Make the error

		LTORG

; --- get__hat ---
;
; On entry:	R9 == pointer to end of line
;		R10 == pointer to directive operands
;		R11 == pointer to end of file
;
; On exit:	R0-R8, R10 corrupted
;
; Use:		Handles a hat (^) directive.

get__hat	ROUT

		STMFD	R13!,{R14}		;Save some registers

		; --- Find start of operands ---

00get__hat	MOV	R8,R10			;Remember current position
		BL	get__byte		;Read another byte
		BMI	%00get__hat		;If whitespace, skip on

		; --- Now find the end ---

		MOV	R1,#32			;Make whitespace into spaces
10get__hat	MOV	R7,R10			;Remember current position
		BL	get__byte		;Read another byte
		BCS	%15get__hat		;If end-of-line, skip out
		STRMIB	R1,[R7,#0]		;If whitespace, space it
		CMP	R0,#','			;Could be a comma, maybe
		CMPNE	R0,#';'			;Also stop at a comment
		BNE	%10get__hat		;If not, keep going

15get__hat	MOV	R14,#0			;Null terminate expression
		STRB	R14,[R7,#0]		;Done that then

		; --- Evaluate the expression ---

		MOV	R1,R8			;Point to the expression
		BL	bTalk_eval		;Evaluate the expression

		STR	R0,[R13,#8]		;Save the new `at' value
		LDMFD	R13!,{PC}^		;And return to caller

		LTORG

; --- get__hash ---
;
; On entry:	R8 == pointer to label, or 0
;		R9 == pointer to end of line
;		R10 == pointer to directive operands
;		R11 == pointer to end of file
;
; On exit:	R0-R8, R10 corrupted
;
; Use:		Handles a hash (#) directive.

get__hash	ROUT

		STMFD	R13!,{R14}		;Save some registers

		; --- Find start of operands ---

00get__hash	MOV	R7,R10			;Remember current position
		BL	get__byte		;Read another byte
		BMI	%00get__hash		;If whitespace, skip on

		; --- Now find the end ---

		MOV	R1,#32			;Make whitespace into spaces
10get__hash	MOV	R6,R10			;Remember current position
		BL	get__byte		;Read another byte
		BCS	%15get__hash		;If end-of-line, skip out
		STRMIB	R1,[R6,#0]		;If whitespace, space it
		CMP	R0,#';'			;Also stop at a comment
		BNE	%10get__hash		;If not, keep going

15get__hash	MOV	R14,#0			;Null terminate expression
		STRB	R14,[R6,#0]		;Done that then

		; --- Save the current `at' value ---

		LDR	R2,[R13,#8]		;Load current `at' value
		MOVS	R0,R8			;Point to label name
		BEQ	%20get__hash		;No label -- don't assign

		BL	bTalk_create		;Create the variable
		BL	bTalk_store		;Store that in lvalue

		; --- Evaluate the expression ---

20get__hash	MOV	R1,R7			;Point to the expression
		BL	bTalk_eval		;Evaluate the expression
		ADD	R0,R0,R2		;Increment the `at' value
		STR	R0,[R13,#8]		;And store it back

		LDMFD	R13!,{PC}^		;And return to caller

		LTORG

; --- get__equ ---
;
; On entry:	R8 == pointer to label, or 0
;		R9 == pointer to end of line
;		R10 == pointer to directive operands
;		R11 == pointer to end of file
;
; On exit:	R0-R8, R10 corrupted
;
; Use:		Handles an EQU directive.

get__equ	ROUT

		STMFD	R13!,{R14}		;Save some registers
		LDR	R14,[R13,#12]		;Load the flags word
		TST	R14,#1			;Are we in macro?
		LDMNEFD	R13!,{PC}^		;Yes -- return to caller

		; --- Find start of operands ---

00get__equ	MOV	R7,R10			;Remember current position
		BL	get__byte		;Read another byte
		BMI	%00get__equ		;If whitespace, skip on

		; --- Now find the end ---

		MOV	R1,#32			;Turn whitespace into spaces
10get__equ	MOV	R6,R10			;Remember current position
		BL	get__byte		;Read another byte
		BCS	%15get__equ		;If end-of-line, skip out
		STRMIB	R1,[R6,#0]		;If whitespace, space it
		CMP	R0,#';'			;Also stop at a comment
		BNE	%10get__equ		;If not, keep going

15get__equ	MOV	R14,#0			;Null terminate expression
		STRB	R14,[R6,#0]		;Done that then

		; --- Evaluate the expression ---

		MOV	R1,R7			;Point to the operand
		BL	bTalk_eval		;Evaluate it nicely
		MOV	R2,R0			;This is the value to store

		MOV	R0,R8			;Point to label
		BL	bTalk_create		;Create the variable
		BL	bTalk_store		;And store the value away

		LDMFD	R13!,{PC}^		;And return to caller

		LTORG

; --- get__import ---
;
; On entry:	R9 == pointer to end of line
;		R10 == pointer to directive operands
;		R11 == pointer to end of file
;
; On exit:	R0-R8, R10 corrupted
;
; Use:		Handles an IMPORT directive.

get__import	ROUT

		STMFD	R13!,{R14}		;Save some registers
		LDR	R14,[R13,#12]		;Load the flags word
		TST	R14,#1			;Are we in macro?
		LDMNEFD	R13!,{PC}^		;Yes -- return to caller

		; --- Find start of operands ---

00get__import	MOV	R7,R10			;Remember current position
		BL	get__byte		;Read another byte
		BMI	%00get__import		;If whitespace, skip on

		; --- Now find the end ---

		MOV	R1,#32			;Turn whitespace into spaces
10get__import	MOV	R6,R10			;Remember current position
		BL	get__byte		;Read another byte
		BCS	%15get__import		;If end-of-line, skip out
		STRMIB	R1,[R6,#0]		;If whitespace, space it
		CMP	R0,#';'			;Also stop at a comment
		BNE	%10get__import		;If not, keep going

15get__import	MOV	R14,#0			;Null terminate expression
		STRB	R14,[R6,#0]		;Done that then

		; --- Now import the symbol ---

		MOV	R0,R7			;Point to operand name
		MOV	R1,R7			;Make this the alias too
		MOV	R3,#0			;No special attributes
		FSAVE	R9-R11			;Save the block pointers
		BL	aof_import		;Import the symbol
		FLOAD	R9-R11			;Load them back again
		LDMFD	R13!,{PC}^		;And return to caller

		LTORG

; --- get__macro ---
;
; On entry:	--
;
; On exit:	R0-R8 corrupted
;
; Use:		Sets the `in a macro' flag, so that strange EQU directives
;		don't get read.

get__macro	ROUT

		LDR	R0,[R13,#8]		;Load the flags word
		ORR	R0,R0,#1		;Set the flag
		STR	R0,[R13,#8]		;Save the flags back
		MOVS	PC,R14			;Return to caller

		LTORG

; --- get__mend ---
;
; On entry:	--
;
; On exit:	R0-R8 corrupted
;
; Use:		Clears the `in a macro' flag, so that strange EQU directives
;		don't get read.

get__mend	ROUT

		LDR	R0,[R13,#8]		;Load the flags word
		BIC	R0,R0,#1		;Clear the flag
		STR	R0,[R13,#8]		;Save the flags back
		MOVS	PC,R14			;Return to caller

		LTORG

; --- get__lib ---
;
; On entry:	--
;
; On exit:	--
;
; Use:		Loads a macro library.  This is done so that an objasm
;		header file can load BASIC macros as appropriate, since
;		objasm macros are obviously not much use.  We do this by
;		evaluating a call to FNlib(), which the BASIC part will
;		implement as loading a library.

get__lib	ROUT

		STMFD	R13!,{R14}		;Save the link register

		; --- Find start of operands ---

00get__lib	MOV	R7,R10			;Remember current position
		BL	get__byte		;Read another byte
		BMI	%00get__lib		;If whitespace, skip on

		; --- Now find the end ---

10get__lib	MOV	R6,R10			;Remember current position
		BL	get__byte		;Read another byte
		BCS	%15get__lib		;If end-of-line, skip out
		CMP	R0,#';'			;Also stop at a comment
		BNE	%10get__lib		;If not, keep going

15get__lib	MOV	R14,#0			;Null terminate expression
		STRB	R14,[R6,#0]		;Done that then

		; --- Build the string to evaluate ---

		BL	str_buffer		;Get a buffer
		ADR	R0,get__libSkel		;Point to skeleton string
		BL	str_subst		;Build the correct invocation
		MOV	R1,R0			;Point to the string built
		BL	bTalk_eval		;Evaluate the expression

		LDMFD	R13!,{PC}^		;And return to caller

get__libSkel	DCB	"FNbas_lib(""%5"")",0

		LTORG

; --- get__nextLine ---
;
; On entry:	R9 == pointer to start of next line
;		R11 == pointer to end of file
;
; On exit:	CC if more to come, and
;		  R9 == pointer to start of next line line
;		  R10 == pointer to next line
;		else CS if end of file reached and
;		  R9, R10 corrupted
;		R0 always corrupted
;
; Use:		Finds the start address of the next line

get__nextLine	ROUT

		CMP	R9,R11			;Are we at end of file?
		ORRCSS	PC,R14,#C_flag		;Yes -- return with C set

		MOV	R10,R9			;Point to the next line
00get__nextLine	LDRB	R0,[R9],#1		;Get next character
		CMP	R0,#&0A			;Is this a newline?
		BNE	%00get__nextLine	;No -- go round for more then
		LDRB	R0,[R9,#0]		;Load the next byte
		CMP	R0,#&0D			;Is this a carriage return?
		ADDEQ	R0,R0,#1		;Yes -- then move along one
		BICS	PC,R14,#C_flag		;And return with C clear

		LTORG

; --- get__byte ---
;
; On entry:	R10 == pointer to next byte
;
; On exit:	CC if read a byte, and
;		  R0 == byte read
;		  R10 moved to byte after
;		  MI if byte is whitespace, else PL
;		else CS if end of line and
;		  R0, R10 corrupted
;
; Use:		Reads a byte from the block

get__byte	ROUT

		LDRB	R0,[R10],#1		;Load a byte
		CMP	R10,R9			;Reached end of line yet?
		ORRCSS	PC,R14,#C_flag + N_flag	;Yes -- set C on exit then
		BIC	R14,R14,#C_flag		;Clear R14's C flag ready
		CMP	R0,#&9			;Is it a tab?
		CMPNE	R0,#&0C			;Or a form feed? (oddness)
		CMPNE	R0,#&0D			;Or a carriage return?
		CMPNE	R0,#&20			;Or a space, indeed?
		ORREQS	PC,R14,#N_flag		;Yes -- set the N flag
		BICNES	PC,R14,#N_flag		;Otherwise clear N

		LTORG

; --- get__match ---
;
; On entry:	R0 == pointer to command line argument table
;		R1 == pointer to command line word read (null terminated)
;
; On exit:	CS if word found in table and
;		  R0 == index of item matched
;		else CC and
;		  R0 corrupted
;
; Use:		Looks up a given word in the command table given.  The
;		command table consists of null-terminated strings, and is
;		itself terminated by a null entry.
;
;		Matching is not case sensitive.  Indexing is from 0.

get__match	ROUT

		STMFD	R13!,{R1-R5,R14}	;Save some registers
		MOV	R2,#0			;Index of the current item
		LDRB	R14,[R1,#0]		;Load the first byte
		CMP	R14,#0			;Is it a null string?
		BEQ	%90get__match		;Yes -- no match then

		; --- The main loop ---

00get__match	MOV	R3,R1			;Point to argument start
		LDRB	R4,[R0],#1		;Load a byte from the table
		LDRB	R5,[R3],#1		;Load a byte from the arg
		CMP	R4,#0			;Is this an empty string?
		BEQ	%90get__match		;Yes -- no match then

		; --- Try to match a word ---

10get__match	CMP	R5,#0			;End of argument string?
		CMPEQ	R4,#0			;And end of match string?
		BEQ	%80get__match		;Yes -- that's a match then
		SUB	R14,R4,#'a'		;Subtract the bottom limit
		CMP	R14,#26			;Is it a lower case letter?
		BICLO	R4,R4,#&20		;Yes -- convert to upper
		SUB	R14,R5,#'a'		;Subtract the bottom limit
		CMP	R14,#26			;Is it a lower case letter?
		BICLO	R5,R5,#&20		;Yes -- convert to upper
		CMP	R4,R5			;Do characters match up?
		LDREQB	R4,[R0],#1		;Load a byte from the table
		LDREQB	R5,[R3],#1		;Load a byte from the arg
		BEQ	%10get__match		;Yes -- go round for more

		; --- Failed -- find end of table entry ---

20get__match	CMP	R4,#0			;End of entry string?
		LDRNEB	R4,[R0],#1		;No -- load byte from table
		BNE	%20get__match		;And go round again
		ADD	R2,R2,#1		;Increment item index
		B	%00get__match		;Loop round for next entry

		; --- Found a match ---

80get__match	MOV	R0,R2			;Get the item index
		LDMFD	R13!,{R1-R5,R14}	;Unstack the registers
		ORRS	PC,R14,#C_flag		;And return with C set

		; --- No match found ---

90get__match	LDMFD	R13!,{R1-R5,R14}	;Unstack the registers
		BICS	PC,R14,#C_flag		;And return with C clear

		LTORG

;----- That's all, folks ----------------------------------------------------

		END

