Initial revision
[ssr] / StraySrc / Libraries / Sapphire / csapph / s / csapph
1 ;
2 ; csapph.s
3 ;
4 ; C support for Sapphire programs
5 ;
6 ; © 1995 Straylight
7 ;
8
9 ;----- Notice ---------------------------------------------------------------
10 ;
11 ; We haven't lost our minds. We aren't planning to move over to development
12 ; in C. Nothing like that. This will allow us to use C code from other
13 ; sources (a bit) in Sapphire programs, and maybe sort out algorithms before
14 ; committing to register allocations.
15
16 ;----- Standard header ------------------------------------------------------
17
18 GET libs:header
19 GET libs:swis
20
21 GET libs:stream
22
23 ;----- Main code ------------------------------------------------------------
24
25 AREA |Sapphire$$Code|,CODE,READONLY
26
27 ; --- __sapph_veneer ---
28 ;
29 ; On entry: R0-R12 == argument registers
30 ; R14 == routine to call
31 ; Return address on stack
32 ;
33 ; On exit: R0-R12 == returned values
34 ; Flags may be altered by called routine
35 ;
36 ; Use: Calls a C routine, passing it arguments, and getting results
37 ; back.
38
39 EXPORT |__sapph_veneer|
40 |__sapph_veneer| ROUT
41
42 STMFD R13!,{R0-R12,PC} ;Save registers
43 MOV sl,R11 ;Look after env pointer
44 MOV a1,R13 ;Point to the regset
45 MOV a2,R10 ;Pass object pointer
46 MOV a3,R12 ;Pass workspace pointer
47 MOV a4,R11 ;And the scratchpad
48 MOV fp,#0 ;Terminate stack frame list
49
50 MOV ip,R14 ;Point to the routine
51 MOV lr,pc ;Set up a return address
52 MOV pc,ip ;And call the routine
53
54 LDR ip,[R13,#52] ;Load the flags word
55 AND a2,a1,#&F0 ;Get the mask bits out
56 BIC ip,ip,a2,LSL #24 ;Mask some flags out
57 TEQP ip,a1,LSL #28 ;Toggle and set the flags
58 MOV R0,R0 ;No-op
59 LDMFD R13!,{R0-R12,R14,PC} ;And return to caller
60
61 LTORG
62
63 ; --- call ---
64 ;
65 ; On entry: a1 == pointer to routine
66 ; a2 == pointer to regset
67 ;
68 ; On exit: a1 == 0, or pointer to error, as seems to be usual
69 ;
70 ; Use: Calls a random routine in Sapphire, or anywhere else. The
71 ; Scratchpad pointer is forced into R11.
72
73 EXPORT call
74 call ROUT
75
76 STMFD sp!,{a1,a2,v1-v6,sl,fp,ip,lr} ;Save lots of registers
77 STR sl,[a2,#44] ;Store Scratchpad away
78 MOV lr,pc ;Set up current flags
79 AND lr,lr,#&0C000003 ;Leave important flags
80 TEQP lr,#0 ;Clear the others please
81 LDMIA a2,{R0-R12} ;Load lots of registers
82 MOV lr,pc ;Set up return address
83 LDR pc,[sp],#4 ;Call the routine
84 LDR lr,[sp],#4 ;Load the base address back
85 STMIA lr,{R0-R12,PC} ;Store all the registers
86 MOVVC R0,#0 ;If no error, return 0
87 LDMFD sp!,{v1-v6,sl,fp,ip,pc}^ ;And return to caller
88
89 LTORG
90
91 ; --- swi ---
92 ;
93 ; On entry: R0 == SWI number
94 ; R1 == pointer to regset
95 ;
96 ; On exit: R0 == zero, or pointer to error
97 ;
98 ; Use: Calls a SWI in a versatile, fast, and inconvenient way.
99
100 EXPORT swi
101 swi ROUT
102
103 STMFD R13!,{R4-R10,R14} ;Save some registers
104 MOV R10,R1 ;Remember this pointer
105 ORR R0,R0,#&EF000000 ;Make the SWI number
106 LDR R14,=&E1A0F00C ;Get the return instruction
107 STMFD R13!,{R0,R14} ;Save them on the stack
108 LDMIA R10,{R0-R9} ;Load registers to pass
109 MOV R12,PC ;Set up return address
110 MOV PC,R13 ;Call the SWI instruction
111 STMIA R10,{R0-R9} ;Store the output registers
112 STR PC,[R10,#52] ;Store the output flags too
113 MOVVC R0,#0 ;If no error, return zero
114 ADD R13,R13,#8 ;Restore stack pointer
115 LDMFD R13!,{R4-R10,PC}^ ;And return to caller
116
117 LTORG
118
119 GBLL OPT_CALL
120 GBLL OPT_SAPPHIRE
121 GET libs:s.xswi
122
123 ;----- That's all, folks ----------------------------------------------------
124
125 END