;
; csapph.s
;
; C support for Sapphire programs
;
; © 1995 Straylight
;

;----- Notice ---------------------------------------------------------------
;
; We haven't lost our minds.  We aren't planning to move over to development
; in C.  Nothing like that.  This will allow us to use C code from other
; sources (a bit) in Sapphire programs, and maybe sort out algorithms before
; committing to register allocations.

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

		GET	libs:header
		GET	libs:swis

		GET	libs:stream

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

		AREA	|Sapphire$$Code|,CODE,READONLY

; --- __sapph_veneer ---
;
; On entry:	R0-R12 == argument registers
;		R14 == routine to call
;		Return address on stack
;
; On exit:	R0-R12 == returned values
;		Flags may be altered by called routine
;
; Use:		Calls a C routine, passing it arguments, and getting results
;		back.

		EXPORT	|__sapph_veneer|
|__sapph_veneer| ROUT

		STMFD	R13!,{R0-R12,PC}	;Save registers
		MOV	sl,R11			;Look after env pointer
		MOV	a1,R13			;Point to the regset
		MOV	a2,R10			;Pass object pointer
		MOV	a3,R12			;Pass workspace pointer
		MOV	a4,R11			;And the scratchpad
		MOV	fp,#0			;Terminate stack frame list

		MOV	ip,R14			;Point to the routine
		MOV	lr,pc			;Set up a return address
		MOV	pc,ip			;And call the routine

		LDR	ip,[R13,#52]		;Load the flags word
		AND	a2,a1,#&F0		;Get the mask bits out
		BIC	ip,ip,a2,LSL #24	;Mask some flags out
		TEQP	ip,a1,LSL #28		;Toggle and set the flags
		MOV	R0,R0			;No-op
		LDMFD	R13!,{R0-R12,R14,PC}	;And return to caller

		LTORG

; --- call ---
;
; On entry:	a1 == pointer to routine
;		a2 == pointer to regset
;
; On exit:	a1 == 0, or pointer to error, as seems to be usual
;
; Use:		Calls a random routine in Sapphire, or anywhere else.  The
;		Scratchpad pointer is forced into R11.

		EXPORT	call
call		ROUT

		STMFD	sp!,{a1,a2,v1-v6,sl,fp,ip,lr} ;Save lots of registers
		STR	sl,[a2,#44]		;Store Scratchpad away
		MOV	lr,pc			;Set up current flags
		AND	lr,lr,#&0C000003	;Leave important flags
		TEQP	lr,#0			;Clear the others please
		LDMIA	a2,{R0-R12}		;Load lots of registers
		MOV	lr,pc			;Set up return address
		LDR	pc,[sp],#4		;Call the routine
		LDR	lr,[sp],#4		;Load the base address back
		STMIA	lr,{R0-R12,PC}		;Store all the registers
		MOVVC	R0,#0			;If no error, return 0
		LDMFD	sp!,{v1-v6,sl,fp,ip,pc}^ ;And return to caller

		LTORG

; --- swi ---
;
; On entry:	R0 == SWI number
;		R1 == pointer to regset
;
; On exit:	R0 == zero, or pointer to error
;
; Use:		Calls a SWI in a versatile, fast, and inconvenient way.

		EXPORT	swi
swi		ROUT

		STMFD	R13!,{R4-R10,R14}	;Save some registers
		MOV	R10,R1			;Remember this pointer
		ORR	R0,R0,#&EF000000	;Make the SWI number
		LDR	R14,=&E1A0F00C		;Get the return instruction
		STMFD	R13!,{R0,R14}		;Save them on the stack
		LDMIA	R10,{R0-R9}		;Load registers to pass
		MOV	R12,PC			;Set up return address
		MOV	PC,R13			;Call the SWI instruction
		STMIA	R10,{R0-R9}		;Store the output registers
		STR	PC,[R10,#52]		;Store the output flags too
		MOVVC	R0,#0			;If no error, return zero
		ADD	R13,R13,#8		;Restore stack pointer
		LDMFD	R13!,{R4-R10,PC}^	;And return to caller

		LTORG

		GBLL	OPT_CALL
		GBLL	OPT_SAPPHIRE
		GET	libs:s.xswi

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

		END