;
; basTalk.s
;
; Interface to BASIC's weird routines
;
; © 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.basicEnv
		GET	sh.messages
		GET	sh.string
		GET	sh.workspace

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

		AREA	|BAS$$Code|,CODE,READONLY

; --- bTalk_lvblnk ---
;
; On entry:	R0 == pointer to variable name to find (not tokenised)
;
; On exit:	R0 == address of lvalue
;		R1 == type of lvalue
;
; Use:		Tries to locate the given BASIC variable.

		EXPORT	bTalk_lvblnk
bTalk_lvblnk	ROUT

		STMFD	R13!,{R0-R12,R14}	;Save some registers

		; --- Make sure name is tokenised ---

		BL	str_buffer		;Get a string buffer nicely
		MOV	R2,R1			;This is the destination
		MOV	R11,R2			;Keep a pointer to it
		MOV	R1,R0			;Point to his source string
		BL	bTalk_match		;Tokenise the variable name

		; --- Find the lvalue ---

		LDR	R7,be__interface	;Point to EIB
		LDR	R8,be__argp		;Get argp pointer
		LDR	R12,be__line		;Get line pointer
		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_lvblnk	;Call BASIC's strange routine
		MOVNE	R1,R9			;Get variable type in R1
		ADDNE	R13,R13,#8		;Don't keep R0, R1 saved
		LDMNEFD	R13!,{R2-R12,PC}^	;Return if found

		; --- Complain about duff variable names ---

bTalk__badName	LDR	R12,[R13,#48]		;Find workspace (good plan)
		LDR	R2,[R13,#0]		;Point to the variable name
		ADRCSL	R0,msg_errBadLValue	;If very bad, point to error
		ADRCCL	R0,msg_errVarNotFound	;Otherwise say couldn't find
		BL	str_error		;Build appropriate error
		SWI	OS_GenerateError	;And report it nicely

		LTORG

; --- bTalk_create ---
;
; On entry:	R0 == pointer to name of variable
;
; On exit:	R0 == address of variable lvalue
;		R1 == type of variable created
;
; Use:		Creates a variable, if it doesn't already exist.  Otherwise
;		a pointer to the existing variable is returned.

		EXPORT	bTalk_create
bTalk_create	ROUT

		STMFD	R13!,{R0-R12,R14}	;Save too many registers

		; --- Make sure name is tokenised ---

		BL	str_buffer		;Get a string buffer nicely
		MOV	R2,R1			;This is the destination
		MOV	R11,R2			;Keep a pointer to it
		MOV	R1,R0			;Point to his source string
		BL	bTalk_match		;Tokenise the variable name

		; --- Find the lvalue ---

		LDR	R7,be__interface	;Point to EIB
		LDR	R8,be__argp		;Get argp pointer
		LDR	R12,be__line		;Get line pointer
		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_lvblnk	;Call BASIC's strange routine
		MOVNE	R1,R9			;Get variable type in R1
		ADDNE	R13,R13,#8		;Don't keep R0, R1 saved
		LDMNEFD	R13!,{R2-R12,PC}^	;Return if found
		BCS	bTalk__badName		;Contort rampantly on error

		; --- Wasn't there -- try to create it ---

		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_create	;Call CREATE routine
		MOV	R1,R9			;Get the variable type
		ADD	R13,R13,#8		;Don't keep R0, R1 saved
		LDMFD	R13!,{R2-R12,PC}^	;Return pristine variable

		LTORG

; --- bTalk_store ---
;
; On entry:	R0 == lvalue in which to store
;		R1 == type of lvalue
;		R2 == (integer) value to store
;
; On exit:	--
;
; Use:		Stores an integer value in a BASIC variable.  The value is
;		converted to floating point if required (without loss of
;		precision).

		EXPORT	bTalk_store
bTalk_store	ROUT

		STMFD	R13!,{R0-R12,R14}	;Save too many registers
		MOV	R4,R0			;Point to the lvalue
		MOV	R5,R1			;Get the lvalue's type
		MOV	R0,R2			;Put value in R0
		MOV	R9,#&40000000		;It's an integer, Jim
		LDR	R7,be__interface	;Find the EIB
		LDR	R8,be__argp		;Get BASIC's workspace
		LDR	R12,be__line		;Tell it which line we're on
		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_storea	;Save the values away
		LDMFD	R13!,{R0-R12,PC}^	;Return to caller

		LTORG

; --- bTalk_load ---
;
; On entry:	R0 == address of lvalue
;		R1 == type of lvalue
;
; On exit:	R2 == integer value of lvalue
;
; Use:		Loads an integer variable from an lvalue.

		EXPORT	bTalk_load
bTalk_load	ROUT

		STMFD	R13!,{R0,R1,R3-R12,R14}	;Save lots of registers

		; --- Load value from register ---

		LDR	R8,be__argp		;Load BASIC's workspace
		LDR	R7,be__interface	;Find the EIB
		LDR	R12,be__line		;And get the current LINE

		MOV	R9,R1			;Get the lvalue's type
		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_varind	;Load the variable value
		TEQ	R9,#0			;Was it a string?
		BEQ	%80bTalk_load		;Yes -- this is evil

		; --- Now convert floating point to integer ---

		MOVMI	R14,PC			;Set up return address
		ADDMI	PC,R7,#bEnv_fix		;And fix it into R0

		; --- Return the value ---

		MOV	R2,R0			;Put value in R2 nicely
		LDMFD	R13!,{R0,R1,R3-R12,PC}^	;Return to caller

		; --- Silly user gave us a string ---

80bTalk_load	ADRL	R0,msg_errOddString	;Point to error
		SWI	OS_GenerateError	;And tell the world

		LTORG

; --- bTalk_eval ---
;
; On entry:	R1 == pointer to a control-terminated string
;
; On exit:	R0 == value of expression
;
; Use:		Evaluates a BASIC expression.

		EXPORT	bTalk_eval
bTalk_eval	ROUT

		STMFD	R13!,{R1-R12,R14}	;Save some registers
		MOV	R0,R1			;Look after string address
		BL	str_buffer		;Get a string buffer
		MOV	R2,R1			;This is destination buffer
		MOV	R1,R0			;Point to source buffer
		BL	bTalk_match		;Tokenise the string nicely

		; --- Evaluate the expression ---

		LDR	R8,be__argp		;Load BASIC's workspace
		LDR	R7,be__interface	;Find the interface block
		LDR	R12,be__line		;Load current LINE value
		MOV	R11,R2			;Point to tokenised expr
		STMFD	R13!,{R7}		;Save environment pointer
		MOV	R14,PC			;Set up return address
		ADD	PC,R7,#bEnv_expr	;Get BASIC to evaluate it
		LDMFD	R13!,{R7}		;Restore environment pointer
		BEQ	%80bTalk_eval		;If string, make an error

		MOVMI	R14,PC			;If floating point, fix it
		ADDMI	PC,R7,#bEnv_fix		;To get an integer

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

		; --- Expression gave us a string ---

80bTalk_eval	ADRL	R0,msg_errOddString	;Point to error message
		SWI	OS_GenerateError	;And raise an error nicely

		LTORG

; --- bTalk_match ---
;
; On entry:	R1 == ctrl terminated string
;		R2 == destination pointer
;
; On exit:	--
;
; Use:		Tokenises the given sting, and puts the result in the
;		destination buffer given.

		EXPORT	bTalk_match
bTalk_match	ROUT

		STMFD	R13!,{R0-R5,R14}	;Store some registers

		; --- BASIC wants string CR terminated ---

		MOV	R3,R1			;Point to source string
00bTalk_match	LDRB	R14,[R3],#1		;Load the next byte
		CMP	R14,#32			;Is this the end of it?
		BCS	%00bTalk_match		;No -- go round again then
		MOV	R14,#13			;Want it CR terminated
		STRB	R14,[R3,#-1]		;Save over terminator

		; --- Get BASIC to do tokenising ---

		MOV	R3,#0			;Parse an lvalue
		MOV	R4,#0			;Without line numbers
		LDR	R5,be__interface	;Get the EIB
		MOV	R14,PC			;Set up return address
		ADD	PC,R5,#bEnv_match	;Call match routine
		LDMFD	R13!,{R0-R5,PC}^	;Return with gleefulness

		LTORG

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

		END