~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / BAS / src / s / basTalk
1 ;
2 ; basTalk.s
3 ;
4 ; Interface to BASIC's weird routines
5 ;
6 ; © 1994-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's BASIC Assembler Supplement.
12 ;
13 ; BAS is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; BAS is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with BAS. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard Header ------------------------------------------------------
28
29 GET libs:header
30 GET libs:swis
31
32 GET libs:stream
33
34 ;----- External dependencies ------------------------------------------------
35
36 GET sh.basicEnv
37 GET sh.messages
38 GET sh.string
39 GET sh.workspace
40
41 ;----- Main code ------------------------------------------------------------
42
43 AREA |BAS$$Code|,CODE,READONLY
44
45 ; --- bTalk_lvblnk ---
46 ;
47 ; On entry: R0 == pointer to variable name to find (not tokenised)
48 ;
49 ; On exit: R0 == address of lvalue
50 ; R1 == type of lvalue
51 ;
52 ; Use: Tries to locate the given BASIC variable.
53
54 EXPORT bTalk_lvblnk
55 bTalk_lvblnk ROUT
56
57 STMFD R13!,{R0-R12,R14} ;Save some registers
58
59 ; --- Make sure name is tokenised ---
60
61 BL str_buffer ;Get a string buffer nicely
62 MOV R2,R1 ;This is the destination
63 MOV R11,R2 ;Keep a pointer to it
64 MOV R1,R0 ;Point to his source string
65 BL bTalk_match ;Tokenise the variable name
66
67 ; --- Find the lvalue ---
68
69 LDR R7,be__interface ;Point to EIB
70 LDR R8,be__argp ;Get argp pointer
71 LDR R12,be__line ;Get line pointer
72 MOV R14,PC ;Set up return address
73 ADD PC,R7,#bEnv_lvblnk ;Call BASIC's strange routine
74 MOVNE R1,R9 ;Get variable type in R1
75 ADDNE R13,R13,#8 ;Don't keep R0, R1 saved
76 LDMNEFD R13!,{R2-R12,PC}^ ;Return if found
77
78 ; --- Complain about duff variable names ---
79
80 bTalk__badName LDR R12,[R13,#48] ;Find workspace (good plan)
81 LDR R2,[R13,#0] ;Point to the variable name
82 ADRCSL R0,msg_errBadLValue ;If very bad, point to error
83 ADRCCL R0,msg_errVarNotFound ;Otherwise say couldn't find
84 BL str_error ;Build appropriate error
85 SWI OS_GenerateError ;And report it nicely
86
87 LTORG
88
89 ; --- bTalk_create ---
90 ;
91 ; On entry: R0 == pointer to name of variable
92 ;
93 ; On exit: R0 == address of variable lvalue
94 ; R1 == type of variable created
95 ;
96 ; Use: Creates a variable, if it doesn't already exist. Otherwise
97 ; a pointer to the existing variable is returned.
98
99 EXPORT bTalk_create
100 bTalk_create ROUT
101
102 STMFD R13!,{R0-R12,R14} ;Save too many registers
103
104 ; --- Make sure name is tokenised ---
105
106 BL str_buffer ;Get a string buffer nicely
107 MOV R2,R1 ;This is the destination
108 MOV R11,R2 ;Keep a pointer to it
109 MOV R1,R0 ;Point to his source string
110 BL bTalk_match ;Tokenise the variable name
111
112 ; --- Find the lvalue ---
113
114 LDR R7,be__interface ;Point to EIB
115 LDR R8,be__argp ;Get argp pointer
116 LDR R12,be__line ;Get line pointer
117 MOV R14,PC ;Set up return address
118 ADD PC,R7,#bEnv_lvblnk ;Call BASIC's strange routine
119 MOVNE R1,R9 ;Get variable type in R1
120 ADDNE R13,R13,#8 ;Don't keep R0, R1 saved
121 LDMNEFD R13!,{R2-R12,PC}^ ;Return if found
122 BCS bTalk__badName ;Contort rampantly on error
123
124 ; --- Wasn't there -- try to create it ---
125
126 MOV R14,PC ;Set up return address
127 ADD PC,R7,#bEnv_create ;Call CREATE routine
128 MOV R1,R9 ;Get the variable type
129 ADD R13,R13,#8 ;Don't keep R0, R1 saved
130 LDMFD R13!,{R2-R12,PC}^ ;Return pristine variable
131
132 LTORG
133
134 ; --- bTalk_store ---
135 ;
136 ; On entry: R0 == lvalue in which to store
137 ; R1 == type of lvalue
138 ; R2 == (integer) value to store
139 ;
140 ; On exit: --
141 ;
142 ; Use: Stores an integer value in a BASIC variable. The value is
143 ; converted to floating point if required (without loss of
144 ; precision).
145
146 EXPORT bTalk_store
147 bTalk_store ROUT
148
149 STMFD R13!,{R0-R12,R14} ;Save too many registers
150 MOV R4,R0 ;Point to the lvalue
151 MOV R5,R1 ;Get the lvalue's type
152 MOV R0,R2 ;Put value in R0
153 MOV R9,#&40000000 ;It's an integer, Jim
154 LDR R7,be__interface ;Find the EIB
155 LDR R8,be__argp ;Get BASIC's workspace
156 LDR R12,be__line ;Tell it which line we're on
157 MOV R14,PC ;Set up return address
158 ADD PC,R7,#bEnv_storea ;Save the values away
159 LDMFD R13!,{R0-R12,PC}^ ;Return to caller
160
161 LTORG
162
163 ; --- bTalk_load ---
164 ;
165 ; On entry: R0 == address of lvalue
166 ; R1 == type of lvalue
167 ;
168 ; On exit: R2 == integer value of lvalue
169 ;
170 ; Use: Loads an integer variable from an lvalue.
171
172 EXPORT bTalk_load
173 bTalk_load ROUT
174
175 STMFD R13!,{R0,R1,R3-R12,R14} ;Save lots of registers
176
177 ; --- Load value from register ---
178
179 LDR R8,be__argp ;Load BASIC's workspace
180 LDR R7,be__interface ;Find the EIB
181 LDR R12,be__line ;And get the current LINE
182
183 MOV R9,R1 ;Get the lvalue's type
184 MOV R14,PC ;Set up return address
185 ADD PC,R7,#bEnv_varind ;Load the variable value
186 TEQ R9,#0 ;Was it a string?
187 BEQ %80bTalk_load ;Yes -- this is evil
188
189 ; --- Now convert floating point to integer ---
190
191 MOVMI R14,PC ;Set up return address
192 ADDMI PC,R7,#bEnv_fix ;And fix it into R0
193
194 ; --- Return the value ---
195
196 MOV R2,R0 ;Put value in R2 nicely
197 LDMFD R13!,{R0,R1,R3-R12,PC}^ ;Return to caller
198
199 ; --- Silly user gave us a string ---
200
201 80bTalk_load ADRL R0,msg_errOddString ;Point to error
202 SWI OS_GenerateError ;And tell the world
203
204 LTORG
205
206 ; --- bTalk_eval ---
207 ;
208 ; On entry: R1 == pointer to a control-terminated string
209 ;
210 ; On exit: R0 == value of expression
211 ;
212 ; Use: Evaluates a BASIC expression.
213
214 EXPORT bTalk_eval
215 bTalk_eval ROUT
216
217 STMFD R13!,{R1-R12,R14} ;Save some registers
218 MOV R0,R1 ;Look after string address
219 BL str_buffer ;Get a string buffer
220 MOV R2,R1 ;This is destination buffer
221 MOV R1,R0 ;Point to source buffer
222 BL bTalk_match ;Tokenise the string nicely
223
224 ; --- Evaluate the expression ---
225
226 LDR R8,be__argp ;Load BASIC's workspace
227 LDR R7,be__interface ;Find the interface block
228 LDR R12,be__line ;Load current LINE value
229 MOV R11,R2 ;Point to tokenised expr
230 STMFD R13!,{R7} ;Save environment pointer
231 MOV R14,PC ;Set up return address
232 ADD PC,R7,#bEnv_expr ;Get BASIC to evaluate it
233 LDMFD R13!,{R7} ;Restore environment pointer
234 BEQ %80bTalk_eval ;If string, make an error
235
236 MOVMI R14,PC ;If floating point, fix it
237 ADDMI PC,R7,#bEnv_fix ;To get an integer
238
239 LDMFD R13!,{R1-R12,PC}^ ;And return value to caller
240
241 ; --- Expression gave us a string ---
242
243 80bTalk_eval ADRL R0,msg_errOddString ;Point to error message
244 SWI OS_GenerateError ;And raise an error nicely
245
246 LTORG
247
248 ; --- bTalk_match ---
249 ;
250 ; On entry: R1 == ctrl terminated string
251 ; R2 == destination pointer
252 ;
253 ; On exit: --
254 ;
255 ; Use: Tokenises the given sting, and puts the result in the
256 ; destination buffer given.
257
258 EXPORT bTalk_match
259 bTalk_match ROUT
260
261 STMFD R13!,{R0-R5,R14} ;Store some registers
262
263 ; --- BASIC wants string CR terminated ---
264
265 MOV R3,R1 ;Point to source string
266 00bTalk_match LDRB R14,[R3],#1 ;Load the next byte
267 CMP R14,#32 ;Is this the end of it?
268 BCS %00bTalk_match ;No -- go round again then
269 MOV R14,#13 ;Want it CR terminated
270 STRB R14,[R3,#-1] ;Save over terminator
271
272 ; --- Get BASIC to do tokenising ---
273
274 MOV R3,#0 ;Parse an lvalue
275 MOV R4,#0 ;Without line numbers
276 LDR R5,be__interface ;Get the EIB
277 MOV R14,PC ;Set up return address
278 ADD PC,R5,#bEnv_match ;Call match routine
279 LDMFD R13!,{R0-R5,PC}^ ;Return with gleefulness
280
281 LTORG
282
283 ;----- That's all, folks ----------------------------------------------------
284
285 END
The Straylight Source Distribution (obsolete software for RISC OS)