;
; var.s
;
; Variable handling
;
; © 1995 Straylight
;

;----- Standard Header ------------------------------------------------------

		GET	libs:header
		GET	libs:swis

		GET	libs:stream

;----- External dependencies ------------------------------------------------

		GET	sh.anchor
		GET	sh.errNum
		GET	sh.error
		GET	sh.tree

;----- Other definitions ----------------------------------------------------

var__chunkSize	EQU	256			;Chunck size of var stack

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

		AREA	|TermScript$$Code|,CODE,READONLY

; --- var_create ---
;
; On entry:	R0 == type of variable
;		R1 == pointer to variable name
;		R12 == pointer to the anchor block
;		Other registers depend on the type
;		vType_label, vType_proc, vType_fn:
;		  R2 == file offset of label of DEF
;		  R3 == line number of label or DEF
;		vType_dimInt, vType_dimStr:
;		  R2 == pointer to subscript block (in *reverse* order)
;		  R3 == number of subscripts
;		  R4 == number of items to create
;
; On exit:	R0 == pointer to the variable
;
; Use:		Tries to find the variable given, and return a pointer
;		to it if it is found. Otherwise it will try to create the
;		variable and return a pointer to the new one.

		EXPORT	var_create
var_create	ROUT

		ADD	PC,PC,R0,LSL #2		;Branch to correct dispatcher
		DCB	"TMA!"			;A little padding

		B	var__normal
		B	var__normal
		B	var__dim
		B	var__dim
		B	var__label
		B	var__label
		B	var__label

		LTORG

; --- var_find ---
;
; On entry:	R0 == type of the variable
;		R1 == name of the variable
;
; On exit:	CS if the variable was found, and
;		  R0 == pointer to the variable block
;		else CC and
;		  R0 corrupted
;
; Use:		Tries to find the given variable in the current tree.

		EXPORT	var_find
var_find	ROUT

		STMFD	R13!,{R2,R14}		;Save some registers
		MOV	R2,R0			;Look after the type
		BL	tree_find		;Find the variable
		LDMCSFD	R13!,{R2,PC}^		;If found, return now
		CMP	R2,#vType_dimInt	;Is it an integer array?
		CMPNE	R2,#vType_dimStr	;Or a string array?
		MOVEQ	R0,#err_ukArray		;Yes -- find `unknown array'
		MOVNE	R0,#err_unknown		;No -- use `unknown var'
		B	error_report		;And report it to the world

		LTORG

;----- Variable creation routines -------------------------------------------
;
; On entry:	R0 == variable type
;		R1 == address of variable name

; --- var__normal ---

var__normal	ROUT

		STMFD	R13!,{R1-R4,R14}	;Stack registers

		; --- Allocate space for the variable ---

		MOV	R2,#8			;Variable requires 16 bytes
		BL	tree_add		;Add it to the symbol table
		BVS	var__error		;Return possible error

		MOV	R14,#0			;Initialise the value
		STRCC	R14,[R0,#4]		;Set this up nicely
		LDMFD	R13!,{R1-R4,PC}^	;And return to caller

; --- var__dim ---

var__dim	ROUT

		STMFD	R13!,{R1-R6,R14}	;Stack registers
		ADD	R5,R2,R3,LSL #2		;Look after subscript block
		MOV	R2,#12			;Room for name + num of subs
		ADD	R2,R2,R3,LSL #2		;Add room for sizes
		ADD	R2,R2,R4,LSL #2		;And subscripts themselves
		BL	tree_add		;Try to allocate space
		BVS	var__error		;Barf on error
		STR	R3,[R0,#4]		;Store number of subscripts
		STR	R4,[R0,#8]		;Store total number of items
		ADD	R6,R0,#12		;Point to the first size

		; --- Set up the subscript sizes ---

00		LDR	R14,[R5,#-4]!		;Load the subscript size
		STR	R14,[R6],#4		;Store that in the block
		SUBS	R3,R3,#1		;Reduce subscript count
		BGT	%b00			;Keep filling in block

		; --- Initialise all the entries ---

		MOV	R14,#0			;Initialiser
00		STR	R14,[R6],#4		;Set entry to 0
		SUBS	R4,R4,#1		;Reduce the item count
		BGT	%b00			;Keep on initialising

		LDMFD	R13!,{R1-R6,PC}^	;Return to caller

		LTORG

; --- var__label ---

var__label	ROUT

		STMFD	R13!,{R1-R4,R14}	;Stack registers
		LDR	R14,sail_tokAnchor	;Find anchor of t'ised file
		LDR	R14,[R14]		;I hate WimpExt_Heap
		SUB	R4,R2,R14		;Make the address an offset

		; --- Allocate space for the variable ---

		MOV	R2,#12			;Variable requires 16 bytes
		BL	tree_add		;Add it to the symbol table
		BVS	var__error		;Return possible error

		; --- Fill in the block ---

		MOV	R2,R4			;Get the file offset
		STMIB	R0,{R2,R3}		;Store the informtion
		LDMFD	R13!,{R1-R4,PC}^	;Unstack registers

var__error	MOV	R0,#err_noMem		;Get the error number
		B	error_report		;And report the error

		LTORG

;----- Workspace ------------------------------------------------------------

		; --- Variable types ---

		^	0
vType_integer	#	1			;Integer
vType_string	#	1			;String
vType_dimInt	#	1			;DIM of integers
vType_dimStr	#	1			;DIM of strings
vType_label	#	1			;Label
vType_proc	#	1			;Procedure name
vType_fn	#	1			;Function name

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

		END