Commit | Line | Data |
---|---|---|
c1b567d8 MW |
1 | REM Basic Assembler Supplement 1.00 © 1996-1998 Straylight |
2 | REMÂÁÓhack | |
3 | ||
4 | REM ----- Licensing note ---------------------------------------------------- | |
5 | REM | |
6 | REM This file is part of Straylight's BASIC Assembler Supplement (BAS) | |
7 | REM | |
8 | REM BAS is free software; you can redistribute it and/or modify | |
9 | REM it under the terms of the GNU General Public License as published by | |
10 | REM the Free Software Foundation; either version 2, or (at your option) | |
11 | REM any later version | |
12 | REM | |
13 | REM BAS is distributed in the hope that it will be useful, | |
14 | REM but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | REM GNU General Public License for more details. | |
17 | REM | |
18 | REM You should have received a copy of the GNU General Public License | |
19 | REM along with BAS. If not, write to the Free Software Foundation, | |
20 | REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
21 | ||
22 | REM --- Hacking warning --- | |
23 | REM | |
24 | REM That gorp on the second line is a magic marker word inserted by hand | |
25 | REM (the three letters `BAS' with their top bits set) and space for an offset | |
26 | REM word which marks the offset of the code section from the beginning of | |
27 | REM the LIBRARY link block. Don't play with them unless you (a) know what | |
28 | REM you're doing (and it should be perfectly clear by now that I don't have | |
29 | REM a clue), and (b) want to seriously upset the library search code below. | |
30 | ||
31 | ERROR 0,"You can't run the Basic Assembler Supplement" | |
32 | ||
33 | REM --- A note --- | |
34 | REM | |
35 | REM To make this program particularly easy to strip down and transmogrify, | |
36 | REM it contains directives which are picked up by a sed script during | |
37 | REM munging. The directives currently are `del ... edel' which deletes | |
38 | REM all the enclosed lines, and `hex' which inserts the generated hex version | |
39 | REM of the library search code. Directives are enclosed in square brackets. | |
40 | REM It's usual to put them in REM statements. | |
41 | ||
42 | REM ----- Initialisation ---------------------------------------------------- | |
43 | ||
44 | REM [del] | |
45 | DEF FNbas_assign(RETURN d,v%):d=v%:=0 | |
46 | DEF PROCbas_const(var$,val%) | |
47 | IF bas_cf% THEN BPUT #bas_cf%,"/\<"+var$+"\>/s//"+STR$(val%)+"/g" | |
48 | IF EVAL("FNbas_assign("+var$+",val%)") | |
49 | ENDPROC | |
50 | ||
51 | DEF FNnext:R%+=4:=R%-4 | |
52 | ||
53 | DEF PROCbas_saveconst | |
54 | bas_cf%=OPENOUT("work.basconst") | |
55 | ||
56 | DEF PROCbas_constants | |
57 | bas_cf%=bas_cf% | |
58 | R%=0 | |
59 | PROCbas_const("bcode_wSize",FNnext) | |
60 | PROCbas_const("bcode_init",FNnext) | |
61 | PROCbas_const("bcode_aofInit",FNnext) | |
62 | PROCbas_const("bcode_newPass",FNnext) | |
63 | PROCbas_const("bcode_import",FNnext) | |
64 | PROCbas_const("bcode_export",FNnext) | |
65 | PROCbas_const("bcode_get",FNnext) | |
66 | PROCbas_const("bcode_area",FNnext) | |
67 | PROCbas_const("bcode_reloc",FNnext) | |
68 | PROCbas_const("bcode_noReloc",FNnext) | |
69 | PROCbas_const("bcode_entry",FNnext) | |
70 | PROCbas_const("bcode_save",FNnext) | |
71 | PROCbas_const("bcode_align",FNnext) | |
72 | PROCbas_const("bcode_reserve",FNnext) | |
73 | PROCbas_const("bcode_lit",FNnext) | |
74 | PROCbas_const("bcode_ltorg",FNnext) | |
75 | PROCbas_const("bcode_saveOpt",FNnext) | |
76 | PROCbas_const("bcode_restoreOpt",FNnext) | |
77 | IF bas_cf% THEN CLOSE #bas_cf% | |
78 | ENDPROC | |
79 | REM [edel] | |
80 | ||
81 | REM --- Unexplainable horridness --- | |
82 | REM | |
83 | REM Tim wants to be able to embed the code into this library file, so | |
84 | REM that it doesn't have to be searched for. I'll therefore have to write | |
85 | REM some code to scan the library list and locate this one, and find the | |
86 | REM code tacked onto the end. Yuk. | |
87 | ||
88 | DEF PROCbas_init | |
89 | LOCAL type%,size% :REM [dl] | |
90 | LOCAL workSize%,H%,len%,f% | |
91 | PROCbas_constants :REM [dl] | |
92 | ||
93 | REM --- Old code to load the library from disk --- | |
94 | ||
95 | REM [del] | |
96 | IF TRUE THEN | |
97 | DIM bas_scratch% 300 | |
98 | SYS "OS_File",17,"libs:BAScode" TO type%,,,,size% | |
99 | IF type%<>1 THEN ERROR 0,"BAS code not found" | |
100 | DIM bas_code% size% | |
101 | SYS "OS_File",16,"libs:BAScode",bas_code%,0 | |
102 | ELSE | |
103 | DEF PROCbas_dumpcode | |
104 | REM [edel] | |
105 | ||
106 | REM --- New hacking to scan the library list --- | |
107 | REM | |
108 | REM This must be done in assembler, of course ;-) Time to put on my pointy | |
109 | REM Rincewind hat... I've tried to do this in one pass because I'm lazy -- | |
110 | REM I guess that's why it's unreadable. | |
111 | ||
112 | DIM bas_scratch% 300 | |
113 | P%=bas_scratch% | |
114 | [ opt 0 | |
115 | ||
116 | ; exit with r0 == pointer to code, or 0 if not found (erk!) | |
117 | ||
118 | ldr r2,[pc] ; load the magic marker word | |
119 | mov pc,pc ; skip over the magic marker word | |
120 | dcd &d3c1c2f4 ; this is `REMBAS', with the top bits set | |
121 | ||
122 | ldr r0,[r14,#&24] ; find offset of TIMEOF | |
123 | add r0,r8,r0 ; add on ARGP to find TIMEOF | |
124 | ldr r0,[r0,#&c] ; load the library list base | |
125 | ||
126 | ;.loop | |
127 | cmp r0,#0 ; is that the end of it all? | |
128 | moveqs pc,r14 ; yes -- oh, well -- it was a nice try | |
129 | ||
130 | ldr r1,[r0,#&44] ; load mystic recognition word | |
131 | cmp r1,r2 ; does it match? | |
132 | ldrne r0,[r0] ; if not there, load the next link | |
133 | subne pc,pc,#28 ; and jump back to `loop' (erk) | |
134 | ||
135 | ldr r1,[r0,#&48] ; load the code offset | |
136 | add r0,r1,r0 ; and add it to the base address | |
137 | movs pc,r14 | |
138 | ] | |
139 | ||
140 | REM --- Now some code to dump that out as hex --- | |
141 | ||
142 | bas_code%=USR bas_scratch% | |
143 | IF bas_code%=0 THEN ERROR 0,"BAS code not found: is the library corrupt?" | |
144 | ||
145 | REM [del] | |
146 | ENDIF | |
147 | REM [edel] | |
148 | ||
149 | REM --- Back to life as normal --- | |
150 | ||
151 | workSize%=USR(bas_code%+bcode_wSize) | |
152 | DIM bas_workspace% workSize% | |
153 | H%=bas_workspace% | |
154 | CALL bas_code%+bcode_init | |
155 | SYS "XOS_ReadVarVal","BAS$Output",bas_scratch%,256,3 TO ,,len%;f% | |
156 | IF f% AND 1 THEN | |
157 | bas_fileName$="" | |
158 | ELSE | |
159 | bas_scratch%?len%=13 | |
160 | bas_fileName$=$bas_scratch% | |
161 | ENDIF | |
162 | ENDPROC | |
163 | ||
164 | DEF PROCbas_aofInit(size%) | |
165 | LOCAL H% | |
166 | IF size% THEN DIM bas_asmCode% size% ELSE bas_asmCode%=bas_asmCode% | |
167 | IF bas_asmCode%=0 THEN ERROR 0,"No buffer allocated for assembler code" | |
168 | H%=bas_workspace% | |
169 | CALL bas_code%+bcode_aofInit,bas_asmCode% | |
170 | ENDPROC | |
171 | ||
172 | REM This function saves a few bytes and tidies up the code a bit. | |
173 | ||
174 | DEF FNbas_call(offset%) | |
175 | LOCAL H% | |
176 | H%=bas_workspace% | |
177 | =USR(bas_code%+offset%) | |
178 | ||
179 | REM ----- AOF code generation ----------------------------------------------- | |
180 | ||
181 | DEF PROCbas_aofSaveAs(name$) | |
182 | LOCAL H% | |
183 | H%=bas_workspace% | |
184 | CALL bas_code%+bcode_save,name$ | |
185 | ENDPROC | |
186 | ||
187 | DEF PROCbas_aofSave | |
188 | IF bas_fileName$="" THEN ERROR 0,"No implicit filename" | |
189 | PROCbas_aofSaveAs(bas_fileName$) | |
190 | bas_fileName$="" | |
191 | ENDPROC | |
192 | ||
193 | DEF FNpass=FNbas_call(bcode_newPass) | |
194 | ||
195 | DEF FNbas_port(offset%,A%,s$,t$) | |
196 | LOCAL H% | |
197 | H%=bas_workspace% | |
198 | CALL bas_code%+offset%,s$,t$ | |
199 | =0 | |
200 | ||
201 | DEF FNimport(var$)=FNbas_port(bcode_import,0,var$,var$) | |
202 | DEF FNimportAs(sym$,var$)=FNbas_port(bcode_import,0,sym$,var$) | |
203 | DEF FNimportWeak(var$)=FNbas_port(bcode_import,1,var$,var$) | |
204 | DEF FNimportWeakAs(sym$,var$)=FNbas_port(bcode_import,1,sym$,var$) | |
205 | DEF FNexport(var$)=FNbas_port(bcode_export,0,var$,var$) | |
206 | DEF FNexportAs(var$,sym$)=FNbas_port(bcode_export,0,var$,sym$) | |
207 | DEF FNexportStrong(var$)=FNbas_port(bcode_export,1,var$,var$) | |
208 | DEF FNexportStrongAs(var$,sym$)=FNbas_port(bcode_export,1,var$,sym$) | |
209 | ||
210 | DEF FNget(file$) | |
211 | LOCAL H% | |
212 | H%=bas_workspace% | |
213 | CALL bas_code%+bcode_get,file$ | |
214 | =0 | |
215 | ||
216 | DEF FNbas_lib(lib$) | |
217 | LOCAL err%,leaf$,lower$,i% | |
218 | leaf$=lib$ | |
219 | FOR i%=1 TO LEN(lib$) | |
220 | IF INSTR(":.",MID$(lib$,i%,1)) THEN leaf$=MID$(lib$,i%+1) | |
221 | NEXT | |
222 | FOR i%=1 TO LEN(leaf$) | |
223 | lower$+=CHR$(ASC(MID$(leaf$,i%,1)) OR &20) | |
224 | NEXT | |
225 | LOCAL ERROR | |
226 | ON ERROR LOCAL err%=TRUE | |
227 | IF err%=FALSE THEN | |
228 | IF EVAL("FN"+lower$+"_test") | |
229 | ENDIF | |
230 | RESTORE ERROR | |
231 | IF err%=TRUE THEN LIBRARY lib$ | |
232 | =0 | |
233 | ||
234 | DEF FNarea(name$,attr$) | |
235 | LOCAL A%,H% | |
236 | A%=2 | |
237 | IF INSTR(attr$,"CODE") THEN A%+=&200 | |
238 | IF INSTR(attr$,"COMDEF") THEN A%+=&400 | |
239 | IF INSTR(attr$,"COMMON") THEN A%+=&800 | |
240 | IF INSTR(attr$,"NOINIT") THEN A%+=&1000 | |
241 | IF INSTR(attr$,"READONLY") THEN A%+=&2000 | |
242 | IF INSTR(attr$,"DEBUG") THEN A%+=&8000 | |
243 | IF A% AND &800 THEN A%=A% OR &1000 | |
244 | IF A% AND &200 THEN A%=A% OR &2000 | |
245 | H%=bas_workspace% | |
246 | CALL bas_code%+bcode_area,name$ | |
247 | =0 | |
248 | ||
249 | DEF FNreloc=FNbas_call(bcode_reloc) | |
250 | DEF FNnoReloc=FNbas_call(bcode_noReloc) | |
251 | ||
252 | DEF FNentry=FNbas_call(bcode_entry) | |
253 | ||
254 | REM ----- Literal handling -------------------------------------------------- | |
255 | ||
256 | DEF PROClitStart | |
257 | bas_litStart%=P% | |
258 | bas_savedOpt%=USR(bas_code%+bcode_saveOpt) | |
259 | ENDPROC | |
260 | ||
261 | DEF FNlitw(val%) | |
262 | PROClitStart | |
263 | [ opt 4: dcd val%:] | |
264 | =FNlitAlign | |
265 | ||
266 | DEF FNlits(str$) | |
267 | PROClitStart | |
268 | [ opt 4: equs str$:] | |
269 | =FNlit | |
270 | ||
271 | DEF FNlitmagic(str$) | |
272 | PROClitStart | |
273 | [ opt 4: equs str$:] | |
274 | =FNlitAlign | |
275 | ||
276 | DEF FNlitsz(str$) | |
277 | PROClitStart | |
278 | [ opt 4: equs str$+CHR$0:] | |
279 | =FNliteral | |
280 | ||
281 | DEF FNliterr(err%,str$) | |
282 | PROClitStart | |
283 | [ opt 4: dcd err%: equs str$+CHR$0:] | |
284 | =FNlitAlign | |
285 | ||
286 | DEF FNliteral | |
287 | LOCAL A%,B%,C% | |
288 | A%=bas_savedOpt% | |
289 | CALL bas_code%+bcode_restoreOpt | |
290 | B%=P%-bas_litStart% | |
291 | A%=O%-B% | |
292 | C%=0 | |
293 | P%=bas_litStart% | |
294 | O%=A% | |
295 | =FNbas_call(bcode_lit) | |
296 | ||
297 | DEF FNlitAlign | |
298 | LOCAL A%,B%,C% | |
299 | A%=bas_savedOpt% | |
300 | CALL bas_code%+bcode_restoreOpt | |
301 | B%=P%-bas_litStart% | |
302 | A%=O%-B% | |
303 | C%=1 | |
304 | P%=bas_litStart% | |
305 | O%=A% | |
306 | =FNbas_call(bcode_lit) | |
307 | ||
308 | DEF FNltorg=FNbas_call(bcode_ltorg) | |
309 | ||
310 | REM ----- Initialising areas ------------------------------------------------ | |
311 | ||
312 | DEF FNalign=FNbas_call(bcode_align) | |
313 | DEF FNreserve(A%)=FNbas_call(bcode_reserve) | |
314 | ||
315 | DEF FNbin(file$) | |
316 | LOCAL size% | |
317 | IF FNbas_call(bcode_noReloc) | |
318 | size%=FNfSize(file$) | |
319 | SYS "OS_File",16,file$,O%,0 | |
320 | O%+=size% | |
321 | P%+=size% | |
322 | IF FNbas_call(bcode_reloc) | |
323 | =0 | |
324 | ||
325 | DEF FNfSize(file$) | |
326 | LOCAL size% | |
327 | SYS "OS_File",17,file$ TO ,,,,size% | |
328 | =size% | |
329 | ||
330 | REM ----- Laying out storage areas ------------------------------------------ | |
331 | ||
332 | DEF PROCws_start | |
333 | bas_R%=0 | |
334 | ENDPROC | |
335 | ||
336 | DEF PROCws_base(start%) | |
337 | bas_R%=start% | |
338 | ENDPROC | |
339 | ||
340 | DEF FNws(size%) | |
341 | bas_R%+=size% | |
342 | =bas_R%-size% | |
343 | ||
344 | DEF PROCws_align | |
345 | bas_R%=(bas_R%+3) AND -4 | |
346 | ENDPROC | |
347 | ||
348 | DEF FNws_word | |
349 | PROCws_align | |
350 | =FNws(4) | |
351 | ||
352 | DEF FNws_byte=FNws(1) | |
353 | ||
354 | REM ----- Long directives --------------------------------------------------- | |
355 | ||
356 | DEF FNadrl(r%,adr%)=FNaddccl(14,r%,15,adr%-P%-8) | |
357 | DEF FNadrccl(cc%,r%,adr%)=FNaddccl(cc%,r%,15,adr%-P%-8) | |
358 | DEF FNaddl(r%,b%,off%)=FNaddccl(14,r%,b%,off%) | |
359 | DEF FNaddccl(cc%,r%,b%,off%) | |
360 | IF off%>0 THEN | |
361 | [opt 4:addeq r%,b%,#off% AND 255:addeq r%,r%,#off% AND -256:] | |
362 | ELSE | |
363 | [opt 4:subeq r%,pc,#(-off%) AND 255:subeq r%,r%,#(-off%) AND -256:] | |
364 | ENDIF | |
365 | !(O%-8)=!(O%-8) OR (cc%<<28) | |
366 | !(O%-4)=!(O%-4) OR (cc%<<28) | |
367 | =0 | |
368 | ||
369 | DEF FNldrl(r%,adr%)=FNldrrccl(14,r%,15,adr%-P%-8) | |
370 | DEF FNldrccl(cc%,r%,adr%)=FNldrrccl(cc%,r%,15,adr%-P%-8) | |
371 | DEF FNldrrl(r%,b%,off%)=FNldrrccl(14,r%,b%,off%) | |
372 | DEF FNldrrccl(cc%,r%,b%,off%) | |
373 | IF off%>0 THEN | |
374 | [opt 4:addeq r%,b%,#off% AND -256:ldreq r%,[r%,#off% AND 255]:] | |
375 | ELSE | |
376 | [opt 4:subeq r%,b%,#(-off%) AND -256:ldreq r%,[r%,#-((-off%) AND 255)]:] | |
377 | ENDIF | |
378 | !(O%-8)=!(O%-8) OR (cc%<<28) | |
379 | !(O%-4)=!(O%-4) OR (cc%<<28) | |
380 | =0 | |
381 | ||
382 | REM ----- That's all, folks ------------------------------------------------- |