;
; env.s
;
; Environment handling for SAIL
;
; © 1995 Straylight
;

;----- Standard header ------------------------------------------------------

		GET	libs:header
		GET	libs:swis

		GET	libs:stream

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

		GET	sapphire:subAlloc

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

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- sail_createEnv ---
;
; On entry:	R0 == parent environment handle or 0
;		R1 == address of CALL table
;
; On exit:	R0 == environment handle
;		May return an error
;
; Use:		Creates an environment.
;
;		The CALL tabe format is as follows:
;
;		string		prefix
;		align
;		word		size of data for this prefix
;		align
;		string		name of call
;		word		address to call
;		...
;		word		0

		EXPORT	sail_createEnv

sail_createEnv ROUT

		STMFD	R13!,{R1,R2,R14}	;Stach registers

		MOV	R2,R0			;Look after handle
		MOV	R0,#sEnv__size		;Get the size
		BL	sub_alloc		;Allocate it then
		BVS	%90			;Jump ahead with glum

		STR	R2,[R0,#sEnv__parent]	;Store the parent handle
		STR	R1,[R0,#sEnv__table]	;Store call table address
		MOV	R14,#0			;I like this value
		STR	R14,[R0,#sEnv__next]	;No next block yet
90		LDMFD	R13!,{R1,R2,R14}	;Load back registers
		ORRVSS	PC,R14,#V_flag		;Return with error
		BICVCS	PC,R14,#V_flag		;Return without error

		LTORG

; --- sail_addCalls ---
;
; On entry:	R0 == environment handle
;		R1 == address of new call table
;
; On exit:	May return an error
;
; Use:		Adds an extra CALL table to an environment.  Useful
;		for extension DLLs.

		EXPORT	sail_addCalls
sail_addCalls	ROUT

		ASSERT	sEnv__next=sCall__next
		ASSERT	sEnv__table=sCall__table

		STMFD	R13!,{R0-R3,R14}	;Stack register
		MOV	R3,R1			;Look after the call table
		ADD	R2,R0,#sEnv__next	;Point to the next entry
00		LDR	R14,[R2,#sCall__next]	;Load the next pointer
		CMP	R14,#0			;Is there one?
		MOVNE	R2,R14			;No -- point to next one
		BNE	%b00			;...and do this lots

		MOV	R0,#sEnv__callSize	;Get the size to allocate
		BL	sub_alloc		;Allocate it then
		BVS	%95			;Report possible error

		STR	R0,[R2,#sCall__next]	;Store this as next pointer
		STR	R3,[R0,#sCall__table]	;Store the table pointer
		MOV	R14,#0			;A NULL word
		STR	R14,[R0,#sCall__next]	;No next pointer yet

		LDMFD	R13!,{R0-R3,R14}	;Load back register
		BICS	PC,R14,#V_flag		;Return without error

90		LDMFD	R13!,{R0-R3,R14}	;Load back register
		ORRS	PC,R14,#V_flag		;Return with error

		LTORG

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

; --- Environment block ---

		^	0
sEnv__start	#	0
sEnv__next	#	4			;Pointer to next call table
sEnv__table	#	4			;Pointer to the call table
sEnv__parent	#	4			;Parent environment
sEnv__size	#	0			;Size of the structure

; --- The call block ---

		^	0
sCall__start	#	0
sCall__next	#	4
sCall__table	#	4

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

		END