;
; bas.s
;
; Base code for BAS
;
;  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.basicEnv
		GET	sh.basTalk
		GET	sh.fastMove
		GET	sh.flex
		GET	sh.get
		GET	sh.insert
		GET	sh.lit
		GET	sh.messages
		GET	sh.string
		GET	sh.vars
		GET	sh.workspace

;----- Branch table header --------------------------------------------------

		AREA	|!BAS$$Header|,CODE,READONLY

		B	bas__workSize		;Find workspace requirements
		B	bas__init		;Initialise workspace
		B	aof_init		;Initialise AOF generation
		B	aof_pass		;Signal start of new pass
		B	aof_iImport		;Import a symbol
		B	aof_export		;Export a symbol
		B	get			;Read in a header file
		B	aof_area		;Define start of new area
		B	aof_reloc		;Mark start of reloc area
		B	aof_noReloc		;Mark start of non-reloc area
		B	aof_entry		;Define entry point of image
		B	aof_save		;Save AOF file
		B	insert_align		;Align and add zeroes
		B	insert_reserve		;Reserve lots of zeroes
		B	lit_add			;Add data to literal pool
		B	lit_ltorg		;Insert a literal pool
		B	bas__saveOpt		;Read the current OPT value
		B	bas__restoreOpt		;Restore the OPT value

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

		AREA	|BAS$$Code|,CODE,READONLY

; --- bas__workSize ---
;
; On entry:	--
;
; On exit:	R0 == size of workspace required (picked up by USR())
;
; Use:		Allows the BASIC component to allocate a workspace block of
;		the right size.  This will then be passed to us in R7 when
;		we get called later.

bas__workSize	ROUT

		LDR	R0,=bas_wSize		;Get the workspace size
		MOVS	PC,R14			;And return to caller

		LTORG

; --- bas__init ---
;
; On entry:	R7 == address of workspace
;		R8-R14 from BASIC's CALL
;
; On exit:	--
;
; Use:		Initialises the code component of BAS.

bas__init	ROUT

		STMFD	R13!,{R12,R14}		;Save some registers
		STR	R12,[R7,#:INDEX:be__line] ;Store line value
		MOV	R12,R7			;Point to my workspace

		; --- Fill in the BASIC environment things ---

		STR	R8,be__argp		;Save BASIC's workspace addr
		STR	R14,be__interface	;And save the interface ptr

		; --- Set up some special bits ---

		MOV	R14,#0			;Set up string's buffer
		STR	R14,str__buffNum	;Tell it to use the first one
		STR	R14,aof__objHead	;We're not generating AOF

		; --- Work out address of A% ---

		ADR	R0,bas__aPercent	;Find the variable name
		BL	bTalk_lvblnk		;Find the address of it
		STR	R0,be__percents		;Save this address

		; --- Start up our memory manager ---

		BL	flex_init		;Initialise flex
		BL	vars_set		;Set up register names etc.

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

bas__aPercent	DCB	"A%",0

		LTORG

; --- bas__saveOpt ---
;
; On entry:	R8 == BASIC's ARGP pointer
;
; On exit:	R0 == current value of OPT
;
; Use:		Returns the current value of BASIC's assembler options.  This
;		is handy, because BASIC doesn't seem terribly good at
;		handling this by itself.  The value -38 used here is stolen
;		from BAX.

bas__saveOpt	ROUT

		LDRB	R0,[R8,#-38]		;Load the OPT value
		MOVS	PC,R14			;And return to caller

		LTORG

; --- bas__restoreOpt ---
;
; On entry:	R0 == OPT value to restore
;		R8 == BASIC's ARGP pointer
;
; On exit:	--
;
; Use:		Sets the value of BASIC's assembler options to the given
;		value.  This is necessary because BASIC isn't terribly good
;		at nesting the option values.

bas__restoreOpt	ROUT

		STRB	R0,[R8,#-38]		;Store the OPT value
		MOVS	PC,R14			;And return to caller

		LTORG

; --- bas_argString ---
;
; On entry:	R1 == address of destination buffer
;		R9 == pointer to argument entry
;		R10 == number of arguments left
;
; On exit:	R9 increased by 8
;		R10 decreased by 1
;
; Use:		Reads a string argument into a buffer and null terminates
;		it sensibly so we can use it.

		EXPORT	bas_argString
bas_argString	ROUT

		STMFD	R13!,{R0-R3,R14}	;Save some registers
		SUBS	R10,R10,#1		;Decrement R10 as promised
		BCC	bas_badCall		;If there wasn't one, die
		LDR	R14,[R9,#4]		;Load the argument type
		CMP	R14,#&81		;Is this a $(addr) string?
		BEQ	%50bas_argString	;Yes -- handle that then
		CMP	R14,#&80		;Is it a normal string?
		BNE	bas_badCall		;No -- the make an error

		; --- Handle a normal string variable ---

		MOV	R0,R1			;Point to caller's buffer
		LDR	R3,[R9],#8		;Load the string pointer
		ANDS	R14,R3,#3		;Get non-word-alignedness
		BIC	R1,R3,#3		;Word align anyway
		LDMIA	R1,{R1,R2}		;Load the possible bytes
		MOV	R14,R14,LSL #3		;Convert bytes to bits
		MOVNE	R1,R1,LSR R14		;Shove the bytes down
		RSB	R14,R14,#32		;Get the other shift size
		ORRNE	R1,R1,R2,LSL R14	;And work that out
		LDRB	R2,[R3,#4]		;Load the string length
		BL	fastMove		;(This is overkill)
		MOV	R14,#0			;Terminate the string
		STRB	R14,[R0,R2]		;Do this nicely
		B	%90bas_argString	;And return to caller

		; --- Handle a $(addr) type string ---

50bas_argString	MOV	R2,R1			;Keep the buffer pointer
		MOV	R0,R1			;And point to it for str_cpy
		LDR	R1,[R9],#8		;Point to caller's string
		BL	str_cpy			;Copy it over (and null term)

90bas_argString	LDMFD	R13!,{R0-R3,PC}^	;Return to caller

		LTORG

; --- bas_badCall ---
;
; On entry:	--
;
; On exit:	Generates an error
;
; Use:		Generates an error about bad arguments.  It saves space to
;		just have this here.

		EXPORT	bas_badCall
bas_badCall	ROUT

		ADRL	R0,msg_errBadArg
		SWI	OS_GenerateError

		LTORG

; --- bas_noMem ---
;
; On entry:	--
;
; On exit:	Generates an error
;
; Use:		Generates an error about not having any memory left.


		EXPORT	bas_noMem
bas_noMem	ROUT

		ADRL	R0,msg_errNoMoreMem
		SWI	OS_GenerateError

		LTORG

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

		END
