~mdw / ssr / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Initial revision
[ssr] / StraySrc / Libraries / BAS / src / s / get
1 ;
2 ; get.s
3 ;
4 ; Parsing of simple objasm header files
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.aofGen
37 GET sh.bas
38 GET sh.basTalk
39 GET sh.flex
40 GET sh.string
41 GET sh.workspace
42
43 ;----- Main code ------------------------------------------------------------
44
45 AREA |BAS$$Code|,CODE,READONLY
46
47 ; --- get ---
48 ;
49 ; On entry: R7 == pointer to workspace
50 ; R8-R12 as set up by BASIC
51 ;
52 ; On exit: --
53 ;
54 ; CALL syntax: filename
55 ;
56 ; Use: Parses a Straylight format objasm header file and sets up
57 ; BASIC variables appropriately.
58
59 EXPORT get
60 get ROUT
61
62 STMFD R13!,{R0-R12,R14} ;Save some registers
63 STR R12,[R7,#:INDEX:be__line] ;Save BASIC's LINE value
64 MOV R12,R7 ;Set up my workspace pointer
65
66 ; --- Find out if we need to do anything ---
67
68 BL aof_firstPass ;Is this the first pass?
69 LDMCCFD R13!,{R0-R12,PC}^ ;No -- then return to caller
70
71 ; --- Load the file into a flex block ---
72
73 BL str_buffer ;Find a string buffer
74 BL bas_argString ;Read a string argument
75 MOV R7,R1 ;Look after this pointer
76 MOV R0,#17 ;Read information about file
77 SWI OS_File ;Find out the file info
78 TST R0,#1 ;Is this a file?
79 BEQ %80get ;No -- then report error
80
81 MOV R0,#0 ;Clear a flags word
82 STR R0,[R13,#-4]! ;Save it on the stack
83 SUB R13,R13,#8 ;Make a flex anchor
84 MOV R0,R13 ;Point at the anchor
85 ADD R1,R4,#1 ;Bump file size by 1
86 BL flex_alloc ;Allocate lots of memory
87 BCS bas_noMem ;If it failed, complain
88
89 MOV R0,#16 ;Load a file name
90 MOV R1,R7 ;Point to the file name
91 LDR R2,[R13,#0] ;Load the flex pointer
92 MOV R3,#0 ;Load file right here
93 SWI XOS_File ;Load the file
94 BVS %90get ;If it failed, tidy up
95
96 ; --- Set up for parsing the file ---
97 ;
98 ; Register allocation:
99 ;
100 ; R12 == workspace
101 ; R11 == pointer to end of file
102 ; R10 == pointer to current position
103 ; R9 == pointer to next line start
104
105 MOV R14,#&10 ;Put a newline at the end
106 LDR R9,[R13,#0] ;Load flex block base
107 STRB R14,[R9,R4] ;Save at end of the file
108 ADD R11,R9,R4 ;Find the end of the file
109
110 ; --- Loop throught the lines of the file ---
111
112 10get BL get__nextLine ;Get the next line
113 BCS %70get ;If now finished, return
114
115 ; --- See if there's a comment here ---
116
117 MOV R8,R10 ;Remember current position
118 BL get__byte ;Read a character
119 BCS %10get ;If end of line, loop back
120 MOVMI R8,#0 ;If whitespace, no label
121 BMI %12get ;And skip on a little
122 CMP R0,#';' ;Is this a line comment?
123 BEQ %20get ;Yes -- may be active comment
124
125 11get BL get__byte ;Read a character
126 BPL %11get ;And wait for whitespace
127
128 ; --- Skip whitespace and find opcode ---
129
130 12get MOV R7,R10 ;Remember current position
131 BL get__byte ;Read a character
132 BCS %10get ;If end of line, loop back
133 BMI %12get ;If whitespace, loop back
134
135 ; --- Find end of opcode ---
136
137 13get MOV R6,R10 ;Remember current position
138 BL get__byte ;Read a character
139 BPL %13get ;And wait for whitespace
140 MOV R14,#0 ;Mark end of opcode
141 STRB R14,[R6,#0] ;Terminate opcode string
142
143 ; --- Attempt to match the opcode ---
144
145 MOV R1,R7 ;Point to the opcode
146 ADR R0,get__table ;Point to opcode table
147 BL get__match ;Try to find a match
148 MOV R14,PC ;Set up return address
149 ADDCS PC,PC,R0,LSL #2 ;Do dispatch table things
150 B %10get ;And get the next line
151
152 ; --- The dispatch table ---
153
154 B get__hash ;Hash (#) directive
155 B get__hat ;Hat (^) directive
156 B get__equ ;EQU directive
157 B get__equ ;EQU directive
158 B get__import ;IMPORT dirctive
159 B get__macro ;MACRO directive
160 B get__mend ;MEND directive
161
162 ; --- The directive table ---
163
164 get__table DCB "#",0
165 DCB "^",0
166 DCB "EQU",0
167 DCB "*",0
168 DCB "IMPORT",0
169 DCB "MACRO",0
170 DCB "MEND",0
171 DCB 0
172
173 ; --- Found an active comment ---
174 ;
175 ; We use active comments to give this specific parser
176 ; instructions, of which objasm should be blissfully
177 ; unaware. This is used to load BASIC macro libraries
178 ; which we use instead of the objasm ones.
179
180 20get BL get__byte ;Read the next byte
181 BCS %10get ;If end-of-line, move on
182 CMP R0,#'+' ;Is it a BAS active comment?
183 BNE %10get ;No -- ignore this line
184
185 ; --- Find start of directive ---
186
187 21get MOV R7,R10 ;Remember this position
188 BL get__byte ;Get another byte
189 BCS %10get ;If end-of-line, ignore it
190 BMI %21get ;If whitespace, skip on
191
192 22get MOV R6,R10 ;Remember end of directive
193 BL get__byte ;Get another byte
194 BPL %22get ;If nonwhitespace, skip
195 MOV R14,#0 ;Null terminate the directive
196 STRB R14,[R6,#0] ;Save the null byte then
197
198 ; --- Call the correct directive ---
199
200 ADR R0,get__actComm ;Point to directive table
201 MOV R1,R7 ;Point to this directive
202 BL get__match ;Try to match the name
203 MOV R14,PC ;Set up a return address
204 ADDCS PC,PC,R0,LSL #2 ;Dispatch through the table
205 B %10get ;And get the next line
206
207 ; --- The dispatch table ---
208
209 B get__lib ;Include BASIC macro lib
210
211 ; --- Active comment directives ---
212
213 get__actComm DCB "LIB",0
214 DCB 0
215
216 ; --- Close the file and return ---
217
218 70get MOV R0,R13 ;Point to flex anchor
219 BL flex_free ;Free the block
220 BL flex_compact ;And reduce memory usage
221 ADD R13,R13,#12 ;Restore the stack pointer
222 LDMFD R13!,{R0-R12,PC}^ ;Return to caller
223
224 90get MOV R10,R0 ;Look after error pointer
225 MOV R0,R13 ;Point to flex anchor
226 BL flex_free ;Free the block
227 BL flex_compact ;And reduce memory usage
228 ADD R13,R13,#12 ;Restore the stack pointer
229 MOV R0,R10 ;Get error back again
230 SWI OS_GenerateError ;And raise the error
231
232 80get MOV R2,R0 ;Get returned object type
233 MOV R0,#19 ;Return error message
234 SWI OS_File ;Make the error
235
236 LTORG
237
238 ; --- get__hat ---
239 ;
240 ; On entry: R9 == pointer to end of line
241 ; R10 == pointer to directive operands
242 ; R11 == pointer to end of file
243 ;
244 ; On exit: R0-R8, R10 corrupted
245 ;
246 ; Use: Handles a hat (^) directive.
247
248 get__hat ROUT
249
250 STMFD R13!,{R14} ;Save some registers
251
252 ; --- Find start of operands ---
253
254 00get__hat MOV R8,R10 ;Remember current position
255 BL get__byte ;Read another byte
256 BMI %00get__hat ;If whitespace, skip on
257
258 ; --- Now find the end ---
259
260 MOV R1,#32 ;Make whitespace into spaces
261 10get__hat MOV R7,R10 ;Remember current position
262 BL get__byte ;Read another byte
263 BCS %15get__hat ;If end-of-line, skip out
264 STRMIB R1,[R7,#0] ;If whitespace, space it
265 CMP R0,#',' ;Could be a comma, maybe
266 CMPNE R0,#';' ;Also stop at a comment
267 BNE %10get__hat ;If not, keep going
268
269 15get__hat MOV R14,#0 ;Null terminate expression
270 STRB R14,[R7,#0] ;Done that then
271
272 ; --- Evaluate the expression ---
273
274 MOV R1,R8 ;Point to the expression
275 BL bTalk_eval ;Evaluate the expression
276
277 STR R0,[R13,#8] ;Save the new `at' value
278 LDMFD R13!,{PC}^ ;And return to caller
279
280 LTORG
281
282 ; --- get__hash ---
283 ;
284 ; On entry: R8 == pointer to label, or 0
285 ; R9 == pointer to end of line
286 ; R10 == pointer to directive operands
287 ; R11 == pointer to end of file
288 ;
289 ; On exit: R0-R8, R10 corrupted
290 ;
291 ; Use: Handles a hash (#) directive.
292
293 get__hash ROUT
294
295 STMFD R13!,{R14} ;Save some registers
296
297 ; --- Find start of operands ---
298
299 00get__hash MOV R7,R10 ;Remember current position
300 BL get__byte ;Read another byte
301 BMI %00get__hash ;If whitespace, skip on
302
303 ; --- Now find the end ---
304
305 MOV R1,#32 ;Make whitespace into spaces
306 10get__hash MOV R6,R10 ;Remember current position
307 BL get__byte ;Read another byte
308 BCS %15get__hash ;If end-of-line, skip out
309 STRMIB R1,[R6,#0] ;If whitespace, space it
310 CMP R0,#';' ;Also stop at a comment
311 BNE %10get__hash ;If not, keep going
312
313 15get__hash MOV R14,#0 ;Null terminate expression
314 STRB R14,[R6,#0] ;Done that then
315
316 ; --- Save the current `at' value ---
317
318 LDR R2,[R13,#8] ;Load current `at' value
319 MOVS R0,R8 ;Point to label name
320 BEQ %20get__hash ;No label -- don't assign
321
322 BL bTalk_create ;Create the variable
323 BL bTalk_store ;Store that in lvalue
324
325 ; --- Evaluate the expression ---
326
327 20get__hash MOV R1,R7 ;Point to the expression
328 BL bTalk_eval ;Evaluate the expression
329 ADD R0,R0,R2 ;Increment the `at' value
330 STR R0,[R13,#8] ;And store it back
331
332 LDMFD R13!,{PC}^ ;And return to caller
333
334 LTORG
335
336 ; --- get__equ ---
337 ;
338 ; On entry: R8 == pointer to label, or 0
339 ; R9 == pointer to end of line
340 ; R10 == pointer to directive operands
341 ; R11 == pointer to end of file
342 ;
343 ; On exit: R0-R8, R10 corrupted
344 ;
345 ; Use: Handles an EQU directive.
346
347 get__equ ROUT
348
349 STMFD R13!,{R14} ;Save some registers
350 LDR R14,[R13,#12] ;Load the flags word
351 TST R14,#1 ;Are we in macro?
352 LDMNEFD R13!,{PC}^ ;Yes -- return to caller
353
354 ; --- Find start of operands ---
355
356 00get__equ MOV R7,R10 ;Remember current position
357 BL get__byte ;Read another byte
358 BMI %00get__equ ;If whitespace, skip on
359
360 ; --- Now find the end ---
361
362 MOV R1,#32 ;Turn whitespace into spaces
363 10get__equ MOV R6,R10 ;Remember current position
364 BL get__byte ;Read another byte
365 BCS %15get__equ ;If end-of-line, skip out
366 STRMIB R1,[R6,#0] ;If whitespace, space it
367 CMP R0,#';' ;Also stop at a comment
368 BNE %10get__equ ;If not, keep going
369
370 15get__equ MOV R14,#0 ;Null terminate expression
371 STRB R14,[R6,#0] ;Done that then
372
373 ; --- Evaluate the expression ---
374
375 MOV R1,R7 ;Point to the operand
376 BL bTalk_eval ;Evaluate it nicely
377 MOV R2,R0 ;This is the value to store
378
379 MOV R0,R8 ;Point to label
380 BL bTalk_create ;Create the variable
381 BL bTalk_store ;And store the value away
382
383 LDMFD R13!,{PC}^ ;And return to caller
384
385 LTORG
386
387 ; --- get__import ---
388 ;
389 ; On entry: R9 == pointer to end of line
390 ; R10 == pointer to directive operands
391 ; R11 == pointer to end of file
392 ;
393 ; On exit: R0-R8, R10 corrupted
394 ;
395 ; Use: Handles an IMPORT directive.
396
397 get__import ROUT
398
399 STMFD R13!,{R14} ;Save some registers
400 LDR R14,[R13,#12] ;Load the flags word
401 TST R14,#1 ;Are we in macro?
402 LDMNEFD R13!,{PC}^ ;Yes -- return to caller
403
404 ; --- Find start of operands ---
405
406 00get__import MOV R7,R10 ;Remember current position
407 BL get__byte ;Read another byte
408 BMI %00get__import ;If whitespace, skip on
409
410 ; --- Now find the end ---
411
412 MOV R1,#32 ;Turn whitespace into spaces
413 10get__import MOV R6,R10 ;Remember current position
414 BL get__byte ;Read another byte
415 BCS %15get__import ;If end-of-line, skip out
416 STRMIB R1,[R6,#0] ;If whitespace, space it
417 CMP R0,#';' ;Also stop at a comment
418 BNE %10get__import ;If not, keep going
419
420 15get__import MOV R14,#0 ;Null terminate expression
421 STRB R14,[R6,#0] ;Done that then
422
423 ; --- Now import the symbol ---
424
425 MOV R0,R7 ;Point to operand name
426 MOV R1,R7 ;Make this the alias too
427 MOV R3,#0 ;No special attributes
428 FSAVE R9-R11 ;Save the block pointers
429 BL aof_import ;Import the symbol
430 FLOAD R9-R11 ;Load them back again
431 LDMFD R13!,{PC}^ ;And return to caller
432
433 LTORG
434
435 ; --- get__macro ---
436 ;
437 ; On entry: --
438 ;
439 ; On exit: R0-R8 corrupted
440 ;
441 ; Use: Sets the `in a macro' flag, so that strange EQU directives
442 ; don't get read.
443
444 get__macro ROUT
445
446 LDR R0,[R13,#8] ;Load the flags word
447 ORR R0,R0,#1 ;Set the flag
448 STR R0,[R13,#8] ;Save the flags back
449 MOVS PC,R14 ;Return to caller
450
451 LTORG
452
453 ; --- get__mend ---
454 ;
455 ; On entry: --
456 ;
457 ; On exit: R0-R8 corrupted
458 ;
459 ; Use: Clears the `in a macro' flag, so that strange EQU directives
460 ; don't get read.
461
462 get__mend ROUT
463
464 LDR R0,[R13,#8] ;Load the flags word
465 BIC R0,R0,#1 ;Clear the flag
466 STR R0,[R13,#8] ;Save the flags back
467 MOVS PC,R14 ;Return to caller
468
469 LTORG
470
471 ; --- get__lib ---
472 ;
473 ; On entry: --
474 ;
475 ; On exit: --
476 ;
477 ; Use: Loads a macro library. This is done so that an objasm
478 ; header file can load BASIC macros as appropriate, since
479 ; objasm macros are obviously not much use. We do this by
480 ; evaluating a call to FNlib(), which the BASIC part will
481 ; implement as loading a library.
482
483 get__lib ROUT
484
485 STMFD R13!,{R14} ;Save the link register
486
487 ; --- Find start of operands ---
488
489 00get__lib MOV R7,R10 ;Remember current position
490 BL get__byte ;Read another byte
491 BMI %00get__lib ;If whitespace, skip on
492
493 ; --- Now find the end ---
494
495 10get__lib MOV R6,R10 ;Remember current position
496 BL get__byte ;Read another byte
497 BCS %15get__lib ;If end-of-line, skip out
498 CMP R0,#';' ;Also stop at a comment
499 BNE %10get__lib ;If not, keep going
500
501 15get__lib MOV R14,#0 ;Null terminate expression
502 STRB R14,[R6,#0] ;Done that then
503
504 ; --- Build the string to evaluate ---
505
506 BL str_buffer ;Get a buffer
507 ADR R0,get__libSkel ;Point to skeleton string
508 BL str_subst ;Build the correct invocation
509 MOV R1,R0 ;Point to the string built
510 BL bTalk_eval ;Evaluate the expression
511
512 LDMFD R13!,{PC}^ ;And return to caller
513
514 get__libSkel DCB "FNbas_lib(""%5"")",0
515
516 LTORG
517
518 ; --- get__nextLine ---
519 ;
520 ; On entry: R9 == pointer to start of next line
521 ; R11 == pointer to end of file
522 ;
523 ; On exit: CC if more to come, and
524 ; R9 == pointer to start of next line line
525 ; R10 == pointer to next line
526 ; else CS if end of file reached and
527 ; R9, R10 corrupted
528 ; R0 always corrupted
529 ;
530 ; Use: Finds the start address of the next line
531
532 get__nextLine ROUT
533
534 CMP R9,R11 ;Are we at end of file?
535 ORRCSS PC,R14,#C_flag ;Yes -- return with C set
536
537 MOV R10,R9 ;Point to the next line
538 00get__nextLine LDRB R0,[R9],#1 ;Get next character
539 CMP R0,#&0A ;Is this a newline?
540 BNE %00get__nextLine ;No -- go round for more then
541 LDRB R0,[R9,#0] ;Load the next byte
542 CMP R0,#&0D ;Is this a carriage return?
543 ADDEQ R0,R0,#1 ;Yes -- then move along one
544 BICS PC,R14,#C_flag ;And return with C clear
545
546 LTORG
547
548 ; --- get__byte ---
549 ;
550 ; On entry: R10 == pointer to next byte
551 ;
552 ; On exit: CC if read a byte, and
553 ; R0 == byte read
554 ; R10 moved to byte after
555 ; MI if byte is whitespace, else PL
556 ; else CS if end of line and
557 ; R0, R10 corrupted
558 ;
559 ; Use: Reads a byte from the block
560
561 get__byte ROUT
562
563 LDRB R0,[R10],#1 ;Load a byte
564 CMP R10,R9 ;Reached end of line yet?
565 ORRCSS PC,R14,#C_flag + N_flag ;Yes -- set C on exit then
566 BIC R14,R14,#C_flag ;Clear R14's C flag ready
567 CMP R0,#&9 ;Is it a tab?
568 CMPNE R0,#&0C ;Or a form feed? (oddness)
569 CMPNE R0,#&0D ;Or a carriage return?
570 CMPNE R0,#&20 ;Or a space, indeed?
571 ORREQS PC,R14,#N_flag ;Yes -- set the N flag
572 BICNES PC,R14,#N_flag ;Otherwise clear N
573
574 LTORG
575
576 ; --- get__match ---
577 ;
578 ; On entry: R0 == pointer to command line argument table
579 ; R1 == pointer to command line word read (null terminated)
580 ;
581 ; On exit: CS if word found in table and
582 ; R0 == index of item matched
583 ; else CC and
584 ; R0 corrupted
585 ;
586 ; Use: Looks up a given word in the command table given. The
587 ; command table consists of null-terminated strings, and is
588 ; itself terminated by a null entry.
589 ;
590 ; Matching is not case sensitive. Indexing is from 0.
591
592 get__match ROUT
593
594 STMFD R13!,{R1-R5,R14} ;Save some registers
595 MOV R2,#0 ;Index of the current item
596 LDRB R14,[R1,#0] ;Load the first byte
597 CMP R14,#0 ;Is it a null string?
598 BEQ %90get__match ;Yes -- no match then
599
600 ; --- The main loop ---
601
602 00get__match MOV R3,R1 ;Point to argument start
603 LDRB R4,[R0],#1 ;Load a byte from the table
604 LDRB R5,[R3],#1 ;Load a byte from the arg
605 CMP R4,#0 ;Is this an empty string?
606 BEQ %90get__match ;Yes -- no match then
607
608 ; --- Try to match a word ---
609
610 10get__match CMP R5,#0 ;End of argument string?
611 CMPEQ R4,#0 ;And end of match string?
612 BEQ %80get__match ;Yes -- that's a match then
613 SUB R14,R4,#'a' ;Subtract the bottom limit
614 CMP R14,#26 ;Is it a lower case letter?
615 BICLO R4,R4,#&20 ;Yes -- convert to upper
616 SUB R14,R5,#'a' ;Subtract the bottom limit
617 CMP R14,#26 ;Is it a lower case letter?
618 BICLO R5,R5,#&20 ;Yes -- convert to upper
619 CMP R4,R5 ;Do characters match up?
620 LDREQB R4,[R0],#1 ;Load a byte from the table
621 LDREQB R5,[R3],#1 ;Load a byte from the arg
622 BEQ %10get__match ;Yes -- go round for more
623
624 ; --- Failed -- find end of table entry ---
625
626 20get__match CMP R4,#0 ;End of entry string?
627 LDRNEB R4,[R0],#1 ;No -- load byte from table
628 BNE %20get__match ;And go round again
629 ADD R2,R2,#1 ;Increment item index
630 B %00get__match ;Loop round for next entry
631
632 ; --- Found a match ---
633
634 80get__match MOV R0,R2 ;Get the item index
635 LDMFD R13!,{R1-R5,R14} ;Unstack the registers
636 ORRS PC,R14,#C_flag ;And return with C set
637
638 ; --- No match found ---
639
640 90get__match LDMFD R13!,{R1-R5,R14} ;Unstack the registers
641 BICS PC,R14,#C_flag ;And return with C clear
642
643 LTORG
644
645 ;----- That's all, folks ----------------------------------------------------
646
647 END
648
The Straylight Source Distribution (obsolete software for RISC OS)