OpenCores
URL https://opencores.org/ocsvn/raptor64/raptor64/trunk

Subversion Repositories raptor64

[/] [raptor64/] [trunk/] [software/] [sample code/] [bootrom.s] - Blame information for rev 43

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 27 robfinch
; ============================================================================
2 43 robfinch
; (C) 2012,2013 Robert Finch, Stratford
3 27 robfinch
; All Rights Reserved.
4
; robfinch<remove>@opencores.org
5
;
6
; This source file is free software: you can redistribute it and/or modify 
7
; it under the terms of the GNU Lesser General Public License as published 
8
; by the Free Software Foundation, either version 3 of the License, or     
9
; (at your option) any later version.                                      
10
;                                                                          
11
; This source file is distributed in the hope that it will be useful,      
12
; but WITHOUT ANY WARRANTY; without even the implied warranty of           
13
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            
14
; GNU General Public License for more details.                             
15
;                                                                          
16
; You should have received a copy of the GNU General Public License        
17
; along with this program.  If not, see <http://www.gnu.org/licenses/>.    
18
;                                                                          
19
; ============================================================================
20
;
21
CR      EQU     0x0D            ;ASCII equates
22
LF      EQU     0x0A
23
TAB     EQU     0x09
24
CTRLC   EQU     0x03
25
CTRLH   EQU     0x08
26
CTRLS   EQU     0x13
27
CTRLX   EQU     0x18
28 43 robfinch
XON             EQU     0x11
29
XOFF    EQU     0x13
30 10 robfinch
 
31 43 robfinch
DATA_PRESENT    EQU     0x01            ; there is data preset at the serial port bc_uart3
32
XMIT_NOT_FULL   EQU     0x20
33
 
34
BUFLEN  EQU     80      ;       length of keyboard input buffer
35
 
36
; Initial stack tops for contexts
37
; Each context gets 1k from the special 16k startup stack memory
38
;
39
STACKTOP0       EQU             0xFFFF_FFFF_FFFE_FFF8
40
STACKTOP1       EQU             0xFFFF_FFFF_FFFE_FBF8
41
STACKTOP2       EQU             0xFFFF_FFFF_FFFE_F7F8
42
STACKTOP3       EQU             0xFFFF_FFFF_FFFE_F3F8
43
STACKTOP4       EQU             0xFFFF_FFFF_FFFE_EFF8
44
STACKTOP5       EQU             0xFFFF_FFFF_FFFE_EBF8
45
STACKTOP6       EQU             0xFFFF_FFFF_FFFE_E7F8
46
STACKTOP7       EQU             0xFFFF_FFFF_FFFE_E3F8
47
STACKTOP8       EQU             0xFFFF_FFFF_FFFE_DFF8
48
STACKTOP9       EQU             0xFFFF_FFFF_FFFE_DBF8
49
STACKTOP10      EQU             0xFFFF_FFFF_FFFE_D7F8
50
STACKTOP11      EQU             0xFFFF_FFFF_FFFE_D3F8
51
STACKTOP12      EQU             0xFFFF_FFFF_FFFE_CFF8
52
STACKTOP13      EQU             0xFFFF_FFFF_FFFE_CBF8
53
STACKTOP14      EQU             0xFFFF_FFFF_FFFE_C7F8
54
STACKTOP15      EQU             0xFFFF_FFFF_FFFE_C3F8
55
 
56
 
57
; BOOT ROM routines
58
 
59
TCBSize         EQU             0x200                   ; 512 bytes per TCB
60
TCBBase         EQU             0x00000001_00000000                     ; TCB pages
61
TCBr1           EQU             0x00
62
TCBr2           EQU             0x08
63
TCBr3           EQU             0x10
64
TCBr4           EQU             0x18
65
TCBr5           EQU             0x20
66
TCBr6           EQU             0x28
67
TCBr7           EQU             0x30
68
TCBr8           EQU             0x38
69
TCBr9           EQU             0x40
70
TCBr10          EQU             0x48
71
TCBr11          EQU             0x50
72
TCBr12          EQU             0x58
73
TCBr13          EQU             0x60
74
TCBr14          EQU             0x68
75
TCBr15          EQU             0x70
76
TCBr16          EQU             0x78
77
TCBr17          EQU             0x80
78
TCBr18          EQU             0x88
79
TCBr19          EQU             0x90
80
TCBr20          EQU             0x98
81
TCBr21          EQU             0xA0
82
TCBr22          EQU             0xA8
83
TCBr23          EQU             0xB0
84
TCBr24          EQU             0xB8
85
TCBr25          EQU             0xC0
86
TCBr26          EQU             0xC8
87
TCBr27          EQU             0xD0
88
TCBr28          EQU             0xD8
89
TCBr29          EQU             0xE0
90
TCBr30          EQU             0xE8
91
TCBr31          EQU             0xF0
92
 
93
warmStart   EQU     0x1020
94
usrJmp      EQU     0x1028
95
TickIRQAddr             EQU             0x1030
96
TaskBlock               EQU             0x1038
97
tencount                EQU             0x13F8
98
Milliseconds    EQU             0x1400
99
Lastloc                 EQU             0x1408
100
ScreenColor     EQU             0x1414
101
CursorRow       EQU             0x1416
102
CursorCol       EQU             0x1418
103
CursorFlash     EQU             0x141A
104
KeybdEcho       EQU             0x141C
105
KeybdBuffer     EQU             0x1440
106
KeybdHead       EQU             0x1450
107
KeybdTail       EQU             0x1451
108
Score           EQU             0x1500
109
Manpos          EQU             0x1508
110
MissileActive   EQU             0x1510
111
MissileX        EQU             0x1512
112
MissileY        EQU             0x1514
113
InvadersRow1    EQU             0x1520
114
InvadersRow2    EQU             0x1530
115
InvadersRow3    EQU             0x1540
116
InvadersRow4    EQU             0x1550
117
InvadersRow5    EQU             0x1560
118
InvadersColpos  EQU             0x1570
119
InvadersRowpos  EQU             0x1571
120
Uart_rxfifo             EQU             0x1600
121
Uart_rxhead             EQU             0x1800
122
Uart_rxtail             EQU             0x1802
123
Uart_ms                 EQU             0x1808
124
Uart_rxrts              EQU             0x1809
125
Uart_rxdtr              EQU             0x180A
126
Uart_rxxon              EQU             0x180B
127
Uart_rxflow             EQU             0x180C
128
Uart_fon                EQU             0x180E
129
Uart_foff               EQU             0x1810
130
Uart_txrts              EQU             0x1812
131
Uart_txdtr              EQU             0x1813
132
Uart_txxon              EQU             0x1814
133
Uart_txxonoff   EQU             0x1815
134
TaskList                EQU             0x2000
135
ReadyList1              EQU             0x2000
136
ReadyList2              EQU             0x2020
137
ReadyList3              EQU             0x2040
138
ReadyList4              EQU             0x2060
139
ReadyList5              EQU             0x2080
140
ReadyNdx1               EQU             0x20A0
141
ReadyNdx2               EQU             0x20A1
142
ReadyNdx3               EQU             0x20A2
143
ReadyNdx4               EQU             0x20A3
144
ReadyNdx5               EQU             0x20A4
145
RunningTCB              EQU             0x20A6
146
NextToRunTCB    EQU             0x20A8
147
r1save                  EQU             0x20B0
148
r2save                  EQU             0x20B8
149
AXCstart                EQU             0x20C0
150
 
151
p100IRQvec              EQU             0x3000
152
keybdIRQvec             EQU             0x3008
153
serialIRQvec    EQU             0x3010
154
rasterIRQvec    EQU             0x3018
155
 
156
TEXTSCR         EQU             0xD0_0000
157
COLORSCR        EQU             0xD1_0000
158
TEXTREG         EQU             0xDA_0000
159 27 robfinch
TEXT_COLS       EQU             0x0
160
TEXT_ROWS       EQU             0x2
161
TEXT_CURPOS     EQU             0x16
162 43 robfinch
KEYBD           EQU             0xDC_0000
163
KEYBDCLR        EQU             0xDC_0002
164
 
165
UART            EQU             0xDC_0A00
166
UART_LS         EQU             0xDC_0A01
167
UART_MS         EQU             0xDC_0A02
168
UART_IS         EQU             0xDC_0A03
169
UART_IE         EQU             0xDC_0A04
170
UART_MC         EQU             0xDC_0A06
171
DATETIME        EQU             0xDC_0400
172
PIC                     EQU             0xDC_0FF0
173
PIC_IE          EQU             0xDC_0FF2
174
 
175
PSG                     EQU             0xD5_0000
176
PSGFREQ0        EQU             0xD5_0000
177
PSGPW0          EQU             0xD5_0002
178
PSGCTRL0        EQU             0xD5_0004
179
PSGADSR0        EQU             0xD5_0006
180
 
181
SPRRAM          EQU             0xD8_0000
182
AC97            EQU             0xDC_1000
183
LED                     EQU             0xDC_0600
184
GACCEL          EQU             0xDA_E000
185
RASTERIRQ       EQU             0xDA_0100
186 27 robfinch
BOOT_STACK      EQU             0xFFFF_FFFF_FFFE_FFF8
187 43 robfinch
SPRITEREGS      EQU             0xDA_D000
188 27 robfinch
BITMAPSCR       EQU             0x00000001_00200000
189
 
190
txempty EQU             0x40
191
rxfull  EQU             0x01
192
 
193 43 robfinch
;
194
; Internal variables follow:
195
;
196
                bss
197
                org             0x1038
198
txtWidth        db      0                ; BIOS var =56
199
txtHeight       db      0                ; BIOS var =31
200
cursx   db              0                ; cursor x position
201
cursy   db              0                ; cursor y position
202
pos             dh              0                ; text screen position
203
                org             0x1040
204
charToPrint             dc              0
205
fgColor                 db              0
206
bkColor                 db              0
207
cursFlash               db              0        ; flash the cursor ?
208
 
209
lineLinkTbl             fill.b  25,0     ; screen line link table
210
                align 8
211
 
212
                org             0x1080
213
typef   db      0   ; variable / expression type
214
        align   8
215
OSSP    dw      1       ; OS value of sp
216
CURRNT  dw      1       ;       Current line pointer
217
STKGOS  dw      1       ;       Saves stack pointer in 'GOSUB'
218
STKINP  dw      1       ;       Saves stack pointer during 'INPUT'
219
LOPVAR  dw      1       ;       'FOR' loop save area
220
LOPINC  dw      1       ;       increment
221
LOPLMT  dw      1       ;       limit
222
LOPLN   dw      1       ;       line number
223
LOPPT   dw      1       ;       text pointer
224
TXTUNF  dw      1       ;       points to unfilled text area
225
VARBGN  dw      1       ;       points to variable area
226
IVARBGN dw  1   ;   points to integer variable area
227
SVARBGN dw  1   ;   points to string variable area
228
FVARBGN dw  1   ;   points to float variable area
229
STKBOT  dw      1       ;       holds lower limit for stack growth
230
NUMWKA  fill.b  24,0                     ; numeric work area
231
BUFFER  fill.b  BUFLEN,0x00             ;               Keyboard input buffer
232
 
233
        bss
234
        org     0x1_00600000
235
TXT             equ             0x1_00600000    ; Beginning of program area
236
 
237 27 robfinch
;       org 0x070
238
;       iret
239
;       nop
240
;       nop
241
;       nop
242
;       nop
243
;       nop
244
;       nop
245
;       nop
246
;
247
        code
248 43 robfinch
        org 0xFFFF_FFFF_FFFF_B000
249 27 robfinch
 
250
; jump table
251
;
252
        jmp             SerialGetChar
253
        jmp             SerialPutChar
254
        jmp             SetKeyboardEcho
255
        jmp             KeybdCheckForKey
256
        jmp             KeybdGetChar
257
        jmp             DisplayChar
258
        jmp             DisplayString
259
 
260 10 robfinch
start:
261 27 robfinch
;       lea             MSGRAM,a1
262
;       jsr             DisplayString
263
 
264
ColdStart:
265
        icache_on                               ; turn on the ICache
266 43 robfinch
        dcache_off                              ; turn on the DCache
267
 
268
; Initialize the context schedule with all contexts treated equally
269
; There are only 16 contexts, but 256 schedule slots. Each context is
270
; given 16 slots distributed evenly throughout the execution pattern
271
; table.
272
;
273
        xor             r1,r1,r1        ; r1 = 0
274
ict1:
275
        mtep    r1,r1           ; only the low order four bits of r1 will move to the pattern table
276
        addui   r1,r1,#1
277
        cmpi    r2,r1,#255
278
        bne             r2,r0,ict1
279
 
280
; Point the interrupt return address register of the context to the 
281
; context startup code. The context will start up when an interrupt return
282
; occurs.
283
;
284
; We cannot use a loop for this. Fortunately there's only 16 contexts.
285
;
286
        lea             r25,ctxstart
287
        lea             r30,STACKTOP0
288
        iepp
289
        nop
290
        nop
291
        lea             r25,ctxstart
292
        lea             r30,STACKTOP1
293
        iepp
294
        nop
295
        nop
296
        lea             r25,ctxstart
297
        lea             r30,STACKTOP2
298
        iepp
299
        nop
300
        nop
301
        lea             r25,ctxstart
302
        lea             r30,STACKTOP3
303
        iepp
304
        nop
305
        nop
306
 
307
        lea             r25,ctxstart
308
        lea             r30,STACKTOP4
309
        iepp
310
        nop
311
        nop
312
        lea             r25,ctxstart
313
        lea             r30,STACKTOP5
314
        iepp
315
        nop
316
        nop
317
        lea             r25,ctxstart
318
        lea             r30,STACKTOP6
319
        iepp
320
        nop
321
        nop
322
        lea             r25,ctxstart
323
        lea             r30,STACKTOP7
324
        iepp
325
        nop
326
        nop
327
 
328
        lea             r25,ctxstart
329
        lea             r30,STACKTOP8
330
        iepp
331
        nop
332
        nop
333
        lea             r25,ctxstart
334
        lea             r30,STACKTOP9
335
        iepp
336
        nop
337
        nop
338
        lea             r25,ctxstart
339
        lea             r30,STACKTOP10
340
        iepp
341
        nop
342
        nop
343
        lea             r25,ctxstart
344
        lea             r30,STACKTOP11
345
        iepp
346
        nop
347
        nop
348
 
349
        lea             r25,ctxstart
350
        lea             r30,STACKTOP12
351
        iepp
352
        nop
353
        nop
354
        lea             r25,ctxstart
355
        lea             r30,STACKTOP13
356
        iepp
357
        nop
358
        nop
359
        lea             r25,ctxstart
360
        lea             r30,STACKTOP14
361
        iepp
362
        nop
363
        nop
364
        lea             r25,ctxstart
365
        lea             r30,STACKTOP15
366
        iepp
367
        nop
368
        nop
369
 
370
; Ensure that context zero is the active context
371
;
372
ctxstart3:
373
        mfspr   r1,AXC
374
        beq             r1,r0,ctxstart2
375
        iepp
376
        nop
377
        nop
378
        bra             ctxstart3
379
ctxstart2:
380
        sb              r1,AXCstart             ; save off the startup context which should be context zero
381
 
382
; Entry point for context startup
383
;
384
; Avoid repeating all the system initialization when a context starts up by testing whether
385
; or not the context is the starting context.
386
;
387
ctxstart:
388
        mfspr   r1,AXC
389
        lbu             r2,AXCstart
390
        bne             r1,r2,ctxstart1
391
 
392
;
393
; set system vectors
394
; TBA defaults to zero on reset
395
;
396
        setlo   r3,#0
397
        setlo   r2,#511
398
        lea             r1,nmirout
399
csj5:
400
        sw              r1,[r3]
401
        addui   r3,r3,#8
402
        loop    r2,csj5
403
        lea             r1,KeybdSC              ; keyboard BIOS vector
404
        sw              r1,0xD08
405
        lea             r1,irqrout
406
        sw              r1,0xE08                ; set IRQ vector
407
        lea             r1,dberr_rout
408
        sw              r1,0xFE0                ; set Bus error vector
409
        lea             r1,iberr_rout
410
        sw              r1,0xFE8                ; set Bus error vector
411
        lea             r1,nmirout
412
        sw              r1,0xFF0                ; set NMI vector
413
 
414
        lea             r1,KeybdIRQ
415
        sw              r1,keybdIRQvec
416
        lea             r1,Pulse100
417
        sw              r1,p100IRQvec
418
        lea             r1,SerialIRQ
419
        sw              r1,serialIRQvec
420
        lea             r1,RasterIRQfn
421
        sw              r1,rasterIRQvec
422
 
423
        ;-------------------------------
424
        ; Initialize I/O devices
425
        ;-------------------------------
426
        call    SerialInit
427 27 robfinch
        call    KeybdInit
428
        call    PICInit
429 43 robfinch
        call    SetupRasterIRQ
430 27 robfinch
        cli                                             ; enable interrupts
431 43 robfinch
;       call    HelloWorld
432 27 robfinch
        setlo   r3,#0xCE                ; blue on blue
433
        sc              r3,ScreenColor
434 43 robfinch
        lc              r3,0x1414
435 27 robfinch
        setlo   r3,#32
436 43 robfinch
        sc              r3,0x1416               ; we do a store, then a load through the dcache
437
        lc              r2,0x1416               ;
438 27 robfinch
        beq             r2,r3,dcokay
439
        dcache_off                              ; data cache failed
440
dcokay:
441 43 robfinch
        sc              r0,NextToRunTCB
442
        sc              r0,RunningTCB
443 27 robfinch
        call    ClearScreen
444
        call    ClearBmpScreen
445 43 robfinch
        call    RandomizeSprram
446 27 robfinch
        sc              r0,CursorRow
447
        sc              r0,CursorCol
448 43 robfinch
        setlo   r1,#1
449
        sb              r1,CursorFlash
450
        lea             r1,MSGSTART
451
        call    DisplayStringCRLF
452
        jmp             Monitor
453
        call    SetupAC97               ; and Beep
454
        setlo   r3,#4
455
        outb    r3,LED
456
        call    Beep
457 27 robfinch
 
458
j4:
459
        jmp             Monitor
460
        bra             j4
461
 
462 43 robfinch
; for now hang the contexts
463
;
464
ctxstart1:
465
        bra             ctxstart1
466
 
467 27 robfinch
;       call    ramtest
468
 
469
;-----------------------------------------
470
; Hello World!
471
;-----------------------------------------
472
HelloWorld:
473
        subui   r30,r30,#24
474 43 robfinch
        sw              r1,[sp]
475
        sw              r2,8[sp]
476
        sw              lr,16[sp]
477
        lea             r2,MSG
478 27 robfinch
j3:
479
        lb              r1,[r2]
480
        beq             r1,r0,j2
481
        call    SerialPutChar
482
        addui   r2,r2,#1
483
        bra             j3
484
j2:
485 43 robfinch
        sw              lr,16[sp]
486
        sw              r2,8[sp]
487
        sw              r1,[sp]
488 27 robfinch
        ret             #24
489
 
490
 
491
        align   16
492
MSG:
493 43 robfinch
        db      "Hello World!",0
494 27 robfinch
MSGSTART:
495 43 robfinch
        db      "Raptor64 system starting....",0
496 27 robfinch
 
497
        align 16
498
 
499
;----------------------------------------------------------
500
; Initialize programmable interrupt controller (PIC)
501
;  0 = nmi
502
;  1 = keyboard reset
503 43 robfinch
;  2 = 1000Hz pulse (context switcher)
504
;  3 = 100Hz pulse (cursor flash)
505
;  8 = uart
506
; 13 = raster interrupt
507 27 robfinch
; 15 = keyboard char
508
;----------------------------------------------------------
509
PICInit:
510 43 robfinch
        lea             r1,PICret
511
        sw              r1,TickIRQAddr
512
        ; enable: raster irq,
513
        setlo   r1,#0xA00F      ; enable nmi,kbd_rst,and kbd_irq
514
        ; A10F enable serial IRQ
515
        outc    r1,PIC_IE
516
PICret:
517 27 robfinch
        ret
518
 
519 43 robfinch
;==============================================================================
520
; Serial port
521
;==============================================================================
522 27 robfinch
;-----------------------------------------
523 43 robfinch
; Initialize the serial port
524 27 robfinch
;-----------------------------------------
525 43 robfinch
;
526
SerialInit:
527
        sc              r0,Uart_rxhead          ; reset buffer indexes
528
        sc              r0,Uart_rxtail
529
        setlo   r1,#0x1f0
530
        sc              r1,Uart_foff            ; set threshold for XOFF
531
        setlo   r1,#0x010
532
        sc              r1,Uart_fon                     ; set threshold for XON
533
        setlo   r1,#1
534
        outb    r1,UART_IE                      ; enable receive interrupt only
535
        sb              r0,Uart_rxrts           ; no RTS/CTS signals available
536
        sb              r0,Uart_txrts           ; no RTS/CTS signals available
537
        sb              r0,Uart_txdtr           ; no DTR signals available
538
        sb              r0,Uart_rxdtr           ; no DTR signals available
539
        setlo   r1,#1
540
        sb              r1,Uart_txxon           ; for now
541
        ret
542
 
543
;---------------------------------------------------------------------------------
544
; Get character directly from serial port. Blocks until a character is available.
545
;---------------------------------------------------------------------------------
546
;
547
SerialGetCharDirect:
548 27 robfinch
sgc1:
549 43 robfinch
        inb             r1,UART_LS              ; uart status
550
        andi    r1,r1,#rxfull   ; is there a char available ?
551
        beq             r1,r0,sgc1
552
        inb             r1,UART
553
        ret
554 27 robfinch
 
555 43 robfinch
;------------------------------------------------
556
; Check for a character at the serial port
557
; returns r1 = 1 if char available, 0 otherwise
558
;------------------------------------------------
559
;
560
SerialCheckForCharDirect:
561
        inb             r1,UART_LS              ; uart status
562
        andi    r1,r1,#rxfull   ; is there a char available ?
563
        sne             r1,r1,r0
564
        ret
565
 
566 27 robfinch
;-----------------------------------------
567
; Put character to serial port
568 43 robfinch
; r1 = char to put
569 27 robfinch
;-----------------------------------------
570 43 robfinch
;
571 27 robfinch
SerialPutChar:
572 43 robfinch
        subui   sp,sp,#32
573
        sw              r2,[sp]
574
        sw              r3,8[sp]
575
        sw              r4,16[sp]
576
        sw              r5,24[sp]
577
        inb             r2,UART_MC
578
        ori             r2,r2,#3                ; assert DTR / RTS
579
        outb    r2,UART_MC
580
        lb              r2,Uart_txrts
581
        beq             r2,r0,spcb1
582
        lw              r4,Milliseconds
583
        setlo   r3,#100                 ; delay count (1 s)
584
spcb3:
585
        inb             r2,UART_MS
586
        andi    r2,r2,#10               ; is CTS asserted ?
587
        bne             r2,r0,spcb1
588
        lw              r5,Milliseconds
589
        beq             r4,r5,spcb3
590
        mov             r4,r5
591
        loop    r3,spcb3
592
        bra             spcabort
593
spcb1:
594
        lb              r2,Uart_txdtr
595
        beq             r2,r0,spcb2
596
        lw              r4,Milliseconds
597
        setlo   r3,#100                 ; delay count
598
spcb4:
599
        inb             r2,UART_MS
600
        andi    r2,r2,#20               ; is DSR asserted ?
601
        bne             r2,r0,spcb2
602
        lw              r5,Milliseconds
603
        beq             r4,r5,spcb4
604
        mov             r4,r5
605
        loop    r3,spcb4
606
        bra             spcabort
607
spcb2:
608
        lb              r2,Uart_txxon
609
        beq             r2,r0,spcb5
610
spcb6:
611
        lb              r2,Uart_txxonoff
612
        beq             r2,r0,spcb5
613
        inb             r4,UART_MS
614
        andi    r4,r4,#0x80                     ; DCD ?
615
        bne             r4,r0,spcb6
616
spcb5:
617
        lw              r4,Milliseconds
618
        setlo   r3,#100                         ; wait up to 1s
619
spcb8:
620
        inb             r2,UART_LS
621
        andi    r2,r2,#0x20                     ; tx not full ?
622
        bne             r2,r0,spcb7
623
        lw              r5,Milliseconds
624
        beq             r4,r5,spcb8
625
        mov             r4,r5
626
        loop    r3,spcb8
627
        bra             spcabort
628
spcb7:
629
        outb    r1,UART
630
spcabort:
631
        lw              r2,[sp]
632
        lw              r3,8[sp]
633
        lw              r4,16[sp]
634
        lw              r5,24[sp]
635
        ret             #32
636 27 robfinch
 
637 43 robfinch
;-------------------------------------------------
638
; Compute number of characters in recieve buffer.
639
; r4 = number of chars
640
;-------------------------------------------------
641
CharsInRxBuf:
642
        lc              r4,Uart_rxhead
643
        lc              r2,Uart_rxtail
644
        subu    r4,r4,r2
645
        bgt             r4,r0,cirxb1
646
        setlo   r4,#0x200
647
        addu    r4,r4,r2
648
        lc              r2,Uart_rxhead
649
        subu    r4,r4,r2
650
cirxb1:
651
        ret
652
 
653
;----------------------------------------------
654
; Get character from rx fifo
655
; If the fifo is empty enough then send an XON
656
;----------------------------------------------
657
;
658
SerialGetChar:
659
        subui   sp,sp,#32
660
        sw              r2,[sp]
661
        sw              r3,8[sp]
662
        sw              r4,16[sp]
663
        sw              lr,24[sp]
664
        lc              r3,Uart_rxhead
665
        lc              r2,Uart_rxtail
666
        beq             r2,r3,sgcfifo1  ; is there a char available ?
667
        lea             r3,Uart_rxfifo
668
        lb              r1,[r2+r3]              ; get the char from the fifo into r1
669
        addui   r2,r2,#1                ; increment the fifo pointer
670
        andi    r2,r2,#0x1ff
671
        sc              r2,Uart_rxtail
672
        lb              r2,Uart_rxflow  ; using flow control ?
673
        beq             r2,r0,sgcfifo2
674
        lc              r3,Uart_fon             ; enough space in Rx buffer ?
675
        call    CharsInRxBuf
676
        bgt             r4,r3,sgcfifo2
677
        sb              r0,Uart_rxflow  ; flow off
678
        lb              r4,Uart_rxrts
679
        beq             r4,r0,sgcfifo3
680
        inb             r4,UART_MC              ; set rts bit in MC
681
        ori             r4,r4,#2
682
        outb    r4,UART_MC
683
sgcfifo3:
684
        lb              r4,Uart_rxdtr
685
        beq             r4,r0,sgcfifo4
686
        inb             r4,UART_MC              ; set DTR
687
        ori             r4,r4,#1
688
        outb    r4,UART_MC
689
sgcfifo4:
690
        lb              r4,Uart_rxxon
691
        beq             r4,r0,sgcfifo5
692
        setlo   r4,#XON
693
        outb    r4,UART
694
sgcfifo5:
695
sgcfifo2:                                       ; return with char in r1
696
        lw              r2,[sp]
697
        lw              r3,8[sp]
698
        lw              r4,16[sp]
699
        lw              lr,24[sp]
700
        ret             #32
701
sgcfifo1:
702
        setlo   r1,#-1                  ; no char available
703
        lw              r2,[sp]
704
        lw              r3,8[sp]
705
        lw              r4,16[sp]
706
        lw              lr,24[sp]
707
        ret             #32
708
 
709
;-----------------------------------------
710
; Serial port IRQ
711
;-----------------------------------------
712
;
713
SerialIRQ:
714
        subui   sp,sp,#40
715
        sw              r1,[sp]
716
        sw              r2,8[sp]
717
        sw              r3,16[sp]
718
        sw              r4,24[sp]
719
        sw              lr,32[sp]
720
        inb             r1,UART_IS              ; get interrupt status
721
        bge             r1,r0,sirq1
722
        andi    r1,r1,#0x7f             ; switch on interrupt type
723
        beqi    r1,#4,srxirq
724
        beqi    r1,#0xC,stxirq
725
        beqi    r1,#0x10,smsirq
726
sirq1:
727
        lw              r1,[sp]
728
        lw              r2,8[sp]
729
        lw              r3,16[sp]
730
        lw              r4,24[sp]
731
        lw              lr,32[sp]
732
        ret             #40
733
 
734
; Get the modem status and record it
735
smsirq:
736
        inb             r1,UART_MS
737
        sb              r1,Uart_ms
738
        bra             sirq1
739
 
740
stxirq:
741
        bra             sirq1
742
 
743
; Get a character from the uart and store it in the rx fifo
744
srxirq:
745
srxirq1:
746
        inb             r1,UART                         ; get the char (clears interrupt)
747
        lb              r2,Uart_txxon
748
        beq             r2,r0,srxirq3
749
        bnei    r1,#XOFF,srxirq2
750
        setlo   r1,#1
751
        sb              r1,Uart_txxonoff
752
        bra             srxirq5
753
srxirq2:
754
        bnei    r1,#XON,srxirq3
755
        sb              r0,Uart_txxonoff
756
        bra             srxirq5
757
srxirq3:
758
        sb              r0,Uart_txxonoff
759
        lc              r2,Uart_rxhead
760
        lea             r3,Uart_rxfifo
761
        sb              r1,[r3+r2]                      ; store in buffer
762
        addui   r2,r2,#1
763
        andi    r2,r2,#0x1ff
764
        sc              r2,Uart_rxhead
765
srxirq5:
766
        inb             r1,UART_LS                      ; check for another ready character
767
        andi    r1,r1,#rxfull
768
        bne             r1,r0,srxirq1
769
        lb              r1,Uart_rxflow          ; are we using flow controls?
770
        bne             r1,r0,srxirq8
771
        call    CharsInRxBuf
772
        lc              r1,Uart_foff
773
        blt             r4,r1,srxirq8
774
        setlo   r1,#1
775
        sb              r1,Uart_rxflow
776
        lb              r1,Uart_rxrts
777
        beq             r1,r0,srxirq6
778
        inb             r1,UART_MC
779
        andi    r1,r1,#0xFD             ; turn off RTS
780
        outb    r1,UART_MC
781
srxirq6:
782
        lb              r1,Uart_rxdtr
783
        beq             r1,r0,srxirq7
784
        inb             r1,UART_MC
785
        andi    r1,r1,#0xFE             ; turn off DTR
786
        outb    r1,UART_MC
787
srxirq7:
788
        lb              r1,Uart_rxxon
789
        beq             r1,r0,srxirq8
790
        setlo   r1,#XOFF
791
        outb    r1,UART
792
srxirq8:
793
        bra             sirq1
794
 
795 27 robfinch
;==============================================================================
796 43 robfinch
; Keyboard BIOS
797
; BIOS interrupt #417
798
;
799
; Function in R1
800
; 0 = initialize keyboard
801
; 1 = set keyboard echo
802
; 2 = get keyboard character
803
; 3 = check for key available
804 27 robfinch
;==============================================================================
805 43 robfinch
;
806
KeybdSC:
807
        subui   sp,sp,#8
808
        sw              lr,[sp]
809
        bnei    r1,#0,kbdsc1
810
        call    KeybdInit
811
        bra             kbdscRet
812
kbdsc1:
813
        bnei    r1,#1,kbdsc2
814
        mov             r1,r2
815
        call    SetKeyboardEcho
816
        bra             kbdscRet
817
kbdsc2:
818
        bnei    r1,#2,kbdsc3
819
        call    KeybdGetChar
820
        bra             kbdscRet
821
kbdsc3:
822
        bnei    r1,#3,kbdsc4
823
        call    KeybdCheckForKey
824
        bra             kbdscRet
825
kbdsc4:
826
kbdscRet:
827
        lw              lr,[sp]
828
        addui   sp,sp,#8
829
        eret
830
 
831 27 robfinch
;------------------------------------------------------------------------------
832
; Initialize keyboard
833
;------------------------------------------------------------------------------
834
KeybdInit:
835
        sb              r0,KeybdHead
836
        sb              r0,KeybdTail
837
        setlo   r1,#1                   ; turn on keyboard echo
838
        sb              r1,KeybdEcho
839
        ret
840
 
841
;------------------------------------------------------------------------------
842
; Normal keyboard interrupt, the lowest priority interrupt in the system.
843
; Grab the character from the keyboard device and store it in a buffer.
844
;------------------------------------------------------------------------------
845
;
846
KeybdIRQ:
847 43 robfinch
        subui   sp,sp,#8
848
        sw              r2,[sp]
849 27 robfinch
        lbu             r1,KeybdHead
850
        andi    r1,r1,#0x0f                             ; r1 = index into buffer
851
KeybdIRQa:
852
        inch    r2,KEYBD                                ; get keyboard character
853
        outc    r0,KEYBD+2                              ; clear keyboard strobe (turns off the IRQ)
854 43 robfinch
        sb              r2,KeybdBuffer[r1]              ; store character in buffer
855 27 robfinch
        addui   r1,r1,#1                                ; increment head index
856
        andi    r1,r1,#0x0f
857
        sb              r1,KeybdHead
858
KeybdIRQb:
859
        lbu             r2,KeybdTail                    ; check to see if we've collided
860
        bne             r1,r2,KeybdIRQc                 ; with the tail
861
        addui   r2,r2,#1                                ; if so, increment the tail index
862
        andi    r2,r2,#0x0f                             ; the oldest character will be lost
863
        sb              r2,KeybdTail
864
KeybdIRQc:
865 43 robfinch
        lw              r2,[sp]
866
        ret             #8
867 27 robfinch
 
868
;------------------------------------------------------------------------------
869
; r1 0=echo off, non-zero = echo on
870
;------------------------------------------------------------------------------
871
SetKeyboardEcho:
872
        sb              r1,KeybdEcho
873
        ret
874
 
875
;-----------------------------------------
876
; Get character from keyboard buffer
877
;-----------------------------------------
878
KeybdGetChar:
879
        subui   sp,sp,#16
880 43 robfinch
        sw              r2,[sp]
881
        sw              lr,8[sp]
882 27 robfinch
        lbu             r2,KeybdTail
883
        lbu             r1,KeybdHead
884
        beq             r1,r2,nochar
885 43 robfinch
        lbu             r1,KeybdBuffer[r2]
886 27 robfinch
        addui   r2,r2,#1
887
        andi    r2,r2,#0x0f
888
        sb              r2,KeybdTail
889 43 robfinch
        lb              r2,KeybdEcho
890
        beq             r2,r0,kgc3
891
        bnei    r1,#CR,kgc2
892
        call    CRLF                    ; convert CR keystroke into CRLF
893
        bra             kgc3
894
kgc2:
895
        call    DisplayChar
896
        bra             kgc3
897 27 robfinch
nochar:
898
        setlo   r1,#-1
899 43 robfinch
kgc3:
900
        lw              lr,8[sp]
901
        lw              r2,[sp]
902 27 robfinch
        ret             #16
903
 
904
;------------------------------------------------------------------------------
905
; Check if there is a keyboard character available in the keyboard buffer.
906
;------------------------------------------------------------------------------
907
;
908
KeybdCheckForKey:
909
        lbu             r1,KeybdTail
910
        lbu             r2,KeybdHead
911 43 robfinch
        sne             r1,r1,r2
912 27 robfinch
        ret
913
 
914
;------------------------------------------------------------------------------
915
; Check if there is a keyboard character available. If so return true (1)
916
; otherwise return false (0) in r1.
917
;------------------------------------------------------------------------------
918
;
919
KeybdCheckForKeyDirect:
920
        inch    r1,KEYBD
921 43 robfinch
        slt             r1,r1,r0
922 27 robfinch
        ret
923
 
924
;------------------------------------------------------------------------------
925
; Get character directly from keyboard. This routine blocks until a key is
926
; available.
927
;------------------------------------------------------------------------------
928
;
929
KeybdGetCharDirect:
930
        subui   sp,sp,#16
931 43 robfinch
        sw              r2,[sp]
932
        sw              lr,8[sp]
933 27 robfinch
        setlo   r2,KEYBD
934
kgc1:
935
        inch    r1,KEYBD
936
        bge             r1,r0,kgc1
937
        outc    r0,KEYBD+2              ; clear keyboard strobe
938
        andi    r1,r1,#0xff             ; remove strobe bit
939
        lb              r2,KeybdEcho    ; is keyboard echo on ?
940
        beq             r2,r0,gk1
941
        bnei    r1,#'\r',gk2    ; convert CR keystroke into CRLF
942
        call    CRLF
943
        bra             gk1
944
gk2:
945
        call    DisplayChar
946
gk1:
947 43 robfinch
        lw              r2,[sp]
948
        lw              lr,8[sp]
949 27 robfinch
        ret             #16
950
 
951
;==============================================================================
952
;==============================================================================
953
;------------------------------------------------------------------------------
954 43 robfinch
; 100 Hz interrupt
955 27 robfinch
; - takes care of "flashing" the cursor
956
;------------------------------------------------------------------------------
957
;
958 43 robfinch
Pulse100:
959
        subui   sp,sp,#8
960
        sw              lr,[sp]
961
        lea             r2,TEXTSCR
962
        inch    r1,334[r2]
963 27 robfinch
        addui   r1,r1,#1
964 43 robfinch
        outc    r1,334[r2]
965
        call    DisplayDatetime
966
        call    SelectNextToRunTCB
967
        call    SwitchTask
968
        sb              r0,0xFFFF_FFFF_FFFF_0010        ; clear interrupt
969
;       lw              r1,TickIRQAddr
970
;       jal             r31,[r1]
971
;       lw              r1,Milliseconds
972
;       andi    r1,r1,#0x0f
973
;       bnei    r1,#5,p1001
974
;       call    FlashCursor
975
p1001:
976
        lw              lr,[sp]
977
        ret             #8
978 27 robfinch
 
979
;------------------------------------------------------------------------------
980 43 robfinch
;------------------------------------------------------------------------------
981
SelectNextToRunTCB:
982
        sc              r0,NextToRunTCB
983
        ret
984
 
985
;------------------------------------------------------------------------------
986
; Switch from the RunningTCB to the NextToRunTCB
987
;------------------------------------------------------------------------------
988
SwitchTask:
989
        sw              r1,r1save
990
        sw              r2,r2save
991
        lcu             r1,NextToRunTCB
992
        lcu             r2,RunningTCB
993
        bne             r1,r2,swtsk1            ; are we already running this TCB ?
994
        lw              r1,r1save
995
        lw              r2,r2save
996
        ret
997
swtsk1:
998
        andi    r2,r2,#0x1ff            ; max 512 TCB's
999
        mului   r2,r2,#TCBSize
1000
        addui   r2,r2,#TCBBase
1001
        lw              r1,r1save                       ; get back r1
1002
        sw              r1,TCBr1[r2]
1003
        lw              r1,r2save                       ; get back r2
1004
        sw              r1,TCBr2[r2]
1005
        sw              r3,TCBr3[r2]
1006
        sw              r4,TCBr4[r2]
1007
        sw              r5,TCBr5[r2]
1008
        sw              r6,TCBr6[r2]
1009
        sw              r7,TCBr7[r2]
1010
        sw              r8,TCBr8[r2]
1011
        sw              r9,TCBr9[r2]
1012
        sw              r10,TCBr10[r2]
1013
        sw              r11,TCBr11[r2]
1014
        sw              r12,TCBr12[r2]
1015
        sw              r13,TCBr13[r2]
1016
        sw              r14,TCBr14[r2]
1017
        sw              r15,TCBr15[r2]
1018
        sw              r16,TCBr16[r2]
1019
        sw              r17,TCBr17[r2]
1020
        sw              r18,TCBr18[r2]
1021
        sw              r19,TCBr19[r2]
1022
        sw              r20,TCBr20[r2]
1023
        sw              r21,TCBr21[r2]
1024
        sw              r22,TCBr22[r2]
1025
        sw              r23,TCBr23[r2]
1026
        sw              r24,TCBr24[r2]
1027
        sw              r25,TCBr25[r2]
1028
        sw              r26,TCBr26[r2]
1029
        sw              r27,TCBr27[r2]
1030
        sw              r28,TCBr28[r2]
1031
        sw              r29,TCBr29[r2]
1032
        sw              r30,TCBr30[r2]
1033
        sw              r31,TCBr31[r2]
1034
 
1035
        lcu             r2,NextToRunTCB
1036
        sc              r2,RunningTCB
1037
        mului   r2,r2,#TCBSize
1038
        addui   r2,r2,#TCBBase
1039
 
1040
        lw              r1,TCBr1[r2]
1041
        lw              r3,TCBr3[r2]
1042
        lw              r4,TCBr4[r2]
1043
        lw              r5,TCBr5[r2]
1044
        lw              r6,TCBr6[r2]
1045
        lw              r7,TCBr7[r2]
1046
        lw              r8,TCBr8[r2]
1047
        lw              r9,TCBr9[r2]
1048
        lw              r10,TCBr10[r2]
1049
        lw              r11,TCBr11[r2]
1050
        lw              r12,TCBr12[r2]
1051
        lw              r13,TCBr13[r2]
1052
        lw              r14,TCBr14[r2]
1053
        lw              r15,TCBr15[r2]
1054
        lw              r16,TCBr16[r2]
1055
        lw              r17,TCBr17[r2]
1056
        lw              r18,TCBr18[r2]
1057
        lw              r19,TCBr19[r2]
1058
        lw              r20,TCBr20[r2]
1059
        lw              r21,TCBr21[r2]
1060
        lw              r22,TCBr22[r2]
1061
        lw              r23,TCBr23[r2]
1062
        lw              r24,TCBr24[r2]
1063
        lw              r25,TCBr25[r2]
1064
        lw              r26,TCBr26[r2]
1065
        lw              r27,TCBr27[r2]
1066
        lw              r28,TCBr28[r2]
1067
        lw              r29,TCBr29[r2]
1068
        lw              r30,TCBr30[r2]
1069
        lw              r31,TCBr31[r2]
1070
        lw              r2,TCBr2[r2]
1071
        ret
1072
 
1073
;------------------------------------------------------------------------------
1074 27 robfinch
; Flash Cursor
1075
;------------------------------------------------------------------------------
1076
;
1077
FlashCursor:
1078
        subui   sp,sp,#32
1079 43 robfinch
        sw              r1,[sp]
1080
        sw              r2,8[sp]
1081
        sw              r3,16[sp]
1082
        sw              lr,24[sp]
1083 27 robfinch
        call    CalcScreenLoc
1084
        addui   r1,r1,#0x10000
1085 43 robfinch
        lb              r2,CursorFlash
1086
        beq             r2,r0,flshcrsr2
1087 27 robfinch
        ; causes screen colors to flip around
1088 43 robfinch
        inch    r2,[r1]
1089 27 robfinch
        addui   r2,r2,#1
1090 43 robfinch
        outc    r2,[r1]
1091
flshcrsr3:
1092 27 robfinch
        lw              r2,Lastloc
1093
        beq             r1,r2,flshcrsr1
1094
        ; restore the screen colors of the previous cursor location
1095
        lc              r3,ScreenColor
1096 43 robfinch
        outc    r3,[r2]
1097 27 robfinch
        sw              r1,Lastloc
1098
flshcrsr1:
1099 43 robfinch
        lw              r1,[sp]
1100
        lw              r2,8[sp]
1101
        lw              r3,16[sp]
1102
        lw              lr,24[sp]
1103 27 robfinch
        ret             #32
1104 43 robfinch
flshcrsr2:
1105
        lc              r3,ScreenColor
1106
        outc    r3,[r1]
1107
        bra             flshcrsr3
1108 27 robfinch
 
1109 43 robfinch
CursorOff:
1110
        lw              r1,#0xA0
1111
        outc    r1,TEXTREG+16           ; turn off cursor
1112
        ret
1113
CursorOn:
1114
        lw              r1,#0xE0
1115
        outc    r1,TEXTREG+16           ; turn on cursor
1116
        ret
1117
 
1118 27 robfinch
;------------------------------------------------------------------------------
1119
;------------------------------------------------------------------------------
1120
ClearBmpScreen:
1121 43 robfinch
        subui   sp,sp,#24
1122
        sw              r1,[sp]
1123
        sw              r2,8[sp]
1124
        sw              r3,16[sp]
1125
        lw              r2,#1364*768
1126
        shrui   r2,r2,#3                        ; r2 = # words to clear
1127
        lea             r1,0x2929292929292929   ; r1 = color for eight pixels
1128
        lea             r3,BITMAPSCR            ; r3 = screen address
1129 27 robfinch
csj4:
1130 43 robfinch
        sw              r1,[r3]                         ; store pixel data
1131
        addui   r3,r3,#8                        ; advance screen address by eight
1132
        loop    r2,csj4                         ; decrement pixel count and loop back
1133
        lw              r1,[sp]
1134
        lw              r2,8[sp]
1135
        lw              r3,16[sp]
1136
        ret             #24
1137 27 robfinch
 
1138
;------------------------------------------------------------------------------
1139
; Clear the screen and the screen color memory
1140
; We clear the screen to give a visual indication that the system
1141
; is working at all.
1142
;------------------------------------------------------------------------------
1143
;
1144
ClearScreen:
1145
        subui   sp,sp,#40
1146 43 robfinch
        sw              r1,[sp]
1147
        sw              r2,8[sp]
1148
        sw              r3,16[sp]
1149
        sw              r4,24[sp]
1150
        sw              lr,32[sp]
1151
        lea             r3,TEXTREG
1152
        inch    r1,TEXT_COLS[r3]        ; calc number to clear
1153
        inch    r2,TEXT_ROWS[r3]
1154 27 robfinch
        mulu    r2,r1,r2                        ; r2 = # chars to clear
1155
        setlo   r1,#32                  ; space char
1156
        lc              r4,ScreenColor
1157
        call    AsciiToScreen
1158 43 robfinch
        lea             r3,TEXTSCR              ; text screen address
1159 27 robfinch
csj4:
1160 43 robfinch
        outc    r1,[r3]
1161
        outc    r4,0x10000[r3]  ; color screen is 0x10000 higher
1162
        addui   r3,r3,#2
1163 27 robfinch
        loop    r2,csj4
1164 43 robfinch
        lw              lr,32[sp]
1165
        lw              r4,24[sp]
1166
        lw              r3,16[sp]
1167
        lw              r2,8[sp]
1168
        lw              r1,[sp]
1169 27 robfinch
        ret             #40
1170
 
1171
;------------------------------------------------------------------------------
1172
; Scroll text on the screen upwards
1173
;------------------------------------------------------------------------------
1174
;
1175
ScrollUp:
1176
        subui   sp,sp,#40
1177 43 robfinch
        sw              r1,[sp]
1178
        sw              r2,8[sp]
1179
        sw              r3,16[sp]
1180
        sw              r4,24[sp]
1181
        sw              lr,32[sp]
1182
        lea             r3,TEXTREG
1183
        inch    r1,TEXT_COLS[r3]        ; r1 = # text columns
1184
        inch    r2,TEXT_ROWS[r3]
1185 27 robfinch
        mulu    r2,r1,r2                        ; calc number of chars to scroll
1186
        subu    r2,r2,r1                        ; one less row
1187 43 robfinch
        lea             r3,TEXTSCR
1188 27 robfinch
scrup1:
1189 43 robfinch
        inch    r4,[r3+r1]                      ; indexed addressing example
1190
        outc    r4,[r3]
1191 27 robfinch
        addui   r3,r3,#2
1192
        loop    r2,scrup1
1193
 
1194 43 robfinch
        lea             r3,TEXTREG
1195
        inch    r1,TEXT_ROWS[r3]
1196 27 robfinch
        subui   r1,r1,#1
1197
        call    BlankLine
1198 43 robfinch
        lw              r1,[sp]
1199
        lw              r2,8[sp]
1200
        lw              r3,16[sp]
1201
        lw              r4,24[sp]
1202
        lw              lr,32[sp]
1203 27 robfinch
        ret             #40
1204
 
1205
;------------------------------------------------------------------------------
1206
; Blank out a line on the display
1207
; line number to blank is in r1
1208
;------------------------------------------------------------------------------
1209
;
1210
BlankLine:
1211
        subui   sp,sp,#24
1212 43 robfinch
        sw              r1,[sp]
1213
        sw              r2,8[sp]
1214
        sw              r3,16[sp]
1215
        lea             r3,TEXTREG                      ; r3 = text register address
1216
        inch    r2,TEXT_COLS[r3]        ; r2 = # chars to blank out
1217 27 robfinch
        mulu    r3,r2,r1
1218
        shli    r3,r3,#1
1219
        addui   r3,r3,#TEXTSCR          ; r3 = screen address
1220
        setlo   r1,#' '
1221
blnkln1:
1222 43 robfinch
        outc    r1,[r3]
1223 27 robfinch
        addui   r3,r3,#2
1224
        loop    r2,blnkln1
1225 43 robfinch
        lw              r1,[sp]
1226
        lw              r2,8[sp]
1227
        lw              r3,16[sp]
1228 27 robfinch
        ret             #24
1229
 
1230
;------------------------------------------------------------------------------
1231
; Convert ASCII character to screen display character.
1232
;------------------------------------------------------------------------------
1233
;
1234
AsciiToScreen:
1235
        andi    r1,r1,#0x00ff
1236
        bltui   r1,#'A',atoscr1
1237
        bleui   r1,#'Z',atoscr1
1238
        bgtui   r1,#'z',atoscr1
1239
        bltui   r1,#'a',atoscr1
1240
        subi    r1,r1,#0x60
1241
atoscr1:
1242
        ori             r1,r1,#0x100
1243
        ret
1244
 
1245
;------------------------------------------------------------------------------
1246
; Convert screen character to ascii character
1247
;------------------------------------------------------------------------------
1248
;
1249
ScreenToAscii:
1250
        andi    r1,r1,#0xff
1251
        bgtui   r1,#26,stasc1
1252
        addui   r1,r1,#60
1253
stasc1:
1254
        ret
1255
 
1256
;------------------------------------------------------------------------------
1257
; Calculate screen memory location from CursorRow,CursorCol.
1258
; Also refreshes the cursor location.
1259
; Destroys r1,r2,r3
1260
; r1 = screen location
1261
;------------------------------------------------------------------------------
1262
;
1263
CalcScreenLoc:
1264
        lc              r1,CursorRow
1265
        andi    r1,r1,#0x7f
1266 43 robfinch
        lea             r3,TEXTREG
1267 27 robfinch
        inch    r2,TEXT_COLS[r3]
1268
        mulu    r2,r2,r1
1269
        lc              r1,CursorCol
1270
        andi    r1,r1,#0x7f
1271
        addu    r2,r2,r1
1272
        outc    r2,TEXT_CURPOS[r3]
1273
        shli    r2,r2,#1
1274
        addui   r1,r2,#TEXTSCR                  ; r1 = screen location
1275
        ret
1276
 
1277
;------------------------------------------------------------------------------
1278
; Display a character on the screen
1279
; d1.b = char to display
1280
;------------------------------------------------------------------------------
1281
;
1282
DisplayChar:
1283
        bnei    r1,#'\r',dccr           ; carriage return ?
1284
        subui   sp,sp,#32
1285 43 robfinch
        sw              r1,[sp]
1286
        sw              r2,8[sp]
1287
        sw              r3,16[sp]
1288
        sw              lr,24[sp]
1289 27 robfinch
        sc              r0,CursorCol            ; just set cursor column to zero on a CR
1290
        bra             dcx7
1291
dccr:
1292
        bnei    r1,#0x91,dcx6           ; cursor right ?
1293
        subui   sp,sp,#32
1294 43 robfinch
        sw              r1,[sp]
1295
        sw              r2,8[sp]
1296
        sw              r3,16[sp]
1297
        sw              lr,24[sp]
1298 27 robfinch
        lc              r2,CursorCol
1299
        beqi    r2,#56,dcx7
1300
        addui   r2,r2,#1
1301
        sc              r2,CursorCol
1302
dcx7:
1303
        call    CalcScreenLoc
1304 43 robfinch
        lw              lr,24[sp]
1305
        lw              r3,16[sp]
1306
        lw              r2,8[sp]
1307
        lw              r1,[sp]
1308 27 robfinch
        ret             #32
1309
dcx6:
1310
        bnei    r1,#0x90,dcx8           ; cursor up ?
1311
        subui   sp,sp,#32
1312 43 robfinch
        sw              r1,[sp]
1313
        sw              r2,8[sp]
1314
        sw              r3,16[sp]
1315
        sw              lr,24[sp]
1316 27 robfinch
        lc              r2,CursorRow
1317
        beqi    r2,#0,dcx7
1318
        subui   r2,r2,#1
1319
        sc              r2,CursorRow
1320
        bra             dcx7
1321
dcx8:
1322
        bnei    r1,#0x93,dcx9           ; cursor left ?
1323
        subui   sp,sp,#32
1324 43 robfinch
        sw              r1,[sp]
1325
        sw              r2,8[sp]
1326
        sw              r3,16[sp]
1327
        sw              lr,24[sp]
1328 27 robfinch
        lc              r2,CursorCol
1329
        beqi    r2,#0,dcx7
1330
        subui   r2,r2,#1
1331
        sc              r2,CursorCol
1332
        bra             dcx7
1333
dcx9:
1334
        bnei    r1,#0x92,dcx10          ; cursor down ?
1335
        subui   sp,sp,#32
1336 43 robfinch
        sw              r1,[sp]
1337
        sw              r2,8[sp]
1338
        sw              r3,16[sp]
1339
        sw              lr,24[sp]
1340 27 robfinch
        lc              r2,CursorRow
1341
        beqi    r2,#30,dcx7
1342
        addui   r2,r2,#1
1343
        sc              r2,CursorRow
1344
        bra             dcx7
1345
dcx10:
1346
        bnei    r1,#0x94,dcx11                  ; cursor home ?
1347
        subui   sp,sp,#32
1348 43 robfinch
        sw              r1,[sp]
1349
        sw              r2,8[sp]
1350
        sw              r3,16[sp]
1351
        sw              lr,24[sp]
1352 27 robfinch
        lc              r2,CursorCol
1353
        beq             r2,r0,dcx12
1354
        sc              r0,CursorCol
1355
        bra             dcx7
1356
dcx12:
1357
        sc              r0,CursorRow
1358
        bra             dcx7
1359
dcx11:
1360
        subui   sp,sp,#48
1361 43 robfinch
        sw              r1,[sp]
1362
        sw              r2,8[sp]
1363
        sw              r3,16[sp]
1364
        sw              r4,24[sp]
1365
        sw              r5,32[sp]
1366
        sw              lr,40[sp]
1367 27 robfinch
        bnei    r1,#0x99,dcx13          ; delete ?
1368
        call    CalcScreenLoc
1369
        or              r3,r0,r1                        ; r3 = screen location
1370
        lc              r1,CursorCol            ; r1 = cursor column
1371
        bra             dcx5
1372
dcx13:
1373
        bnei    r1,#CTRLH,dcx3          ; backspace ?
1374
        lc              r2,CursorCol
1375
        beq             r2,r0,dcx4
1376
        subui   r2,r2,#1
1377
        sc              r2,CursorCol
1378
        call    CalcScreenLoc           ; a0 = screen location
1379
        or              r3,r0,r1                        ; r3 = screen location
1380
        lc              r1,CursorCol
1381
dcx5:
1382 43 robfinch
        inch    r2,2[r3]
1383
        outc    r2,[r3]
1384 27 robfinch
        addui   r3,r3,#2
1385
        addui   r1,r1,#1
1386 43 robfinch
        lea             r4,TEXTREG
1387 27 robfinch
        inch    r5,TEXT_COLS[r4]
1388
        bltu    r1,r5,dcx5
1389 43 robfinch
        setlo   r1,#' '
1390
        call    AsciiToScreen
1391
        outc    r1,-2[r3]
1392 27 robfinch
        bra             dcx4
1393
dcx3:
1394
        beqi    r1,#'\n',dclf   ; linefeed ?
1395
        or              r4,r0,r1                ; save r1 in r4
1396
        call    CalcScreenLoc   ; r1 = screen location
1397
        or              r3,r0,r1                ; r3 = screen location
1398
        or              r1,r0,r4                ; restore r1
1399
        call    AsciiToScreen   ; convert ascii char to screen char
1400 43 robfinch
        outc    r1,[r3]
1401 27 robfinch
        call    IncCursorPos
1402 43 robfinch
        bra             dcx4
1403 27 robfinch
dclf:
1404
        call    IncCursorRow
1405
dcx4:
1406 43 robfinch
        lw              lr,40[sp]
1407
        lw              r5,32[sp]
1408
        lw              r4,24[sp]
1409
        lw              r3,16[sp]
1410
        lw              r2,8[sp]
1411
        lw              r1,[sp]
1412 27 robfinch
        ret             #48
1413
 
1414
 
1415
;------------------------------------------------------------------------------
1416
; Increment the cursor position, scroll the screen if needed.
1417
;------------------------------------------------------------------------------
1418
;
1419
IncCursorPos:
1420
        subui   sp,sp,#32
1421 43 robfinch
        sw              r1,[sp]
1422
        sw              r2,8[sp]
1423
        sw              r3,16[sp]
1424
        sw              lr,24[sp]
1425 27 robfinch
        lc              r1,CursorCol
1426
        addui   r1,r1,#1
1427
        sc              r1,CursorCol
1428
        inch    r2,TEXTREG+TEXT_COLS
1429
        bleu    r1,r2,icc1
1430
        sc              r0,CursorCol            ; column = 0
1431
        bra             icr1
1432
IncCursorRow:
1433
        subui   sp,sp,#32
1434 43 robfinch
        sw              r1,[sp]
1435
        sw              r2,8[sp]
1436
        sw              r3,16[sp]
1437
        sw              lr,24[sp]
1438 27 robfinch
icr1:
1439
        lc              r1,CursorRow
1440
        addui   r1,r1,#1
1441
        sc              r1,CursorRow
1442
        inch    r2,TEXTREG+TEXT_ROWS
1443
        bleu    r1,r2,icc1
1444
        subui   r2,r2,#1                        ; backup the cursor row, we are scrolling up
1445
        sc              r2,CursorRow
1446
        call    ScrollUp
1447
icc1:
1448
        call    CalcScreenLoc
1449 43 robfinch
        lw              lr,24[sp]
1450
        lw              r3,16[sp]
1451
        lw              r2,8[sp]
1452
        lw              r1,[sp]
1453 27 robfinch
        ret             #32
1454
 
1455
;------------------------------------------------------------------------------
1456
; Display a string on the screen.
1457
;------------------------------------------------------------------------------
1458
;
1459
DisplayString:
1460
        subi    sp,sp,#24
1461 43 robfinch
        sw              r1,[sp]
1462
        sw              r2,8[sp]
1463
        sw              lr,16[sp]
1464
        mov             r2,r1                   ; r2 = pointer to string
1465 27 robfinch
dspj1:
1466
        lbu             r1,[r2]                 ; move string char into r1
1467
        addui   r2,r2,#1                ; increment pointer
1468
        beq             r1,r0,dsret             ; is it end of string ?
1469
        call    DisplayChar             ; display character
1470
        bra             dspj1                   ; go back for next character
1471
dsret:
1472 43 robfinch
        lw              lr,16[sp]
1473
        lw              r2,8[sp]
1474
        lw              r1,[sp]
1475 27 robfinch
        ret             #24
1476
 
1477
DisplayStringCRLF:
1478
        subui   r30,r30,#8
1479
        sw              r31,[r30]
1480
        call    DisplayString
1481
        lw              r31,[r30]
1482
        addui   r30,r30,#8
1483
 
1484
CRLF:
1485
        subui   r30,r30,#16
1486 43 robfinch
        sw              r1,[sp]
1487
        sw              lr,8[sp]
1488 27 robfinch
        setlo   r1,#'\r'
1489
        call    DisplayChar
1490
        setlo   r1,#'\n'
1491
        call    DisplayChar
1492 43 robfinch
        lw              lr,8[sp]
1493
        lw              r1,[sp]
1494 27 robfinch
        ret             #16
1495
 
1496
;------------------------------------------------------------------------------
1497
; Display nybble in r1
1498
;------------------------------------------------------------------------------
1499
;
1500
DisplayNybble:
1501 43 robfinch
        subui   sp,sp,#16
1502
        sw              r1,[sp]
1503
        sw              lr,8[sp]
1504 27 robfinch
        andi    r1,r1,#0x0F
1505
        addui   r1,r1,#'0'
1506
        bleui   r1,#'9',dispnyb1
1507
        addui   r1,r1,#7
1508
dispnyb1:
1509
        call    DisplayChar
1510 43 robfinch
        lw              lr,8[sp]
1511
        lw              r1,[sp]
1512 27 robfinch
        ret             #16
1513
 
1514
;------------------------------------------------------------------------------
1515
; Display the byte in r1
1516
;------------------------------------------------------------------------------
1517
;
1518
DisplayByte:
1519
        subui   sp,sp,#16
1520 43 robfinch
        sw              r1,[sp]
1521
        sw              lr,8[sp]
1522 27 robfinch
        rori    r1,r1,#4
1523
        call    DisplayNybble
1524
        roli    r1,r1,#4
1525
        call    DisplayNybble
1526 43 robfinch
        lw              lr,8[sp]
1527
        lw              r1,[sp]
1528 27 robfinch
        ret             #16
1529
 
1530
;------------------------------------------------------------------------------
1531
; Display the 64 bit word in r1
1532
;------------------------------------------------------------------------------
1533
;
1534
DisplayWord:
1535
        subui   sp,sp,#24
1536 43 robfinch
        sw              r1,[sp]
1537
        sw              r3,8[sp]
1538
        sw              lr,16[sp]
1539 27 robfinch
        setlo   r3,#7
1540
dspwd1:
1541
        roli    r1,r1,#8
1542
        call    DisplayByte
1543
        loop    r3,dspwd1
1544 43 robfinch
        lw              lr,16[sp]
1545
        lw              r3,8[sp]
1546
        lw              r1,[sp]
1547 27 robfinch
        ret             #24
1548
 
1549
;------------------------------------------------------------------------------
1550
; Display memory pointed to by r2.
1551
; destroys r1,r3
1552
;------------------------------------------------------------------------------
1553
;
1554
DisplayMem:
1555 43 robfinch
        subui   sp,sp,#24
1556
        sw              r1,[sp]
1557
        sw              r3,8[sp]
1558
        sw              lr,16[sp]
1559 27 robfinch
        setlo   r1,#':'
1560
        call    DisplayChar
1561 43 robfinch
        mov             r1,r2
1562 27 robfinch
        call    DisplayWord
1563
        setlo   r3,#7
1564
dspmem1:
1565
        setlo   r1,#' '
1566
        call    DisplayChar
1567
        lb              r1,[r2]
1568
        call    DisplayByte
1569
        addui   r2,r2,#1
1570
        loop    r3,dspmem1
1571
        call    CRLF
1572 43 robfinch
        lw              lr,16[sp]
1573
        lw              r3,8[sp]
1574
        lw              r1,[sp]
1575
        ret             #24
1576 27 robfinch
 
1577
;------------------------------------------------------------------------------
1578
; Converts binary number in r1 into BCD number in r2 and r1.
1579
;------------------------------------------------------------------------------
1580
;
1581
BinToBCD:
1582
        subui   sp,sp,#48
1583 43 robfinch
        sw              r3,[sp]
1584
        sw              r4,8[sp]
1585
        sw              r5,16[sp]
1586
        sw              r6,24[sp]
1587
        sw              r7,32[sp]
1588
        sw              r8,40[sp]
1589 27 robfinch
        setlo   r2,#10
1590
        setlo   r8,#19          ; number of digits to produce - 1
1591
bta1:
1592
        mod             r3,r1,r2
1593
        shli    r3,r3,#60       ; shift result to uppermost bits
1594
        shli    r7,r5,#60       ; copy low order nybble of r5 to r4 topmost nybble
1595
        shrui   r4,r4,#4
1596
        or              r4,r4,r7
1597
        shrui   r5,r5,#4
1598
        or              r5,r5,r3        ; copy new bcd digit into uppermost bits of r5
1599
        divui   r1,r1,r2        ; r1=r1/10
1600
        loop    r8,bta1
1601
        shrui   r4,r4,#48       ; right align number in register
1602
        shli    r6,r5,#16
1603
        or              r4,r4,r6        ; copy bits into r4
1604
        shrui   r5,r5,#48
1605 43 robfinch
        mov             r1,r4
1606
        mov             r2,r5
1607
        lw              r3,[sp]
1608
        lw              r4,8[sp]
1609
        lw              r5,16[sp]
1610
        lw              r6,24[sp]
1611
        lw              r7,32[sp]
1612
        lw              r8,40[sp]
1613 27 robfinch
        ret             #48
1614
 
1615
;------------------------------------------------------------------------------
1616
; Converts BCD number in r1 into Ascii number in r2 and r1.
1617
;------------------------------------------------------------------------------
1618
;
1619
BCDToAscii:
1620
        subui   sp,sp,#32
1621 43 robfinch
        sw              r3,[sp]
1622
        sw              r4,8[sp]
1623
        sw              r5,16[sp]
1624
        sw              r8,24[sp]
1625 27 robfinch
        setlo   r8,#15
1626
bta2:
1627
        andi    r2,r1,#0x0F
1628
        ori             r2,r2,#0x30
1629
        shli    r2,r2,#56
1630
        shrui   r4,r4,#8
1631
        shli    r5,r3,#56
1632
        or              r4,r4,r5
1633
        shrui   r3,r3,#8
1634
        or              r3,r3,r2
1635
        shrui   r1,r1,#4
1636
        loop    r8,bta2
1637 43 robfinch
        mov             r1,r4
1638
        mov             r2,r3
1639
        lw              r3,[sp]
1640
        lw              r4,8[sp]
1641
        lw              r5,16[sp]
1642
        lw              r8,24[sp]
1643 27 robfinch
        ret             #32
1644
 
1645
;------------------------------------------------------------------------------
1646
; Convert a binary number into a 20 character ascii string.
1647
; r1 = number to convert
1648
; r2 = address of string buffer
1649
;------------------------------------------------------------------------------
1650
;
1651
BinToStr:
1652
        subui   sp,sp,#56
1653 43 robfinch
        sw              r3,[sp]
1654
        sw              r7,8[sp]
1655
        sw              r8,16[sp]
1656
        sw              r9,24[sp]
1657
        sw              r10,32[sp]
1658
        sw              r11,40[sp]
1659
        sw              lr,48[sp]
1660
        mov             r11,r2
1661 27 robfinch
        call    BinToBCD
1662 43 robfinch
        mov             r10,r2  ; save off r2
1663 27 robfinch
        call    BCDToAscii
1664
        setlo   r9,#1
1665
btos3:
1666
        setlo   r8,#7
1667
btos1:
1668
        shli    r7,r9,#3
1669
        addui   r7,r7,r8
1670
        addui   r7,r7,#4
1671
        andi    r3,r1,#0xff
1672
        sb              r3,[r7+r11]
1673
        shrui   r1,r1,#8
1674
        loop    r8,btos1
1675 43 robfinch
        mov             r1,r2
1676 27 robfinch
        loop    r9,btos3
1677
; the last four digits
1678 43 robfinch
        mov             r1,r10  ; get back r2
1679 27 robfinch
        call    BCDToAscii
1680
        setlo   r8,#3
1681
btos2:
1682
        andi    r3,r1,#0xff
1683
        sb              r3,[r8+r11]
1684
        shrui   r1,r1,#8
1685
        loop    r8,btos2
1686
        sb              r0,20[r11]      ; null terminate
1687 43 robfinch
        lw              r3,[sp]
1688
        lw              r7,8[sp]
1689
        lw              r8,16[sp]
1690
        lw              r9,24[sp]
1691
        lw              r10,32[sp]
1692
        lw              r11,40[sp]
1693
        lw              lr,48[sp]
1694 27 robfinch
        ret             #56
1695
 
1696
 
1697
;==============================================================================
1698
;==============================================================================
1699
Monitor:
1700 43 robfinch
        lea             sp,STACKTOP0    ; top of stack; reset the stack pointer
1701 27 robfinch
        sb              r0,KeybdEcho    ; turn off keyboard echo
1702
PromptLn:
1703
        call    CRLF
1704
        setlo   r1,#'$'
1705
        call    DisplayChar
1706
 
1707
; Get characters until a CR is keyed
1708
;
1709
Prompt3:
1710
        call    KeybdGetChar
1711
        beqi    r1,#-1,Prompt3  ; wait for a character
1712
        beqi    r1,#CR,Prompt1
1713
        call    DisplayChar
1714
        bra             Prompt3
1715
 
1716
; Process the screen line that the CR was keyed on
1717
;
1718
Prompt1:
1719
        sc              r0,CursorCol    ; go back to the start of the line
1720
        call    CalcScreenLoc   ; r1 = screen memory location
1721
        or              r3,r1,r0
1722 43 robfinch
        inch    r1,[r3]
1723 27 robfinch
        addui   r3,r3,#2
1724
        call    ScreenToAscii
1725
        bnei    r1,#'$',Prompt2 ; skip over '$' prompt character
1726 43 robfinch
        inch    r1,[r3]
1727 27 robfinch
        addui   r3,r3,#2
1728
        call    ScreenToAscii
1729
 
1730
; Dispatch based on command character
1731
;
1732
Prompt2:
1733
        beqi    r1,#':',Editmem         ; $: - edit memory
1734
        beqi    r1,#'D',Dumpmem         ; $D - dump memory
1735 43 robfinch
        beqi    r1,#'B',CSTART          ; $B - start tiny basic
1736 27 robfinch
        beqi    r1,#'J',ExecuteCode     ; $J - execute code
1737
        beqi    r1,#'L',LoadS19         ; $L - load S19 file
1738
        beqi    r1,#'?',DisplayHelp     ; $? - display help
1739
        beqi    r1,#'C',TestCLS         ; $C - clear screen
1740 43 robfinch
        beqi    r1,#'R',RandomLinesCall
1741
        beqi    r1,#'I',Invaders
1742
        beqi    r1,#'P',Piano
1743 27 robfinch
        bra             Monitor
1744
 
1745 43 robfinch
RandomLinesCall:
1746
        call    RandomLines
1747
        bra             Monitor
1748
 
1749 27 robfinch
TestCLS:
1750 43 robfinch
        inch    r1,[r3]
1751 27 robfinch
        addui   r3,r3,#2
1752
        call    ScreenToAscii
1753
        bnei    r1,#'L',Monitor
1754 43 robfinch
        inch    r1,[r3]
1755 27 robfinch
        addui   r3,r3,#2
1756
        call    ScreenToAscii
1757
        bnei    r1,#'S',Monitor
1758
        call    ClearScreen
1759
        sb              r0,CursorCol
1760
        sb              r0,CursorRow
1761
        call    CalcScreenLoc
1762
        bra             Monitor
1763 10 robfinch
 
1764 27 robfinch
DisplayHelp:
1765
        setlo   r1,HelpMsg
1766
        call    DisplayString
1767
        bra             Monitor
1768
 
1769
        align   16
1770
HelpMsg:
1771
        db      "? = Display help",CR,LF
1772
        db      "CLS = clear screen",CR,LF
1773
        db      ": = Edit memory bytes",CR,LF
1774
        db      "L = Load S19 file",CR,LF
1775
        db      "D = Dump memory",CR,LF
1776
        db      "B = start tiny basic",CR,LF
1777 43 robfinch
        db      "J = Jump to code",CR,LF
1778
        db      "I = Invaders",CR,LF
1779
        db      "R = Random lines",CR,LF
1780
        db      "P = Piano",CR,LF,0
1781 27 robfinch
        align   16
1782
 
1783
;------------------------------------------------------------------------------
1784
; Ignore blanks in the input
1785
; r3 = text pointer
1786
; r1 destroyed
1787
;------------------------------------------------------------------------------
1788
;
1789
ignBlanks:
1790
        subui   sp,sp,#8
1791
        sw              r31,[sp]
1792
ignBlanks1:
1793 43 robfinch
        inch    r1,[r3]
1794 27 robfinch
        addui   r3,r3,#2
1795
        call    ScreenToAscii
1796
        beqi    r1,#' ',ignBlanks1
1797
        subui   r3,r3,#2
1798
        lw              r31,[sp]
1799
        ret             #8
1800
 
1801
;------------------------------------------------------------------------------
1802
; Edit memory byte(s).
1803
;------------------------------------------------------------------------------
1804
;
1805
EditMem:
1806
        call    ignBlanks
1807
        call    GetHexNumber
1808
        or              r5,r1,r0
1809
        setlo   r4,#7
1810
edtmem1:
1811
        call    ignBlanks
1812
        call    GetHexNumber
1813
        sb              r1,[r5]
1814
        addui   r5,r5,#1
1815
        loop    r4,edtmem1
1816
        bra             Monitor
1817
 
1818
;------------------------------------------------------------------------------
1819
; Execute code at the specified address.
1820
;------------------------------------------------------------------------------
1821
;
1822
ExecuteCode:
1823
        call    ignBlanks
1824
        call    GetHexNumber
1825 43 robfinch
        jal             r31,[r1]
1826 27 robfinch
        bra     Monitor
1827
 
1828
;------------------------------------------------------------------------------
1829
; Do a memory dump of the requested location.
1830
;------------------------------------------------------------------------------
1831
;
1832
DumpMem:
1833
        call    ignBlanks
1834
        call    GetHexNumber
1835 43 robfinch
        mov             r2,r1
1836 27 robfinch
        call    CRLF
1837
        call    DisplayMem
1838
        call    DisplayMem
1839
        call    DisplayMem
1840
        call    DisplayMem
1841
        call    DisplayMem
1842
        call    DisplayMem
1843
        call    DisplayMem
1844
        call    DisplayMem
1845
        bra             Monitor
1846
 
1847
;------------------------------------------------------------------------------
1848
; Get a hexidecimal number. Maximum of sixteen digits.
1849
; R3 = text pointer (updated)
1850 43 robfinch
; R1 = hex number
1851 27 robfinch
;------------------------------------------------------------------------------
1852
;
1853
GetHexNumber:
1854
        subui   sp,sp,#24
1855 43 robfinch
        sw              r2,[sp]
1856
        sw              r4,8[sp]
1857
        sw              lr,16[sp]
1858 27 robfinch
        setlo   r2,#0
1859
        setlo   r4,#15
1860
gthxn2:
1861 43 robfinch
        inch    r1,[r3]
1862 27 robfinch
        addui   r3,r3,#2
1863
        call    ScreenToAscii
1864
        call    AsciiToHexNybble
1865
        beqi    r1,#-1,gthxn1
1866
        shli    r2,r2,#4
1867
        andi    r1,r1,#0x0f
1868
        or              r2,r2,r1
1869
        loop    r4,gthxn2
1870
gthxn1:
1871 43 robfinch
        mov             r1,r2
1872
        lw              lr,16[sp]
1873
        lw              r4,8[sp]
1874
        lw              r2,[sp]
1875 27 robfinch
        ret             #24
1876
 
1877
;------------------------------------------------------------------------------
1878
; Convert ASCII character in the range '0' to '9', 'a' to 'f' or 'A' to 'F'
1879
; to a hex nybble.
1880
;------------------------------------------------------------------------------
1881
;
1882
AsciiToHexNybble:
1883
        bltui   r1,#'0',gthx3
1884
        bgtui   r1,#'9',gthx5
1885
        subui   r1,r1,#'0'
1886 10 robfinch
        ret
1887 27 robfinch
gthx5:
1888
        bltui   r1,#'A',gthx3
1889
        bgtui   r1,#'F',gthx6
1890
        subui   r1,r1,#'A'
1891
        addui   r1,r1,#10
1892
        ret
1893
gthx6:
1894
        bltui   r1,#'a',gthx3
1895
        bgtui   r1,#'f',gthx3
1896
        subui   r1,r1,#'a'
1897
        addui   r1,r1,#10
1898
        ret
1899
gthx3:
1900
        setlo   r1,#-1          ; not a hex number
1901
        ret
1902 10 robfinch
 
1903
;==============================================================================
1904 27 robfinch
; Load an S19 format file
1905
;==============================================================================
1906
;
1907
LoadS19:
1908
        bra             ProcessRec
1909
NextRec:
1910
        call    sGetChar
1911
        bne             r1,#LF,NextRec
1912
ProcessRec:
1913
        call    sGetChar
1914
        beqi    r1,#26,Monitor  ; CTRL-Z ?
1915
        bnei    r1,#'S',NextRec
1916
        call    sGetChar
1917
        blt             r1,#'0',NextRec
1918
        bgt             r1,#'9',NextRec
1919
        or              r4,r1,r0                ; r4 = record type
1920
        call    sGetChar
1921
        call    AsciiToHexNybble
1922
        or              r2,r1,r0
1923
        call    sGetChar
1924
        call    AsciiToHexNybble
1925
        shli    r2,r2,#4
1926
        or              r2,r2,r1                ; r2 = byte count
1927
        or              r3,r2,r1                ; r3 = byte count
1928
        beqi    r4,#'0',NextRec ; manufacturer ID record, ignore
1929
        beqi    r4,#'1',ProcessS1
1930
        beqi    r4,#'2',ProcessS2
1931
        beqi    r4,#'3',ProcessS3
1932
        beqi    r4,#'5',NextRec ; record count record, ignore
1933
        beqi    r4,#'7',ProcessS7
1934
        beqi    r4,#'8',ProcessS8
1935
        beqi    r4,#'9',ProcessS9
1936
        bra             NextRec
1937
 
1938
pcssxa:
1939
        andi    r3,r3,#0xff
1940
        subui   r3,r3,#1                ; one less for loop
1941
pcss1a:
1942
        call    sGetChar
1943
        call    AsciiToHexNybble
1944
        shli    r2,r2,#4
1945
        or              r2,r2,r1
1946
        call    sGetChar
1947
        call    AsciiToHexNybble
1948
        shli    r2,r2,#4
1949
        or              r2,r2,r1
1950
        sb              r2,[r5]
1951
        addui   r5,r5,#1
1952
        loop    r3,pcss1a
1953
; Get the checksum byte
1954
        call    sGetChar
1955
        call    AsciiToHexNybble
1956
        shli    r2,r2,#4
1957
        or              r2,r2,r1
1958
        call    sGetChar
1959
        call    AsciiToHexNybble
1960
        shli    r2,r2,#4
1961
        or              r2,r2,r1
1962
        bra             NextRec
1963
 
1964
ProcessS1:
1965
        call    S19Get16BitAddress
1966
        bra             pcssxa
1967
ProcessS2:
1968
        call    S19Get24BitAddress
1969
        bra             pcssxa
1970
ProcessS3:
1971
        call    S19Get32BitAddress
1972
        bra             pcssxa
1973
ProcessS7:
1974
        call    S19Get32BitAddress
1975
        sw              r5,S19StartAddress
1976
        bra             Monitor
1977
ProcessS8:
1978
        call    S19Get24BitAddress
1979
        sw              r5,S19StartAddress
1980
        bra             Monitor
1981
ProcessS9:
1982
        call    S19Get16BitAddress
1983
        sw              r5,S19StartAddress
1984
        bra             Monitor
1985
 
1986
S19Get16BitAddress:
1987
        subui   sp,sp,#8
1988
        sw              r31,[sp]
1989
        call    sGetChar
1990
        call    AsciiToHexNybble
1991
        or              r2,r1,r0
1992
        bra             S1932b
1993
 
1994
S19Get24BitAddress:
1995
        subui   sp,sp,#8
1996
        sw              r31,[sp]
1997
        call    sGetChar
1998
        call    AsciiToHexNybble
1999
        or              r2,r1,r0
2000
        bra             S1932a
2001
 
2002
S19Get32BitAddress:
2003
        subui   sp,sp,#8
2004
        sw              r31,[sp]
2005
        call    sGetChar
2006
        call    AsciiToHexNybble
2007
        or              r2,r1,r0
2008
        call    sGetChar
2009
        call    AsciiToHexNybble
2010
        shli    r2,r2,#4
2011
        or              r2,r1,r2
2012
        call    sGetChar
2013
        call    AsciiToHexNybble
2014
        shli    r2,r2,#4
2015
        or              r2,r2,r1
2016
S1932a:
2017
        call    sGetChar
2018
        call    AsciiToHexNybble
2019
        shli    r2,r2,#4
2020
        or              r2,r2,r1
2021
        call    sGetChar
2022
        call    AsciiToHexNybble
2023
        shli    r2,r2,#4
2024
        or              r2,r2,r1
2025
S1932b:
2026
        call    sGetChar
2027
        call    AsciiToHexNybble
2028
        shli    r2,r2,#4
2029
        or              r2,r2,r1
2030
        call    sGetChar
2031
        call    AsciiToHexNybble
2032
        shli    r2,r2,#4
2033
        or              r2,r2,r1
2034
        call    sGetChar
2035
        call    AsciiToHexNybble
2036
        shli    r2,r2,#4
2037
        or              r2,r2,r1
2038
        xor             r4,r4,r4
2039
        or              r5,r2,r0
2040
        lw              r31,[sp]
2041
        addui   sp,sp,#8
2042
        ret
2043
 
2044
;------------------------------------------------------------------------------
2045
; Get a character from auxillary input, checking the keyboard status for a
2046
; CTRL-C
2047
;------------------------------------------------------------------------------
2048
;
2049
sGetChar:
2050
        subui   sp,sp,#8
2051
        sw              r31,[sp]
2052
sgc2:
2053
        call    KeybdCheckForKey
2054
        beq             r1,r0,sgc1
2055
        call    KeybdGetchar
2056
        beqi    r1,#CRTLC,Monitor
2057
sgc1:
2058
        call    AUXIN
2059 43 robfinch
        ble             r1,r0,sgc2
2060 27 robfinch
        lw              r31,[sp]
2061 43 robfinch
        ret             #8
2062 27 robfinch
 
2063
;--------------------------------------------------------------------------
2064 43 robfinch
; Draw random lines on the bitmap screen.
2065 27 robfinch
;--------------------------------------------------------------------------
2066 43 robfinch
RandomLines:
2067
        subui   sp,sp,#24
2068
        sw              r1,[sp]
2069
        sw              r3,8[sp]
2070
        sw              lr,16[sp]
2071
rl5:
2072
        gran
2073
        mfspr   r1,rand                 ; select a random color
2074
        outh    r1,GACCEL
2075
rl1:                                            ; random X0
2076
        gran
2077
        mfspr   r1,rand
2078
        lw              r3,#1364
2079
        mod             r1,r1,r3
2080
        outh    r1,GACCEL+8
2081
rl2:                                            ; random X1
2082
        gran
2083
        mfspr   r1,rand
2084
        lw              r3,#1364
2085
        mod             r1,r1,r3
2086
        outh    r1,GACCEL+16
2087
rl3:                                            ; random Y0
2088
        gran
2089
        mfspr   r1,rand
2090
        lw              r3,#768
2091
        mod             r1,r1,r3
2092
        outh    r1,GACCEL+12
2093
rl4:                                            ; random Y1
2094
        gran
2095
        mfspr   r1,rand
2096
        lw              r3,#768
2097
        mod             r1,r1,r3
2098
        outh    r1,GACCEL+20
2099
        setlo   r1,#2                   ; draw line command
2100
        outh    r1,GACCEL+60
2101
rl8:
2102
        call    KeybdGetChar
2103
        beqi    r1,#CTRLC,rl7
2104
        beqi    r1,#'r',rl5
2105
        bra             rl8
2106
rl7:
2107
        lw              lr,16[sp]
2108
        lw              r3,8[sp]
2109
        lw              r1,[sp]
2110
        ret             #24
2111
 
2112
;--------------------------------------------------------------------------
2113
; Initialize sprite image caches with random data.
2114
;--------------------------------------------------------------------------
2115
RandomizeSprram:
2116
        lea             r2,SPRRAM
2117
        setlo   r4,#14335               ; number of chars to initialize
2118
rsr1:
2119
        gran
2120
        mfspr   r1,rand
2121
        outc    r1,[r2]
2122
        addui   r2,r2,#2
2123
        loop    r4,rsr1
2124
        ret
2125
 
2126
;--------------------------------------------------------------------------
2127
; Setup the AC97/LM4550 audio controller. Check keyboard for a CTRL-C
2128
; interrupt which may be necessary if the audio controller isn't 
2129
; responding.
2130
;--------------------------------------------------------------------------
2131 27 robfinch
;
2132
SetupAC97:
2133 43 robfinch
        subui   sp,sp,#16
2134
        sw              r1,[sp]
2135
        sw              lr,8[sp]
2136
sac974:
2137
        outc    r0,AC97+0x26    ; trigger a read of register 26 (status reg)
2138 27 robfinch
sac971:                                         ; wait for status to register 0xF (all ready)
2139 43 robfinch
        call    KeybdGetChar    ; see if we needed to CTRL-C
2140
        beqi    r1,#CTRLC,sac973
2141
        outc    r1,AC97+0x68    ; wait for dirty bit to clear
2142
        bne             r1,r0,sac971
2143
        outc    r1,AC97+0x26    ; check status at reg h26, wait for
2144
        andi    r1,r1,#0x0F             ; analogue to be ready
2145
        bnei    r1,#0x0F,sac974
2146
sac973:
2147
        outc    r0,AC97+2               ; master volume, 0db attenuation, mute off
2148
        outc    r0,AC97+4               ; headphone volume, 0db attenuation, mute off
2149
        outc    r0,AC97+0x18    ; PCM gain (mixer) mute off, no attenuation
2150
        outc    r0,AC97+0x0A    ; mute PC beep
2151
        setlo   r1,#0x8000              ; bypass 3D sound
2152
        outc    r1,AC97+0x20
2153
sac972:
2154
        call    KeybdGetChar
2155
        beqi    r1,#CTRLC,sac975
2156
        outc    r1,AC97+0x68    ; wait for dirty bits to clear
2157
        bne             r1,r0,sac972    ; wait a while for the settings to take effect
2158
sac975:
2159
        lw              lr,8[sp]
2160
        lw              r1,[sp]
2161
        ret             #16
2162 27 robfinch
 
2163 43 robfinch
;--------------------------------------------------------------------------
2164
; Sound a 800 Hz beep
2165
;--------------------------------------------------------------------------
2166
;
2167 27 robfinch
Beep:
2168 43 robfinch
        subui   sp,sp,#16
2169
        sw              r1,[sp]
2170
        sw              lr,8[sp]
2171
        setlo   r1,#8
2172
        outb    r1,LED
2173 27 robfinch
        ori             r1,r0,#15               ; master volume to max
2174 43 robfinch
        outc    r1,PSG+128
2175 27 robfinch
        ori             r1,r0,#13422    ; 800Hz
2176 43 robfinch
        outc    r1,PSGFREQ0
2177
        setlo   r1,#9
2178
        outb    r1,LED
2179
        ; decay  (16.384 ms)2
2180
        ; attack (8.192 ms)1
2181
        ; release (1.024 s)A
2182
        ; sustain level C
2183
        setlo   r1,#0xCA12
2184
        outc    r1,PSGADSR0
2185 27 robfinch
        ori             r1,r0,#0x1104   ; gate, output enable, triangle waveform
2186 43 robfinch
        outc    r1,PSGCTRL0
2187 27 robfinch
        ori             r1,r0,#25000000 ; delay about 1s
2188
beep1:
2189
        loop    r1,beep1
2190 43 robfinch
        setlo   r1,#13
2191
        outb    r1,LED
2192
        ori             r1,r0,#0x0104   ; gate off, output enable, triangle waveform
2193
        outc    r1,PSGCTRL0
2194
        ori             r1,r0,#25000000 ; delay about 1s
2195
beep2:
2196
        loop    r1,beep2
2197
        setlo   r1,#16
2198
        outb    r1,LED
2199 27 robfinch
        ori             r1,r0,#0x0000   ; gate off, output enable off, no waveform
2200 43 robfinch
        outc    r1,PSGCTRL0
2201
        lw              lr,8[sp]
2202
        lw              r1,[sp]
2203
        ret             #16
2204
 
2205
;--------------------------------------------------------------------------
2206
;--------------------------------------------------------------------------
2207
; 
2208
Piano:
2209
        ori             r1,r0,#15               ; master volume to max
2210
        outc    r1,PSG+128
2211
playnt:
2212
        call    KeybdGetChar
2213
        beqi    r1,#CTRLC,Monitor
2214
        beqi    r1,#'a',playnt1a
2215
        beqi    r1,#'b',playnt1b
2216
        beqi    r1,#'c',playnt1c
2217
        beqi    r1,#'d',playnt1d
2218
        beqi    r1,#'e',playnt1e
2219
        beqi    r1,#'f',playnt1f
2220
        beqi    r1,#'g',playnt1g
2221
        bra             playnt
2222
 
2223
playnt1a:
2224
        setlo   r1,#7217
2225
        call    Tone
2226
        bra             playnt
2227
playnt1b:
2228
        setlo   r1,#8101
2229
        call    Tone
2230
        bra             playnt
2231
playnt1c:
2232
        setlo   r1,#4291
2233
        call    Tone
2234
        bra             playnt
2235
playnt1d:
2236
        setlo   r1,#4817
2237
        call    Tone
2238
        bra             playnt
2239
playnt1e:
2240
        setlo   r1,#5407
2241
        call    Tone
2242
        bra             playnt
2243
playnt1f:
2244
        setlo   r1,#5728
2245
        call    Tone
2246
        bra             playnt
2247
playnt1g:
2248
        setlo   r1,#6430
2249
        call    Tone
2250
        bra             playnt
2251
 
2252
Tone:
2253
        subui   sp,sp,#16
2254
        sw              r1,[sp]
2255
        sw              lr,8[sp]
2256
        outc    r1,PSGFREQ0
2257
        ; decay  (16.384 ms)2
2258
        ; attack (8.192 ms)1
2259
        ; release (1.024 s)A
2260
        ; sustain level C
2261
        setlo   r1,#0xCA12
2262
        outc    r1,PSGADSR0
2263
        ori             r1,r0,#0x1104   ; gate, output enable, triangle waveform
2264
        outc    r1,PSGCTRL0
2265
        ori             r1,r0,#250000   ; delay about 10ms
2266
tone1:
2267
        loop    r1,tone1
2268
        ori             r1,r0,#0x0104   ; gate off, output enable, triangle waveform
2269
        outc    r1,PSGCTRL0
2270
        ori             r1,r0,#250000   ; delay about 10ms
2271
tone2:
2272
        loop    r1,tone2
2273
        ori             r1,r0,#0x0000   ; gate off, output enable off, no waveform
2274
        outc    r1,PSGCTRL0
2275
        lw              lr,8[sp]
2276
        lw              r1,[sp]
2277
        ret             #16
2278
 
2279
;==============================================================================
2280
;==============================================================================
2281
SetupRasterIRQ:
2282
        subui   sp,sp,#8
2283
        sw              r1,[sp]
2284
        setlo   r1,#200
2285
        outc    r1,RASTERIRQ
2286
        setlo   r1,#240
2287
        outc    r1,RASTERIRQ+2
2288
        setlo   r1,#280
2289
        outc    r1,RASTERIRQ+4
2290
        setlo   r1,#320
2291
        outc    r1,RASTERIRQ+6
2292
        setlo   r1,#360
2293
        outc    r1,RASTERIRQ+8
2294
        lw              r1,[sp]
2295
        ret             #8
2296
 
2297
RasterIRQfn:
2298
        inch    r1,RASTERIRQ+30         ; get the raster compare register # (clears IRQ)
2299
        beqi    r1,#1,rirq1
2300
        beqi    r1,#2,rirq2
2301
        beqi    r1,#3,rirq3
2302
        beqi    r1,#4,rirq4
2303
        beqi    r1,#5,rirq5
2304
        beqi    r1,#6,rirq6
2305
        beqi    r1,#7,rirq7
2306
        beqi    r1,#8,rirq8
2307 27 robfinch
        ret
2308 43 robfinch
rirq1:
2309
rirq2:
2310
rirq3:
2311
rirq4:
2312
rirq5:
2313
rirq6:
2314
rirq7:
2315
rirq8:
2316
        mului   r1,r1,#40
2317
        addui   r1,r1,#204
2318
        outc    r1,SPRITEREGS+2
2319
        outc    r1,SPRITEREGS+18
2320
        outc    r1,SPRITEREGS+34
2321
        outc    r1,SPRITEREGS+50
2322
        outc    r1,SPRITEREGS+66
2323
        outc    r1,SPRITEREGS+82
2324
        outc    r1,SPRITEREGS+98
2325
        outc    r1,SPRITEREGS+114
2326
        ret
2327 27 robfinch
 
2328 43 robfinch
;------------------------------------------------------------------------------
2329
;------------------------------------------------------------------------------
2330
DisplayDatetime:
2331
        subui   sp,sp,#32
2332
        sw              r1,[sp]
2333
        sw              r2,8[sp]
2334
        sw              r3,16[sp]
2335
        sw              lr,24[sp]
2336
        call    CursorOff
2337
        lc              r2,CursorRow
2338
        lc              r3,CursorCol
2339
        outw    r0,DATETIME+24          ; trigger a snapshot
2340
        lw              r1,#46                          ; move cursor down to last display line
2341
        sc              r1,CursorRow
2342
        lw              r1,#64
2343
        sc              r1,CursorCol
2344
        inw             r1,DATETIME                     ; get the snapshotted date and time
2345
        call    DisplayWord                     ; display on screen
2346
        sc              r2,CursorRow            ; restore cursor position
2347
        sc              r3,CursorCol
2348
        call    CalcScreenLoc
2349
        call    CursorOn
2350
        lw              lr,24[sp]
2351
        lw              r3,16[sp]
2352
        lw              r2,8[sp]
2353
        lw              r1,[sp]
2354
        ret             #32
2355
 
2356
;==============================================================================
2357
;==============================================================================
2358
InitializeGame:
2359
        subui   sp,sp,#16
2360
        sm              [sp],r3/lr
2361
        setlo   r3,#320
2362
        sc              r3,Manpos
2363
        sc              r0,Score
2364
        sb              r0,MissileActive
2365
        sc              r0,MissileX
2366
        sc              r0,MissileY
2367
        lm              [sp],r3/lr
2368
        ret             #16
2369
 
2370
DrawScore:
2371
        subui   sp,sp,#24
2372
        sm              [sp],r1/r3/lr
2373
        setlo   r3,#1
2374
        sb              r3,CursorRow
2375
        setlo   r3,#40
2376
        sb              r3,CursorCol
2377
        lb              r1,Score
2378
        call    DisplayByte
2379
        lb              r1,Score+1
2380
        call    DisplayByte
2381
        lm              [sp],r1/r3/lr
2382
        ret             #24
2383
 
2384
DrawMissile:
2385
        subui   sp,sp,#16
2386
        sm              [sp],r1/lr
2387
        lc              r1,MissileY
2388
        bleu    r1,#2,MissileOff
2389
        lc              r1,MissileX
2390
        shrui   r1,r1,#3
2391
        sb              r1,CursorCol
2392
        lc              r1,MissileY
2393
        sb              r1,CursorRow
2394
        subui   r1,r1,#1
2395
        sc              r1,MissileY
2396
        setlo   r1,#'^'
2397
        call    DisplayChar
2398
        lb              r1,CursorCol
2399
        subui   r1,r1,#1
2400
        sb              r1,CursorCol
2401
        lb              r1,CursorRow
2402
        subui   r1,r1,#1
2403
        sb              r1,CursorRow
2404
        setlo   r1,#' '
2405
        call    DisplayChar
2406
        lm              [sp],r1/lr
2407
        ret             #16
2408
MissileOff:
2409
        sb              r0,MissileActive
2410
        lc              r1,MissileX
2411
        shrui   r1,r1,#3
2412
        sb              r1,CursorCol
2413
        lc              r1,MissileY
2414
        sb              r1,CursorRow
2415
        setlo   r1,#' '
2416
        call    DisplayChar
2417
        lm              [sp],r1/lr
2418
        ret             #16
2419
 
2420
DrawMan:
2421
        subui   sp,sp,#24
2422
        sm              [sp],r1/r3/lr
2423
        setlo   r3,#46
2424
        sb              r3,CursorRow
2425
        lc              r3,Manpos
2426
        shrui   r3,r3,#3
2427
        sb              r3,CursorCol
2428
        setlo   r1,#' '
2429
        call    DisplayChar
2430
        setlo   r1,#'#'
2431
        call    DisplayChar
2432
        setlo   r1,#'A'
2433
        call    DisplayChar
2434
        setlo   r1,#'#'
2435
        call    DisplayChar
2436
        setlo   r1,#' '
2437
        call    DisplayChar
2438
        lm              [sp],r1/r3/lr
2439
        ret             #24
2440
 
2441
DrawInvader:
2442
        lw              r3,InvaderPos
2443
        lw              r1,#233
2444
        sc              r1,[r3]
2445
        lw              r1,#242
2446
        sc              r1,1[r3]
2447
        lw              r1,#223
2448
        sc              r1,2[r3]
2449
        ret
2450
 
2451
DrawInvaders:
2452
        subui   sp,sp,#40
2453
        sm              [sp],r1/r2/r3/r4/lr
2454
        lc              r1,InvadersRow1
2455
        lc              r4,InvadersColpos
2456
        andi    r2,r1,#1
2457
        beq             r2,r0,dinv1
2458
        lb              r3,InvadersRowpos
2459
        sb              r3,CursorRow
2460
        sb              r4,CursorCol
2461
        setlo   r1,#' '
2462
        call    DisplayByte
2463
        setlo   r1,#'#'
2464
        call    DisplayByte
2465
        setlo   r1,#'#'
2466
        call    DisplayByte
2467
        setlo   r1,#'#'
2468
        call    DisplayByte
2469
        setlo   r1,#' '
2470
        call    DisplayByte
2471
        lb              r1,CursorRow
2472
        addui   r1,r1,#1
2473
        sb              r1,CursorRow
2474
        lb              r1,CursorCol
2475
        subui   r1,r1,#5
2476
        setlo   r1,#' '
2477
        call    DisplayByte
2478
        setlo   r1,#'X'
2479
        call    DisplayByte
2480
        setlo   r1,#' '
2481
        call    DisplayByte
2482
        setlo   r1,#'X'
2483
        call    DisplayByte
2484
        setlo   r1,#' '
2485
        call    DisplayByte
2486
dinv1:
2487
        lm              [sp],r1/r2/r3/r4/lr
2488
        ret             #40
2489
DrawBombs:
2490
        ret
2491
 
2492
Invaders:
2493
        subui   sp,#240
2494
        sm              [sp],r1/r2/r3/r4/lr
2495
        call    InitializeGame
2496
InvadersLoop:
2497
        call    DrawScore
2498
        call    DrawInvaders
2499
        call    DrawBombs
2500
        call    DrawMissile
2501
        call    DrawMan
2502
TestMoveMan:
2503
        call    KeybdGetChar
2504
        beqi    r1,#'k',MoveManRight
2505
        beqi    r1,#'j',MoveManLeft
2506
        beqi    r1,#' ',FireMissile
2507
        bra             Invaders1
2508
MoveManRight:
2509
        lc              r2,Manpos
2510
        bgtu    r2,#640,Invaders1
2511
        addui   r2,r2,#8
2512
        sc              r2,Manpos
2513
        bra             Invaders1
2514
MoveManLeft:
2515
        lc              r2,Manpos
2516
        ble             r2,r0,Invaders1
2517
        subui   r2,r2,#8
2518
        sc              r2,Manpos
2519
        bra             Invaders1
2520
FireMissile:
2521
        lb              r2,MissileActive
2522
        bne             r2,r0,Invaders1
2523
        setlo   r2,#1
2524
        sb              r2,MissileActive
2525
        lc              r2,Manpos
2526
        sc              r2,MissileX
2527
        setlo   r2,#46
2528
        sc              r2,MissileY
2529
        bra             Invaders1
2530
Invaders1:
2531
        beqi    r1,#CTRLC,InvadersEnd
2532
        bra             InvadersLoop
2533
InvadersEnd:
2534
        lm              [sp],r1/r2/r3/r4/lr
2535
        addui   sp,sp,#240
2536
        bra             Monitor
2537
 
2538
;==============================================================================
2539
;==============================================================================
2540
;****************************************************************;
2541
;                                                                ;
2542
;               Tiny BASIC for the Raptor64                              ;
2543
;                                                                ;
2544
; Derived from a 68000 derivative of Palo Alto Tiny BASIC as     ;
2545
; published in the May 1976 issue of Dr. Dobb's Journal.         ;
2546
; Adapted to the 68000 by:                                       ;
2547
;       Gordon brndly                                                                    ;
2548
;       12147 - 51 Street                                                                ;
2549
;       Edmonton AB  T5W 3G8                                                         ;
2550
;       Canada                                                                               ;
2551
;       (updated mailing address for 1996)                                       ;
2552
;                                                                ;
2553
; Adapted to the Raptor64 by:                                    ;
2554
;    Robert Finch                                                ;
2555
;    Ontario, Canada                                             ;
2556
;        robfinch<remove>@opencores.org                              ;  
2557
;****************************************************************;
2558
;    Copyright (C) 2012 by Robert Finch. This program may be     ;
2559
;    freely distributed for personal use only. All commercial    ;
2560
;                      rights are reserved.                                          ;
2561
;****************************************************************;
2562
;
2563
; Register Usage
2564
; r8 = text pointer (global usage)
2565
; r3,r4 = inputs parameters to subroutines
2566
; r2 = return value
2567
;
2568
;* Vers. 1.0  1984/7/17 - Original version by Gordon brndly
2569
;*      1.1  1984/12/9  - Addition of '0x' print term by Marvin Lipford
2570
;*      1.2  1985/4/9   - Bug fix in multiply routine by Rick Murray
2571
 
2572
;
2573
; Standard jump table. You can change these addresses if you are
2574
; customizing this interpreter for a different environment.
2575
;
2576
GOSTART:
2577
                jmp     CSTART  ;       Cold Start entry point
2578
GOWARM:
2579
                jmp     WSTART  ;       Warm Start entry point
2580
GOOUT:
2581
                jmp     OUTC    ;       Jump to character-out routine
2582
GOIN:
2583
                jmp     INC             ;Jump to character-in routine
2584
GOAUXO:
2585
                jmp     AUXOUT  ;       Jump to auxiliary-out routine
2586
GOAUXI:
2587
                jmp     AUXIN   ;       Jump to auxiliary-in routine
2588
GOBYE:
2589
                jmp     BYEBYE  ;       Jump to monitor, DOS, etc.
2590
;
2591
; Modifiable system constants:
2592
;
2593
                align   8
2594
TXTBGN  dw      0x000000001_00600000    ;TXT            ;beginning of program memory
2595
ENDMEM  dw      0x000000001_07FFFFF8    ;       end of available memory
2596
;
2597
; The main interpreter starts here:
2598
;
2599
; Usage
2600
; r1 = temp
2601
; r8 = text buffer pointer
2602
; r12 = end of text in text buffer
2603
;
2604
        align   16
2605
CSTART:
2606
        ; First save off the link register and OS sp value
2607
        subui   sp,sp,#8
2608
        sw              lr,[sp]
2609
        sw              sp,OSSP
2610
        lw              sp,ENDMEM       ; initialize stack pointer
2611
        subui   sp,sp,#8
2612
        sw      lr,[sp]    ; save off return address
2613
        sc              r0,CursorRow    ; set screen output
2614
        sc              r0,CursorCol
2615
        sb              r0,CursorFlash
2616
        sw              r0,pos
2617
        lw              r2,#0x10000020  ; black chars, yellow background
2618
        sh              r2,charToPrint
2619
        call    ClearScreen
2620
        lea             r1,msgInit      ;       tell who we are
2621
        call    PRMESGAUX
2622
        lea             r1,msgInit      ;       tell who we are
2623
        call    PRMESG
2624
        lw              r1,TXTBGN       ;       init. end-of-program pointer
2625
        sw              r1,TXTUNF
2626
        lw              r1,ENDMEM       ;       get address of end of memory
2627
        subui   r1,r1,#2048     ;       reserve 2K for the stack
2628
        sw              r1,STKBOT
2629
        subui   r1,r1,#8192 ;   1000 vars
2630
        sw      r1,VARBGN
2631
        call    clearVars   ; clear the variable area
2632
        lw      r1,VARBGN   ; calculate number of bytes free
2633
        lw              r3,TXTUNF
2634
        sub     r1,r1,r3
2635
        setlo   r2,#0
2636
        call    PRTNUM
2637
        lea             r1,msgBytesFree
2638
        call    PRMESG
2639
WSTART:
2640
        sw              r0,LOPVAR   ; initialize internal variables
2641
        sw              r0,STKGOS
2642
        sw              r0,CURRNT       ;       current line number pointer = 0
2643
        lw              sp,ENDMEM       ;       init S.P. again, just in case
2644
        lea             r1,msgReady     ;       display "Ready"
2645
        call    PRMESG
2646
ST3:
2647
        setlo   r1,#'>'         ; Prompt with a '>' and
2648
        call    GETLN           ; read a line.
2649
        call    TOUPBUF         ; convert to upper case
2650
        mov             r12,r8          ; save pointer to end of line
2651
        lea             r8,BUFFER       ; point to the beginning of line
2652
        call    TSTNUM          ; is there a number there?
2653
        call    IGNBLK          ; skip trailing blanks
2654
; does line no. exist? (or nonzero?)
2655
        beq             r1,r0,DIRECT            ; if not, it's a direct statement
2656
        bleu    r1,#0xFFFF,ST2  ; see if line no. is <= 16 bits
2657
        lea             r1,msgLineRange ; if not, we've overflowed
2658
        bra             ERROR
2659
ST2:
2660
    ; ugliness - store a character at potentially an
2661
    ; odd address (unaligned).
2662
        mov             r2,r1       ; r2 = line number
2663
        sb              r2,-2[r8]
2664
        shrui   r2,r2,#8
2665
        sb              r2,-1[r8]       ; store the binary line no.
2666
        subui   r8,r8,#2
2667
        call    FNDLN           ; find this line in save area
2668
        mov             r13,r9          ; save possible line pointer
2669
        beq             r1,r0,ST4       ; if not found, insert
2670
        ; here we found the line, so we're replacing the line
2671
        ; in the text area
2672
        ; first step - delete the line
2673
        setlo   r1,#0
2674
        call    FNDNXT          ; find the next line (into r9)
2675
        bne             r1,r0,ST7
2676
        beq             r9,r0,ST6       ; no more lines
2677
ST7:
2678
        mov             r1,r9           ; r1 = pointer to next line
2679
        mov             r2,r13          ; pointer to line to be deleted
2680
        lw              r3,TXTUNF       ; points to top of save area
2681
        call    MVUP            ; move up to delete
2682
        sw              r2,TXTUNF       ; update the end pointer
2683
        ; we moved the lines of text after the line being
2684
        ; deleted down, so the pointer to the next line
2685
        ; needs to be reset
2686
        mov             r9,r13
2687
        bra             ST4
2688
        ; here there were no more lines, so just move the
2689
        ; end of text pointer down
2690
ST6:
2691
        sw              r13,TXTUNF
2692
        mov             r9,r13
2693
ST4:
2694
        ; here we're inserting because the line wasn't found
2695
        ; or it was deleted     from the text area
2696
        mov             r1,r12          ; calculate the length of new line
2697
        sub             r1,r1,r8
2698
        blei    r1,#3,ST3       ; is it just a line no. & CR? if so, it was just a delete
2699
 
2700
        lw              r11,TXTUNF      ; compute new end of text
2701
        mov             r10,r11         ; r10 = old TXTUNF
2702
        add             r11,r11,r1              ; r11 = new top of TXTUNF (r1=line length)
2703
 
2704
        lw              r1,VARBGN       ; see if there's enough room
2705
        bltu    r11,r1,ST5
2706
        lea             r1,msgTooBig    ; if not, say so
2707
        jmp             ERROR
2708
 
2709
        ; open a space in the text area
2710
ST5:
2711
        sw              r11,TXTUNF      ; if so, store new end position
2712
        mov             r1,r10          ; points to old end of text
2713
        mov             r2,r11          ; points to new end of text
2714
        mov             r3,r9       ; points to start of line after insert line
2715
        call    MVDOWN          ; move things out of the way
2716
 
2717
        ; copy line into text space
2718
        mov             r1,r8           ; set up to do the insertion; move from buffer
2719
        mov             r2,r13          ; to vacated space
2720
        mov             r3,r12          ; until end of buffer
2721
        call    MVUP            ; do it
2722
        bra             ST3                     ; go back and get another line
2723
 
2724
;******************************************************************
2725
;
2726
; *** Tables *** DIRECT *** EXEC ***
2727
;
2728
; This section of the code tests a string against a table. When
2729
; a match is found, control is transferred to the section of
2730
; code according to the table.
2731
;
2732
; At 'EXEC', r8 should point to the string, r9 should point to
2733
; the character table, and r10 should point to the execution
2734
; table. At 'DIRECT', r8 should point to the string, r9 and
2735
; r10 will be set up to point to TAB1 and TAB1_1, which are
2736
; the tables of all direct and statement commands.
2737
;
2738
; A '.' in the string will terminate the test and the partial
2739
; match will be considered as a match, e.g. 'P.', 'PR.','PRI.',
2740
; 'PRIN.', or 'PRINT' will all match 'PRINT'.
2741
;
2742
; There are two tables: the character table and the execution
2743
; table. The character table consists of any number of text items.
2744
; Each item is a string of characters with the last character's
2745
; high bit set to one. The execution table holds a 32-bit
2746
; execution addresses that correspond to each entry in the
2747
; character table.
2748
;
2749
; The end of the character table is a 0 byte which corresponds
2750
; to the default routine in the execution table, which is
2751
; executed if none of the other table items are matched.
2752
;
2753
; Character-matching tables:
2754
        align   8
2755
TAB1:
2756
        db      "LIS",'T'+0x80        ; Direct commands
2757
        db      "LOA",'D'+0x80
2758
        db      "NE",'W'+0x80
2759
        db      "RU",'N'+0x80
2760
        db      "SAV",'E'+0x80
2761
TAB2:
2762
        db      "NEX",'T'+0x80         ; Direct / statement
2763
        db      "LE",'T'+0x80
2764
        db      "I",'F'+0x80
2765
        db      "GOT",'O'+0x80
2766
        db      "GOSU",'B'+0x80
2767
        db      "RETUR",'N'+0x80
2768
        db      "RE",'M'+0x80
2769
        db      "FO",'R'+0x80
2770
        db      "INPU",'T'+0x80
2771
        db      "PRIN",'T'+0x80
2772
        db      "POKE",'C'+0x80
2773
        db      "POKE",'H'+0x80
2774
        db      "POKE",'W'+0x80
2775
        db      "POK",'E'+0x80
2776
        db      "STO",'P'+0x80
2777
        db      "BY",'E'+0x80
2778
        db      "SY",'S'+0x80
2779
        db      "CL",'S'+0x80
2780
    db  "CL",'R'+0x80
2781
    db  "RDC",'F'+0x80
2782
        db      0
2783
TAB4:
2784
        db      "PEEK",'C'+0x80        ;Functions
2785
        db      "PEEK",'H'+0x80        ;Functions
2786
        db      "PEEK",'W'+0x80        ;Functions
2787
        db      "PEE",'K'+0x80         ;Functions
2788
        db      "RN",'D'+0x80
2789
        db      "AB",'S'+0x80
2790
        db      "SIZ",'E'+0x80
2791
        db  "US",'R'+0x80
2792
        db      0
2793
TAB5:
2794
        db      "T",'O'+0x80           ;"TO" in "FOR"
2795
        db      0
2796
TAB6:
2797
        db      "STE",'P'+0x80         ;"STEP" in "FOR"
2798
        db      0
2799
TAB8:
2800
        db      '>','='+0x80           ;Relational operators
2801
        db      '<','>'+0x80
2802
        db      '>'+0x80
2803
        db      '='+0x80
2804
        db      '<','='+0x80
2805
        db      '<'+0x80
2806
        db      0
2807
TAB9:
2808
    db  "AN",'D'+0x80
2809
    db  0
2810
TAB10:
2811
    db  "O",'R'+0x80
2812
    db  0
2813
 
2814
        .align  8
2815
 
2816
;* Execution address tables:
2817
TAB1_1:
2818
        dw      LISTX                   ;Direct commands
2819
        dw      LOAD
2820
        dw      NEW
2821
        dw      RUN
2822
        dw      SAVE
2823
TAB2_1:
2824
        dw      NEXT            ;       Direct / statement
2825
        dw      LET
2826
        dw      IF
2827
        dw      GOTO
2828
        dw      GOSUB
2829
        dw      RETURN
2830
        dw      IF2                     ; REM
2831
        dw      FOR
2832
        dw      INPUT
2833
        dw      PRINT
2834
        dw      POKEC
2835
        dw      POKEH
2836
        dw      POKEW
2837
        dw      POKE
2838
        dw      STOP
2839
        dw      GOBYE
2840
        dw      SYSX
2841
        dw      _cls
2842
        dw  _clr
2843
        dw      _rdcf
2844
        dw      DEFLT
2845
TAB4_1:
2846
        dw  PEEKC
2847
        dw  PEEKH
2848
        dw  PEEKW
2849
        dw      PEEK                    ;Functions
2850
        dw      RND
2851
        dw      ABS
2852
        dw      SIZEX
2853
        dw  USRX
2854
        dw      XP40
2855
TAB5_1
2856
        dw      FR1                     ;"TO" in "FOR"
2857
        dw      QWHAT
2858
TAB6_1
2859
        dw      FR2                     ;"STEP" in "FOR"
2860
        dw      FR3
2861
TAB8_1
2862
        dw      XP11    ;>=             Relational operators
2863
        dw      XP12    ;<>
2864
        dw      XP13    ;>
2865
        dw      XP15    ;=
2866
        dw      XP14    ;<=
2867
        dw      XP16    ;<
2868
        dw      XP17
2869
TAB9_1
2870
    dw  XP_AND
2871
    dw  XP_ANDX
2872
TAB10_1
2873
    dw  XP_OR
2874
    dw  XP_ORX
2875
 
2876
        .align  16
2877
 
2878 27 robfinch
;*
2879 43 robfinch
; r3 = match flag (trashed)
2880
; r9 = text table
2881
; r10 = exec table
2882
; r11 = trashed
2883
DIRECT:
2884
        lea             r9,TAB1
2885
        lea             r10,TAB1_1
2886
EXEC:
2887
        mov             r11,lr          ; save link reg
2888
        call    IGNBLK          ; ignore leading blanks
2889
        mov             lr,r11          ; restore link reg
2890
        mov             r11,r8          ; save the pointer
2891
        setlo   r3,#0            ; clear match flag
2892
EXLP:
2893
        lbu             r1,[r8]         ; get the program character
2894
        addui   r8,r8,#1
2895
        lbu             r2,[r9]         ; get the table character
2896
        bne             r2,r0,EXNGO             ; If end of table,
2897
        mov             r8,r11          ;       restore the text pointer and...
2898
        bra             EXGO            ;   execute the default.
2899
EXNGO:
2900
        beq             r1,r3,EXGO      ; Else check for period... if so, execute
2901
        andi    r2,r2,#0x7f     ; ignore the table's high bit
2902
        beq             r2,r1,EXMAT;            is there a match?
2903
        addui   r10,r10,#8      ;if not, try the next entry
2904
        mov             r8,r11          ; reset the program pointer
2905
        setlo   r3,#0            ; sorry, no match
2906
EX1:
2907
        addui   r9,r9,#1
2908
        lb              r1,-1[r9]       ; get to the end of the entry
2909
        bgt             r1,r0,EX1
2910
        bra             EXLP            ; back for more matching
2911
EXMAT:
2912
        setlo   r3,#'.'         ; we've got a match so far
2913
        addui   r9,r9,#1
2914
        lb              r1,-1[r9]       ; end of table entry?
2915
        bgt             r1,r0,EXLP              ; if not, go back for more
2916
EXGO:
2917
        lw              r11,[r10]       ; execute the appropriate routine
2918
        jal             r0,[r11]
2919
 
2920
;    lb      r1,[r8]     ; get token from text space
2921
;    bpl
2922
;    and     r1,#0x7f
2923
;    shl     r1,#2       ; * 4 - word offset
2924
;    add     r1,r1,#TAB1_1
2925
;    lw      r1,[r1]
2926
;    jmp     [r1]
2927
 
2928
 
2929
;******************************************************************
2930
;
2931
; What follows is the code to execute direct and statement
2932
; commands. Control is transferred to these points via the command
2933
; table lookup code of 'DIRECT' and 'EXEC' in the last section.
2934
; After the command is executed, control is transferred to other
2935
; sections as follows:
2936
;
2937
; For 'LISTX', 'NEW', and 'STOP': go back to the warm start point.
2938
; For 'RUN': go execute the first stored line if any; else go
2939
; back to the warm start point.
2940
; For 'GOTO' and 'GOSUB': go execute the target line.
2941
; For 'RETURN' and 'NEXT'; go back to saved return line.
2942
; For all others: if 'CURRNT' is 0, go to warm start; else go
2943
; execute next command. (This is done in 'FINISH'.)
2944
;
2945
;******************************************************************
2946
;
2947
; *** NEW *** STOP *** RUN (& friends) *** GOTO ***
2948
;
2949
; 'NEW<CR>' sets TXTUNF to point to TXTBGN
2950
;
2951
; 'STOP<CR>' goes back to WSTART
2952
;
2953
; 'RUN<CR>' finds the first stored line, stores its address
2954
; in CURRNT, and starts executing it. Note that only those
2955
; commands in TAB2 are legal for a stored program.
2956
;
2957
; There are 3 more entries in 'RUN':
2958
; 'RUNNXL' finds next line, stores it's address and executes it.
2959
; 'RUNTSL' stores the address of this line and executes it.
2960
; 'RUNSML' continues the execution on same line.
2961
;
2962
; 'GOTO expr<CR>' evaluates the expression, finds the target
2963
; line, and jumps to 'RUNTSL' to do it.
2964
;
2965
NEW:
2966
        call    ENDCHK
2967
        lw              r1,TXTBGN
2968
        sw              r1,TXTUNF       ;       set the end pointer
2969
        call    clearVars
2970
 
2971
STOP:
2972
        call    ENDCHK
2973
        bra             WSTART          ; WSTART will reset the stack
2974
 
2975
RUN:
2976
        call    ENDCHK
2977
        lw              r8,TXTBGN       ;       set pointer to beginning
2978
        sw              r8,CURRNT
2979
        call    clearVars
2980
 
2981
RUNNXL:                                 ; RUN <next line>
2982
        lw              r1,CURRNT       ; executing a program?
2983
        beq             r1,r0,WSTART    ; if not, we've finished a direct stat.
2984
        setlo   r1,#0        ; else find the next line number
2985
        mov             r9,r8
2986
        call    FNDLNP          ; search for the next line
2987
        bne             r1,r0,RUNTSL
2988
        bne             r9,r0,RUNTSL
2989
        bra             WSTART          ; if we've fallen off the end, stop
2990
 
2991
RUNTSL:                                 ; RUN <this line>
2992
        sw              r9,CURRNT       ; set CURRNT to point to the line no.
2993
        lea             r8,2[r9]        ; set the text pointer to
2994
 
2995
RUNSML:                 ; RUN <same line>
2996
        call    CHKIO           ; see if a control-C was pressed
2997
        lea             r9,TAB2         ; find command in TAB2
2998
        lea             r10,TAB2_1
2999
        bra             EXEC            ; and execute it
3000
 
3001
GOTO:
3002
        call    OREXPR          ;evaluate the following expression
3003
        mov     r5,r1
3004
        call    ENDCHK          ;must find end of line
3005
        mov     r1,r5
3006
        call    FNDLN           ; find the target line
3007
        bne             r1,r0,RUNTSL            ; go do it
3008
        lea             r1,msgBadGotoGosub
3009
        bra             ERROR           ; no such line no.
3010
 
3011
_clr:
3012
    call    clearVars
3013
    bra     FINISH
3014
 
3015
; Clear the variable area of memory
3016
clearVars:
3017
    subui   sp,sp,#16
3018
    sw          r6,[sp]
3019
    sw          lr,8[sp]
3020
    setlo   r6,#2048    ; number of words to clear
3021
    lw      r1,VARBGN
3022
cv1:
3023
    sw      r0,[r1]
3024
    add     r1,r1,#8
3025
    loop        r6,cv1
3026
    lw          lr,8[sp]
3027
    lw          r6,[sp]
3028
    ret         #16
3029
 
3030
 
3031
;******************************************************************
3032
; LIST
3033
;
3034
; LISTX has two forms:
3035
; 'LIST<CR>' lists all saved lines
3036
; 'LIST #<CR>' starts listing at the line #
3037
; Control-S pauses the listing, control-C stops it.
3038
;******************************************************************
3039
;
3040
LISTX:
3041
        call    TSTNUM          ; see if there's a line no.
3042
        mov     r5,r1
3043
        call    ENDCHK          ; if not, we get a zero
3044
        mov     r1,r5
3045
        call    FNDLN           ; find this or next line
3046
LS1:
3047
        bne             r1,r0,LS4
3048
        beq             r9,r0,WSTART    ; warm start if we passed the end
3049
LS4:
3050
        mov             r1,r9
3051
        call    PRTLN           ; print the line
3052
        mov             r9,r1           ; set pointer for next
3053
        call    CHKIO           ; check for listing halt request
3054
        beq             r1,r0,LS3
3055
        bnei    r1,#CTRLS,LS3   ; pause the listing?
3056
LS2:
3057
        call    CHKIO           ; if so, wait for another keypress
3058
        beq             r1,r0,LS2
3059
LS3:
3060
        setlo   r1,#0
3061
        call    FNDLNP          ; find the next line
3062
        bra             LS1
3063
 
3064
 
3065
;******************************************************************
3066
; PRINT command is 'PRINT ....:' or 'PRINT ....<CR>'
3067
; where '....' is a list of expressions, formats, back-arrows,
3068
; and strings.  These items a separated by commas.
3069
;
3070
; A format is a pound sign followed by a number.  It controls
3071
; the number of spaces the value of an expression is going to
3072
; be printed in.  It stays effective for the rest of the print
3073
; command unless changed by another format.  If no format is
3074
; specified, 11 positions will be used.
3075
;
3076
; A string is quoted in a pair of single- or double-quotes.
3077
;
3078
; An underline (back-arrow) means generate a <CR> without a <LF>
3079
;
3080
; A <CR LF> is generated after the entire list has been printed
3081
; or if the list is empty.  If the list ends with a semicolon,
3082
; however, no <CR LF> is generated.
3083
;******************************************************************
3084
;
3085
PRINT:
3086
        lw              r5,#11          ; D4 = number of print spaces
3087
        setlo   r3,#':'
3088
        lea             r4,PR2
3089
        call    TSTC            ; if null list and ":"
3090
        call    CRLF            ; give CR-LF and continue
3091
        bra             RUNSML          ;               execution on the same line
3092
PR2:
3093
        setlo   r3,#CR
3094
        lea             r4,PR0
3095
        call    TSTC            ;if null list and <CR>
3096
        call    CRLF            ;also give CR-LF and
3097
        bra             RUNNXL          ;execute the next line
3098
PR0:
3099
        setlo   r3,#'#'
3100
        lea             r4,PR1
3101
        call    TSTC            ;else is it a format?
3102
        call    OREXPR          ; yes, evaluate expression
3103
        lw              r5,r1           ; and save it as print width
3104
        bra             PR3             ; look for more to print
3105
PR1:
3106
        setlo   r3,#'$'
3107
        lea             r4,PR4
3108
        call    TSTC    ;       is character expression? (MRL)
3109
        call    OREXPR  ;       yep. Evaluate expression (MRL)
3110
        call    GOOUT   ;       print low byte (MRL)
3111
        bra             PR3             ;look for more. (MRL)
3112
PR4:
3113
        call    QTSTG   ;       is it a string?
3114
        ; the following branch must occupy only two bytes!
3115
        bra             PR8             ;       if not, must be an expression
3116
PR3:
3117
        setlo   r3,#','
3118
        lea             r4,PR6
3119
        call    TSTC    ;       if ",", go find next
3120
        call    FIN             ;in the list.
3121
        bra             PR0
3122
PR6:
3123
        call    CRLF            ;list ends here
3124
        bra             FINISH
3125
PR8:
3126
        call    OREXPR          ; evaluate the expression
3127
        lw              r2,r5           ; set the width
3128
        call    PRTNUM          ; print its value
3129
        bra             PR3                     ; more to print?
3130
 
3131
FINISH:
3132
        call    FIN             ; Check end of command
3133
        jmp             QWHAT   ; print "What?" if wrong
3134
 
3135
 
3136
;*******************************************************************
3137
;
3138
; *** GOSUB *** & RETURN ***
3139
;
3140
; 'GOSUB expr:' or 'GOSUB expr<CR>' is like the 'GOTO' command,
3141
; except that the current text pointer, stack pointer, etc. are
3142
; saved so that execution can be continued after the subroutine
3143
; 'RETURN's.  In order that 'GOSUB' can be nested (and even
3144
; recursive), the save area must be stacked.  The stack pointer
3145
; is saved in 'STKGOS'.  The old 'STKGOS' is saved on the stack.
3146
; If we are in the main routine, 'STKGOS' is zero (this was done
3147
; in the initialization section of the interpreter), but we still
3148
; save it as a flag for no further 'RETURN's.
3149
;******************************************************************
3150
;
3151
GOSUB:
3152
        call    PUSHA           ; save the current 'FOR' parameters
3153
        call    OREXPR          ; get line number
3154
        call    FNDLN           ; find the target line
3155
        bne             r1,r0,gosub1
3156
        lea             r1,msgBadGotoGosub
3157
        bra             ERROR           ; if not there, say "How?"
3158
gosub1:
3159
        sub             sp,sp,#24
3160
        sw              r8,[sp]         ; save text pointer
3161
        lw              r1,CURRNT
3162
        sw              r1,8[sp]        ; found it, save old 'CURRNT'...
3163
        lw              r1,STKGOS
3164
        sw              r1,16[sp]       ; and 'STKGOS'
3165
        sw              r0,LOPVAR       ; load new values
3166
        sw              sp,STKGOS
3167
        bra             RUNTSL
3168
 
3169
 
3170
;******************************************************************
3171
; 'RETURN<CR>' undoes everything that 'GOSUB' did, and thus
3172
; returns the execution to the command after the most recent
3173
; 'GOSUB'.  If 'STKGOS' is zero, it indicates that we never had
3174
; a 'GOSUB' and is thus an error.
3175
;******************************************************************
3176
;
3177
RETURN:
3178
        call    ENDCHK          ; there should be just a <CR>
3179
        lw              r1,STKGOS       ; get old stack pointer
3180
        bne             r1,r0,return1
3181
        lea             r1,msgRetWoGosub
3182
        bra             ERROR           ; if zero, it doesn't exist
3183
return1:
3184
        mov             sp,r1           ; else restore it
3185
        lw              r1,16[sp]
3186
        sw              r1,STKGOS       ; and the old 'STKGOS'
3187
        lw              r1,8[sp]
3188
        sw              r1,CURRNT       ; and the old 'CURRNT'
3189
        lw              r8,[sp]         ; and the old text pointer
3190
        add             sp,sp,#24
3191
        call    POPA            ;and the old 'FOR' parameters
3192
        bra             FINISH          ;and we are back home
3193
 
3194
;******************************************************************
3195
; *** FOR *** & NEXT ***
3196
;
3197
; 'FOR' has two forms:
3198
; 'FOR var=exp1 TO exp2 STEP exp1' and 'FOR var=exp1 TO exp2'
3199
; The second form means the same thing as the first form with a
3200
; STEP of positive 1.  The interpreter will find the variable 'var'
3201
; and set its value to the current value of 'exp1'.  It also
3202
; evaluates 'exp2' and 'exp1' and saves all these together with
3203
; the text pointer, etc. in the 'FOR' save area, which consists of
3204
; 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', and 'LOPPT'.  If there is
3205
; already something in the save area (indicated by a non-zero
3206
; 'LOPVAR'), then the old save area is saved on the stack before
3207
; the new values are stored.  The interpreter will then dig in the
3208
; stack and find out if this same variable was used in another
3209
; currently active 'FOR' loop.  If that is the case, then the old
3210
; 'FOR' loop is deactivated. (i.e. purged from the stack)
3211
;******************************************************************
3212
;
3213
FOR:
3214
        call    PUSHA           ; save the old 'FOR' save area
3215
        call    SETVAL          ; set the control variable
3216
        sw              r1,LOPVAR       ; save its address
3217
        lea             r9,TAB5
3218
        lea             r10,TAB5_1; use 'EXEC' to test for 'TO'
3219
        jmp             EXEC
3220
FR1:
3221
        call    OREXPR          ; evaluate the limit
3222
        sw              r1,LOPLMT       ; save that
3223
        lea             r9,TAB6
3224
        lea             r10,TAB6_1      ; use 'EXEC' to test for the word 'STEP
3225
        jmp             EXEC
3226
FR2:
3227
        call    OREXPR          ; found it, get the step value
3228
        bra             FR4
3229
FR3:
3230
        setlo   r1,#1           ; not found, step defaults to 1
3231
FR4:
3232
        sw              r1,LOPINC       ; save that too
3233
FR5:
3234
        lw              r2,CURRNT
3235
        sw              r2,LOPLN        ; save address of current line number
3236
        sw              r8,LOPPT        ; and text pointer
3237
        lw              r3,sp           ; dig into the stack to find 'LOPVAR'
3238
        lw              r6,LOPVAR
3239
        bra             FR7
3240
FR6:
3241
        addui   r3,r3,#40       ; look at next stack frame
3242
FR7:
3243
        lw              r2,[r3]         ; is it zero?
3244
        beq             r2,r0,FR8       ; if so, we're done
3245
        bne             r2,r6,FR6       ; same as current LOPVAR? nope, look some more
3246
 
3247
    lw      r1,r3       ; Else remove 5 long words from...
3248
        addui   r2,r3,#40   ; inside the stack.
3249
        lw              r3,sp
3250
        call    MVDOWN
3251
        add             sp,sp,#40       ; set the SP 5 long words up
3252
FR8:
3253
    bra     FINISH              ; and continue execution
3254
 
3255
 
3256
;******************************************************************
3257
; 'NEXT var' serves as the logical (not necessarily physical) end
3258
; of the 'FOR' loop.  The control variable 'var' is checked with
3259
; the 'LOPVAR'.  If they are not the same, the interpreter digs in
3260
; the stack to find the right one and purges all those that didn't
3261
; match.  Either way, it then adds the 'STEP' to that variable and
3262
; checks the result with against the limit value.  If it is within
3263
; the limit, control loops back to the command following the
3264
; 'FOR'.  If it's outside the limit, the save area is purged and
3265
; execution continues.
3266
;******************************************************************
3267
;
3268
NEXT:
3269
        setlo   r1,#0            ; don't allocate it
3270
        call    TSTV            ; get address of variable
3271
        bne             r1,r0,NX4
3272
        lea             r1,msgNextVar
3273
        bra             ERROR           ; if no variable, say "What?"
3274
NX4:
3275
        mov             r9,r1           ; save variable's address
3276
NX0:
3277
        lw              r1,LOPVAR       ; If 'LOPVAR' is zero, we never...
3278
        bne             r1,r0,NX5   ; had a FOR loop
3279
        lea             r1,msgNextFor
3280
        bra             ERROR
3281
NX5:
3282
        beq             r1,r9,NX2       ; else we check them OK, they agree
3283
        call    POPA            ; nope, let's see the next frame
3284
        bra             NX0
3285
NX2:
3286
        lw              r1,[r9]         ; get control variable's value
3287
        lw              r2,LOPINC
3288
        addu    r1,r1,r2        ; add in loop increment
3289
;       BVS.L   QHOW            say "How?" for 32-bit overflow
3290
        sw              r1,[r9]         ; save control variable's new value
3291
        lw              r3,LOPLMT       ; get loop's limit value
3292
        bgt             r2,r0,NX1       ; check loop increment, branch if loop increment is positive
3293
        blt             r1,r3,NXPurge   ; test against limit
3294
        bra     NX3
3295
NX1:
3296
        bgt             r1,r3,NXPurge
3297
NX3:
3298
        lw              r8,LOPLN        ; Within limit, go back to the...
3299
        sw              r8,CURRNT
3300
        lw              r8,LOPPT        ; saved 'CURRNT' and text pointer.
3301
        bra             FINISH
3302
NXPurge:
3303
    call    POPA        ; purge this loop
3304
    bra     FINISH
3305
 
3306
 
3307
;******************************************************************
3308
; *** REM *** IF *** INPUT *** LET (& DEFLT) ***
3309
;
3310
; 'REM' can be followed by anything and is ignored by the
3311
; interpreter.
3312
;
3313
;REM
3314
;    br     IF2             ; skip the rest of the line
3315
; 'IF' is followed by an expression, as a condition and one or
3316
; more commands (including other 'IF's) separated by colons.
3317
; Note that the word 'THEN' is not used.  The interpreter evaluates
3318
; the expression.  If it is non-zero, execution continues.  If it
3319
; is zero, the commands that follow are ignored and execution
3320
; continues on the next line.
3321
;******************************************************************
3322
;
3323
IF:
3324
    call        OREXPR          ; evaluate the expression
3325
IF1:
3326
    bne     r1,r0,RUNSML                ; is it zero? if not, continue
3327
IF2:
3328
    mov         r9,r8           ; set lookup pointer
3329
        setlo   r1,#0            ; find line #0 (impossible)
3330
        call    FNDSKP          ; if so, skip the rest of the line
3331
        bgt             r1,r0,WSTART    ; if no next line, do a warm start
3332
IF3:
3333
        bra             RUNTSL          ; run the next line
3334
 
3335
 
3336
;******************************************************************
3337
; INPUT is called first and establishes a stack frame
3338
INPERR:
3339
        lw              sp,STKINP       ; restore the old stack pointer
3340
        lw              r8,16[sp]
3341
        sw              r8,CURRNT       ; and old 'CURRNT'
3342
        lw              r8,8[sp]        ; and old text pointer
3343
        addui   sp,sp,#40       ; fall through will subtract 40
3344
 
3345
; 'INPUT' is like the 'PRINT' command, and is followed by a list
3346
; of items.  If the item is a string in single or double quotes,
3347
; or is an underline (back arrow), it has the same effect as in
3348
; 'PRINT'.  If an item is a variable, this variable name is
3349
; printed out followed by a colon, then the interpreter waits for
3350
; an expression to be typed in.  The variable is then set to the
3351
; value of this expression.  If the variable is preceeded by a
3352
; string (again in single or double quotes), the string will be
3353
; displayed followed by a colon.  The interpreter the waits for an
3354
; expression to be entered and sets the variable equal to the
3355
; expression's value.  If the input expression is invalid, the
3356
; interpreter will print "What?", "How?", or "Sorry" and reprint
3357
; the prompt and redo the input.  The execution will not terminate
3358
; unless you press control-C.  This is handled in 'INPERR'.
3359
;
3360
INPUT:
3361
        subui   sp,sp,#40       ; allocate stack frame
3362
        sw      r5,32[sp]
3363
IP6:
3364
        sw              r8,[sp]         ; save in case of error
3365
        call    QTSTG           ; is next item a string?
3366
        bra             IP2                     ; nope - this branch must take only two bytes
3367
        setlo   r1,#1           ; allocate var
3368
        call    TSTV            ; yes, but is it followed by a variable?
3369
        beq     r1,r0,IP4   ; if not, brnch
3370
        mov             r10,r1          ; put away the variable's address
3371
        bra             IP3                     ; if so, input to variable
3372
IP2:
3373
        sw              r8,8[sp]        ; save for 'PRTSTG'
3374
        setlo   r1,#1
3375
        call    TSTV            ; must be a variable now
3376
        bne             r1,r0,IP7
3377
        lea             r1,msgInputVar
3378
        bra             ERROR           ; "What?" it isn't?
3379
IP7:
3380
        mov             r10,r1          ; put away the variable's address
3381
        lb              r5,[r8]         ; get ready for 'PRTSTG' by null terminating
3382
        sb              r0,[r8]
3383
        lw              r1,8[sp]        ; get back text pointer
3384
        call    PRTSTG          ; print string as prompt
3385
        sb              r5,[r8]         ; un-null terminate
3386
IP3
3387
        sw              r8,8[sp]        ; save in case of error
3388
        lw              r1,CURRNT
3389
        sw              r1,16[sp]       ; also save 'CURRNT'
3390
        setlo   r1,#-1
3391
        sw              r1,CURRNT       ; flag that we are in INPUT
3392
        sw              sp,STKINP       ; save the stack pointer too
3393
        sw              r10,24[sp]      ; save the variable address
3394
        setlo   r1,#':'         ; print a colon first
3395
        call    GETLN           ; then get an input line
3396
        lea             r8,BUFFER       ; point to the buffer
3397
        call    OREXPR          ; evaluate the input
3398
        lw              r10,24[sp]      ; restore the variable address
3399
        sw              r1,[r10]        ; save value in variable
3400
        lw              r1,16[sp]       ; restore old 'CURRNT'
3401
        sw              r1,CURRNT
3402
        lw              r8,8[sp]        ; and the old text pointer
3403
IP4:
3404
        setlo   r3,#','
3405
        lea             r4,IP5          ; is the next thing a comma?
3406
        call    TSTC
3407
        bra             IP6                     ; yes, more items
3408
IP5:
3409
    lw      r5,32[sp]
3410
        add             sp,sp,#40       ; clean up the stack
3411
        jmp             FINISH
3412
 
3413
 
3414
DEFLT:
3415
    lb      r1,[r8]
3416
        beq         r1,#CR,FINISH           ; empty line is OK else it is 'LET'
3417
 
3418
 
3419
;******************************************************************
3420
; 'LET' is followed by a list of items separated by commas.
3421
; Each item consists of a variable, an equals sign, and an
3422
; expression.  The interpreter evaluates the expression and sets
3423
; the variable to that value.  The interpreter will also handle
3424
; 'LET' commands without the word 'LET'.  This is done by 'DEFLT'.
3425
;******************************************************************
3426
;
3427
LET:
3428
    call        SETVAL          ; do the assignment
3429
    setlo       r3,#','
3430
    lea         r4,FINISH
3431
        call    TSTC            ; check for more 'LET' items
3432
        bra         LET
3433
LT1:
3434
    bra     FINISH              ; until we are finished.
3435
 
3436
 
3437
;******************************************************************
3438
; *** LOAD *** & SAVE ***
3439
;
3440
; These two commands transfer a program to/from an auxiliary
3441
; device such as a cassette, another computer, etc.  The program
3442
; is converted to an easily-stored format: each line starts with
3443
; a colon, the line no. as 4 hex digits, and the rest of the line.
3444
; At the end, a line starting with an '@' sign is sent.  This
3445
; format can be read back with a minimum of processing time by
3446
; the Butterfly.
3447
;******************************************************************
3448
;
3449
LOAD
3450
        lw              r8,TXTBGN       ; set pointer to start of prog. area
3451
        setlo   r1,#CR          ; For a CP/M host, tell it we're ready...
3452
        call    GOAUXO          ; by sending a CR to finish PIP command.
3453
LOD1:
3454
        call    GOAUXI          ; look for start of line
3455
        ble             r1,r0,LOD1
3456
        beq             r1,#'@',LODEND  ; end of program?
3457
        beq     r1,#0x1A,LODEND ; or EOF marker
3458
        bne             r1,#':',LOD1    ; if not, is it start of line? if not, wait for it
3459
        call    GCHAR           ; get line number
3460
        sb              r1,[r8]         ; store it
3461
        shrui   r1,r1,#8
3462
        sb              r1,1[r8]
3463
        addui   r8,r8,#2
3464
LOD2:
3465
        call    GOAUXI          ; get another text char.
3466
        ble             r1,r0,LOD2
3467
        sb              r1,[r8]
3468
        addui   r8,r8,#1        ; store it
3469
        bne             r1,#CR,LOD2             ; is it the end of the line? if not, go back for more
3470
        bra             LOD1            ; if so, start a new line
3471
LODEND:
3472
        sw              r8,TXTUNF       ; set end-of program pointer
3473
        bra             WSTART          ; back to direct mode
3474
 
3475
 
3476
; get character from input (16 bit value)
3477
GCHAR:
3478
        subui   sp,sp,#24
3479
        sw              r5,[sp]
3480
        sw              r6,8[sp]
3481
        sw              lr,16[sp]
3482
        setlo   r6,#3       ; repeat four times
3483
        setlo   r5,#0
3484
GCHAR1:
3485
        call    GOAUXI          ; get a char
3486
        ble             r1,r0,GCHAR1
3487
        call    asciiToHex
3488
        shli    r5,r5,#4
3489
        or              r5,r5,r1
3490
        loop    r6,GCHAR1
3491
        mov             r1,r5
3492
        lw              lr,16[sp]
3493
        lw              r6,8[sp]
3494
        lw              r5,[sp]
3495
        ret             #24
3496
 
3497
 
3498
; convert an ascii char to hex code
3499
; input
3500
;       r1 = char to convert
3501
 
3502
asciiToHex:
3503
        blei    r1,#'9',a2h1    ; less than '9'
3504
        subui   r1,r1,#7        ; shift 'A' to '9'+1
3505
a2h1:
3506
        subui   r1,r1,#'0'      ;
3507
        andi    r1,r1,#15       ; make sure a nybble
3508
        ret
3509
 
3510
 
3511
 
3512
SAVE:
3513
        lw              r8,TXTBGN       ;set pointer to start of prog. area
3514
        lw              r9,TXTUNF       ;set pointer to end of prog. area
3515
SAVE1:
3516
        call    AUXOCRLF    ; send out a CR & LF (CP/M likes this)
3517
        bgeu    r8,r9,SAVEND    ; are we finished?
3518
        setlo   r1,#':'         ; if not, start a line
3519
        call    GOAUXO
3520
        lbu             r1,[r8]         ; get line number
3521
        lbu             r2,1[r8]
3522
        shli    r2,r2,#8
3523
        or              r1,r1,r2
3524
        addui   r8,r8,#2
3525
        call    PWORD       ; output line number as 4-digit hex
3526
SAVE2:
3527
        lb              r1,[r8]         ; get a text char.
3528
        addui   r8,r8,#1
3529
        beqi    r1,#CR,SAVE1            ; is it the end of the line? if so, send CR & LF and start new line
3530
        call    GOAUXO          ; send it out
3531
        bra             SAVE2           ; go back for more text
3532
SAVEND:
3533
        setlo   r1,#'@'         ; send end-of-program indicator
3534
        call    GOAUXO
3535
        call    AUXOCRLF    ; followed by a CR & LF
3536
        setlo   r1,#0x1A        ; and a control-Z to end the CP/M file
3537
        call    GOAUXO
3538
        bra             WSTART          ; then go do a warm start
3539
 
3540
 
3541
; output a CR LF sequence to auxillary output
3542
; Registers Affected
3543
;   r3 = LF
3544
AUXOCRLF:
3545
    subui   sp,sp,#8
3546
    sw      lr,[sp]
3547
    setlo   r1,#CR
3548
    call    GOAUXO
3549
    setlo   r1,#LF
3550
    call    GOAUXO
3551
    lw      lr,[sp]
3552
    ret         #8
3553
 
3554
 
3555
; output a word in hex format
3556
; tricky because of the need to reverse the order of the chars
3557
PWORD:
3558
        sub             sp,sp,#16
3559
        sw              lr,[sp]
3560
        sw              r5,8[sp]
3561
        lea             r5,NUMWKA+15
3562
        mov             r4,r1           ; r4 = value
3563
pword1:
3564
    mov     r1,r4           ; r1 = value
3565
    shrui       r4,r4,#4        ; shift over to next nybble
3566
    call    toAsciiHex  ; convert LS nybble to ascii hex
3567
    sb      r1,[r5]     ; save in work area
3568
    subui   r5,r5,#1
3569
    cmpui   r1,r5,#NUMWKA
3570
    bge     r1,r0,pword1
3571
pword2:
3572
    addui   r5,r5,#1
3573
    lb      r1,[r5]     ; get char to output
3574
        call    GOAUXO          ; send it
3575
        cmpui   r1,r5,#NUMWKA+15
3576
        blt     r1,r0,pword2
3577
        lw              r5,8[sp]
3578
        lw              lr,[sp]
3579
        ret             #16
3580
 
3581
 
3582
; convert nybble in r2 to ascii hex char2
3583
; r2 = character to convert
3584
 
3585
toAsciiHex:
3586
        andi    r1,r1,#15       ; make sure it's a nybble
3587
        blti    r1,#10,tah1     ; > 10 ?
3588
        addi    r1,r1,#7        ; bump it up to the letter 'A'
3589
tah1:
3590
        addui   r1,r1,#'0'      ; bump up to ascii '0'
3591
        ret
3592
 
3593
 
3594
 
3595
;******************************************************************
3596
; *** POKE *** & SYSX ***
3597
;
3598
; 'POKE expr1,expr2' stores the byte from 'expr2' into the memory
3599
; address specified by 'expr1'.
3600
;
3601
; 'SYSX expr' jumps to the machine language subroutine whose
3602
; starting address is specified by 'expr'.  The subroutine can use
3603
; all registers but must leave the stack the way it found it.
3604
; The subroutine returns to the interpreter by executing an RET.
3605
;******************************************************************
3606
;
3607
POKE:
3608
        subui   sp,sp,#8
3609
        call    OREXPR          ; get the memory address
3610
        setlo   r3,#','
3611
        lea             r4,PKER         ; it must be followed by a comma
3612
        call    TSTC            ; it must be followed by a comma
3613
        sw              r1,[sp]     ; save the address
3614
        call    OREXPR          ; get the byte to be POKE'd
3615
        lw              r2,[sp]     ; get the address back
3616
        sb              r1,[r2]         ; store the byte in memory
3617
        addui   sp,sp,#8
3618
        bra             FINISH
3619
PKER:
3620
        lea             r1,msgComma
3621
        bra             ERROR           ; if no comma, say "What?"
3622
 
3623
POKEC:
3624
        subui   sp,sp,#8
3625
        call    OREXPR          ; get the memory address
3626
        setlo   r3,#','
3627
        lea             r4,PKER         ; it must be followed by a comma
3628
        call    TSTC            ; it must be followed by a comma
3629
        sw              r1,[sp]     ; save the address
3630
        call    OREXPR          ; get the byte to be POKE'd
3631
        lw              r2,[sp]     ; get the address back
3632
        sc              r1,[r2]         ; store the char in memory
3633
        addui   sp,sp,#8
3634
        jmp             FINISH
3635
 
3636
POKEH:
3637
        subui   sp,sp,#8
3638
        call    OREXPR          ; get the memory address
3639
        setlo   r3,#','
3640
        lea             r4,PKER         ; it must be followed by a comma
3641
        call    TSTC
3642
        sw              r1,[sp]     ; save the address
3643
        call    OREXPR          ; get the byte to be POKE'd
3644
        lw              r2,[sp]     ; get the address back
3645
        sh              r1,[r2]         ; store the word in memory
3646
        addui   sp,sp,#8
3647
        jmp             FINISH
3648
 
3649
POKEW:
3650
        subui   sp,sp,#8
3651
        call    OREXPR          ; get the memory address
3652
        setlo   r3,#','
3653
        lea             r4,PKER         ; it must be followed by a comma
3654
        call    TSTC
3655
        sw              r1,[sp]     ; save the address
3656
        call    OREXPR          ; get the word to be POKE'd
3657
        lw              r2,[sp]     ; get the address back
3658
        sw              r1,[r2]         ; store the word in memory
3659
        addui   sp,sp,#8
3660
        jmp             FINISH
3661
 
3662
SYSX:
3663
        subui   sp,sp,#8
3664
        call    OREXPR          ; get the subroutine's address
3665
        bne             r1,r0,sysx1     ; make sure we got a valid address
3666
        lea             r1,msgSYSBad
3667
        bra             ERROR
3668
sysx1:
3669
        sw              r8,[sp]     ; save the text pointer
3670
        jal             r31,[r1]        ; jump to the subroutine
3671
        lw              r8,[sp]     ; restore the text pointer
3672
        addui   sp,sp,#8
3673
        bra             FINISH
3674
 
3675
;******************************************************************
3676
; *** EXPR ***
3677
;
3678
; 'EXPR' evaluates arithmetical or logical expressions.
3679
; <OREXPR>::= <ANDEXPR> OR <ANDEXPR> ...
3680
; <ANDEXPR>::=<EXPR> AND <EXPR> ...
3681
; <EXPR>::=<EXPR2>
3682
;          <EXPR2><rel.op.><EXPR2>
3683
; where <rel.op.> is one of the operators in TAB8 and the result
3684
; of these operations is 1 if true and 0 if false.
3685
; <EXPR2>::=(+ or -)<EXPR3>(+ or -)<EXPR3>(...
3686
; where () are optional and (... are optional repeats.
3687
; <EXPR3>::=<EXPR4>( <* or /><EXPR4> )(...
3688
; <EXPR4>::=<variable>
3689
;           <function>
3690
;           (<EXPR>)
3691
; <EXPR> is recursive so that the variable '@' can have an <EXPR>
3692
; as an index, functions can have an <EXPR> as arguments, and
3693
; <EXPR4> can be an <EXPR> in parenthesis.
3694
;
3695
 
3696
; <OREXPR>::=<ANDEXPR> OR <ANDEXPR> ...
3697
;
3698
OREXPR:
3699
        subui   sp,sp,#16
3700
        sw              lr,[sp]
3701
        call    ANDEXPR         ; get first <ANDEXPR>
3702
XP_OR1:
3703
        sw              r1,4[sp]        ; save <ANDEXPR> value
3704
        lea             r9,TAB10        ; look up a logical operator
3705
        lea             r10,TAB10_1
3706
        jmp             EXEC            ; go do it
3707
XP_OR:
3708
    call    ANDEXPR
3709
    lw      r2,8[sp]
3710
    or      r1,r1,r2
3711
    bra     XP_OR1
3712
XP_ORX:
3713
        lw              r1,8[sp]
3714
    lw      lr,[sp]
3715
    ret         #16
3716
 
3717
 
3718
; <ANDEXPR>::=<EXPR> AND <EXPR> ...
3719
;
3720
ANDEXPR:
3721
        subui   sp,sp,#16
3722
        sw              lr,[sp]
3723
        call    EXPR            ; get first <EXPR>
3724
XP_AND1:
3725
        sw              r1,8[sp]        ; save <EXPR> value
3726
        lea             r9,TAB9         ; look up a logical operator
3727
        lea             r10,TAB9_1
3728
        jmp             EXEC            ; go do it
3729
XP_AND:
3730
    call    EXPR
3731
    lw      r2,8[sp]
3732
    and     r1,r1,r2
3733
    bra     XP_AND1
3734
XP_ANDX:
3735
        lw              r1,8[sp]
3736
    lw      lr,[sp]
3737
    ret         #16
3738
 
3739
 
3740
; Determine if the character is a digit
3741
;   Parameters
3742
;       r1 = char to test
3743
;   Returns
3744
;       r1 = 1 if digit, otherwise 0
3745
;
3746
isDigit:
3747
    blt     r1,#'0',isDigitFalse
3748
    bgt     r1,#'9',isDigitFalse
3749
    setlo   r1,#1
3750
    ret
3751
isDigitFalse:
3752
    setlo   r1,#0
3753
    ret
3754
 
3755
 
3756
; Determine if the character is a alphabetic
3757
;   Parameters
3758
;       r1 = char to test
3759
;   Returns
3760
;       r1 = 1 if alpha, otherwise 0
3761
;
3762
isAlpha:
3763
    blt     r1,#'A',isAlphaFalse
3764
    ble     r1,#'Z',isAlphaTrue
3765
    blt     r1,#'a',isAlphaFalse
3766
    bgt     r1,#'z',isAlphaFalse
3767
isAlphaTrue:
3768
    setlo   r1,#1
3769
    ret
3770
isAlphaFalse:
3771
    setlo   r1,#0
3772
    ret
3773
 
3774
 
3775
; Determine if the character is a alphanumeric
3776
;   Parameters
3777
;       r1 = char to test
3778
;   Returns
3779
;       r1 = 1 if alpha, otherwise 0
3780
;
3781
isAlnum:
3782
    subui   sp,sp,#8
3783
    sw      lr,[sp]
3784
    or      r2,r1,r0            ; save test char
3785
    call    isDigit
3786
    bne         r1,r0,isDigitx  ; if it is a digit
3787
    or      r1,r2,r0            ; get back test char
3788
    call    isAlpha
3789
isDigitx:
3790
    lw      lr,[sp]
3791
    ret         #8
3792
 
3793
 
3794
EXPR:
3795
        subui   sp,sp,#16
3796
        sw              lr,[sp]
3797
        call    EXPR2
3798
        sw              r1,8[sp]        ; save <EXPR2> value
3799
        lea             r9,TAB8         ; look up a relational operator
3800
        lea             r10,TAB8_1
3801
        jmp             EXEC            ; go do it
3802
XP11:
3803
        lw              r1,8[sp]
3804
        call    XP18    ; is it ">="?
3805
        bge             r2,r1,XPRT1     ; no, return r2=1
3806
        bra             XPRT0   ; else return r2=0
3807
XP12:
3808
        lw              r1,8[sp]
3809
        call    XP18    ; is it "<>"?
3810
        bne             r2,r1,XPRT1     ; no, return r2=1
3811
        bra             XPRT0   ; else return r2=0
3812
XP13:
3813
        lw              r1,8[sp]
3814
        call    XP18    ; is it ">"?
3815
        bgt             r2,r1,XPRT1     ; no, return r2=1
3816
        bra             XPRT0   ; else return r2=0
3817
XP14:
3818
        lw              r1,8[sp]
3819
        call    XP18    ; is it "<="?
3820
        ble             r2,r1,XPRT1     ; no, return r2=1
3821
        bra             XPRT0   ; else return r2=0
3822
XP15:
3823
        lw              r1,8[sp]
3824
        call    XP18    ; is it "="?
3825
        beq             r2,r1,XPRT1     ; if not, return r2=1
3826
        bra             XPRT0   ; else return r2=0
3827
XP16:
3828
        lw              r1,8[sp]
3829
        call    XP18    ; is it "<"?
3830
        blt             r2,r1,XPRT1     ; if not, return r2=1
3831
        bra             XPRT0   ; else return r2=0
3832
XPRT0:
3833
        lw              lr,[sp]
3834
        setlo   r1,#0   ; return r1=0 (false)
3835
        ret             #16
3836
XPRT1:
3837
        lw              lr,[sp]
3838
        setlo   r1,#1   ; return r1=1 (true)
3839
        ret             #16
3840
 
3841
XP17:                           ; it's not a rel. operator
3842
        lw              r1,8[sp]        ; return r2=<EXPR2>
3843
        lw              lr,[sp]
3844
        ret             #16
3845
 
3846
XP18:
3847
        subui   sp,sp,#16
3848
        sw              lr,[sp]
3849
        sw              r1,8[sp]
3850
        call    EXPR2           ; do a second <EXPR2>
3851
        lw              r2,8[sp]
3852
        lw              lr,[sp]
3853
        ret             #16
3854
 
3855
; <EXPR2>::=(+ or -)<EXPR3>(+ or -)<EXPR3>(...
3856
 
3857
EXPR2:
3858
        subui   sp,sp,#16
3859
        sw              lr,[sp]
3860
        setlo   r3,#'-'
3861
        lea             r4,XP21
3862
        call    TSTC            ; negative sign?
3863
        setlo   r1,#0            ; yes, fake '0-'
3864
        sw              r0,8[sp]
3865
        bra             XP26
3866
XP21:
3867
        setlo   r3,#'+'
3868
        lea             r4,XP22
3869
        call    TSTC            ; positive sign? ignore it
3870
XP22:
3871
        call    EXPR3           ; first <EXPR3>
3872
XP23:
3873
        sw              r1,8[sp]        ; yes, save the value
3874
        setlo   r3,#'+'
3875
        lea             r4,XP25
3876
        call    TSTC            ; add?
3877
        call    EXPR3           ; get the second <EXPR3>
3878
XP24:
3879
        lw              r2,8[sp]
3880
        add             r1,r1,r2        ; add it to the first <EXPR3>
3881
;       BVS.L   QHOW            brnch if there's an overflow
3882
        bra             XP23            ; else go back for more operations
3883
XP25:
3884
        setlo   r3,#'-'
3885
        lea             r4,XP45
3886
        call    TSTC            ; subtract?
3887
XP26:
3888
        call    EXPR3           ; get second <EXPR3>
3889
        neg             r1,r1           ; change its sign
3890
        bra             XP24            ; and do an addition
3891
XP45:
3892
        lw              r1,8[sp]
3893
        lw              lr,[sp]
3894
        ret             #16
3895
 
3896
 
3897
; <EXPR3>::=<EXPR4>( <* or /><EXPR4> )(...
3898
 
3899
EXPR3:
3900
        subui   sp,sp,#16
3901
        sw              lr,[sp]
3902
        call    EXPR4           ; get first <EXPR4>
3903
XP31:
3904
        sw              r1,8[sp]        ; yes, save that first result
3905
        setlo   r3,#'*'
3906
        lea             r4,XP34
3907
        call    TSTC            ; multiply?
3908
        call    EXPR4           ; get second <EXPR4>
3909
        lw              r2,8[sp]
3910
        muls    r1,r1,r2        ; multiply the two
3911
        bra             XP31        ; then look for more terms
3912
XP34:
3913
        setlo   r3,#'/'
3914
        lea             r4,XP47
3915
        call    TSTC            ; divide?
3916
        call    EXPR4           ; get second <EXPR4>
3917
        or      r2,r1,r0
3918
        lw              r1,8[sp]
3919
        divs    r1,r1,r2        ; do the division
3920
        bra             XP31            ; go back for any more terms
3921
XP47:
3922
        lw              r1,8[sp]
3923
        lw              lr,[sp]
3924
        ret             #16
3925
 
3926
 
3927
; Functions are called through EXPR4
3928
; <EXPR4>::=<variable>
3929
;           <function>
3930
;           (<EXPR>)
3931
 
3932
EXPR4:
3933
    subui   sp,sp,#24
3934
    sw      lr,[sp]
3935
    lea         r9,TAB4         ; find possible function
3936
    lea         r10,TAB4_1
3937
        jmp             EXEC        ; branch to function which does subsequent ret for EXPR4
3938
XP40:                   ; we get here if it wasn't a function
3939
        setlo   r1,#0
3940
        call    TSTV
3941
        beq     r1,r0,XP41  ; nor a variable
3942
        lw              r1,[r1]         ; if a variable, return its value in r1
3943
        lw      lr,[sp]
3944
        ret             #24
3945
XP41:
3946
        call    TSTNUM          ; or is it a number?
3947
        bne             r2,r0,XP46      ; (if not, # of digits will be zero) if so, return it in r1
3948
        call    PARN        ; check for (EXPR)
3949
XP46:
3950
        lw      lr,[sp]
3951
        ret             #24
3952
 
3953
 
3954
; Check for a parenthesized expression
3955
PARN:
3956
        subui   sp,sp,#8
3957
        sw              lr,[sp]
3958
        setlo   r3,#'('
3959
        lea             r4,XP43
3960
        call    TSTC            ; else look for ( OREXPR )
3961
        call    OREXPR
3962
        setlo   r3,#')'
3963
        lea             r4,XP43
3964
        call    TSTC
3965
XP42:
3966
        lw              lr,[sp]
3967
        ret             #8
3968
XP43:
3969
        lea             r1,msgWhat
3970
        bra             ERROR
3971
 
3972
 
3973
; ===== Test for a valid variable name.  Returns Z=1 if not
3974
;       found, else returns Z=0 and the address of the
3975
;       variable in r1.
3976
; Parameters
3977
;       r1 = 1 = allocate if not found
3978
; Returns
3979
;       r1 = address of variable, zero if not found
3980
 
3981
TSTV:
3982
        subui   sp,sp,#24
3983
        sw              lr,[sp]
3984
        sw              r5,8[sp]
3985
        or              r5,r1,r0        ; allocate flag
3986
        call    IGNBLK
3987
        lbu             r1,[r8]         ; look at the program text
3988
        blt     r1,#'@',tstv_notfound   ; C=1: not a variable
3989
        bne             r1,#'@',TV1     ; brnch if not "@" array
3990
        addui   r8,r8,#1        ; If it is, it should be
3991
        call    PARN            ; followed by (EXPR) as its index.
3992
        shli    r1,r1,#3
3993
;       BCS.L   QHOW            say "How?" if index is too big
3994
        subui   sp,sp,#24
3995
    sw      r1,8[sp]    ; save the index
3996
    sw          lr,[sp]
3997
        call    SIZEX           ; get amount of free memory
3998
        lw              lr,[sp]
3999
        lw      r2,8[sp]    ; get back the index
4000
        bltu    r2,r1,TV2       ; see if there's enough memory
4001
        jmp     QSORRY          ; if not, say "Sorry"
4002
TV2:
4003
        lea             r1,VARBGN   ; put address of array element...
4004
        subu    r1,r1,r2       ; into r1 (neg. offset is used)
4005
        bra     TSTVRT
4006
TV1:
4007
    call    getVarName      ; get variable name
4008
    beq     r1,r0,TSTVRT    ; if not, return r1=0
4009
    mov         r2,r5
4010
    call    findVar     ; find or allocate
4011
TSTVRT:
4012
        lw              r5,8[sp]
4013
        lw              lr,[sp]
4014
        ret             #24                     ; r1<>0 (found)
4015
tstv_notfound:
4016
        lw              r5,8[sp]
4017
    lw      lr,[sp]
4018
    setlo   r1,#0       ; r1=0 if not found
4019
    ret         #24
4020
 
4021
 
4022
; Returns
4023
;   r1 = 6 character variable name + type
4024
;
4025
getVarName:
4026
    subui   sp,sp,#24
4027
    sw      lr,[sp]
4028
    sw          r5,16[sp]
4029
 
4030
    lb      r1,[r8]     ; get first character
4031
    sw          r1,8[sp]        ; save off current name
4032
    call    isAlpha
4033
    beq     r1,r0,gvn1
4034
    setlo   r5,#5       ; loop six more times
4035
 
4036
        ; check for second/third character
4037
gvn4:
4038
        addui   r8,r8,#1
4039
        lb      r1,[r8]     ; do we have another char ?
4040
        call    isAlnum
4041
        beq     r1,r0,gvn2  ; nope
4042
        lw      r1,8[sp]    ; get varname
4043
        shli    r1,r1,#8
4044
        lb      r2,[r8]
4045
        or      r1,r1,r2   ; add in new char
4046
    sw      r1,8[sp]   ; save off name again
4047
    loop        r5,gvn4
4048
 
4049
    ; now ignore extra variable name characters
4050
gvn6:
4051
    addui   r8,r8,#1
4052
    lb      r1,[r8]
4053
    call    isAlnum
4054
    bne     r1,r0,gvn6  ; keep looping as long as we have identifier chars
4055
 
4056
    ; check for a variable type
4057
gvn2:
4058
        lb              r1,[r8]
4059
    beq     r1,#'%',gvn3
4060
    beq     r1,#'$',gvn3
4061
    setlo   r1,#0
4062
    subui   r8,r8,#1
4063
 
4064
    ; insert variable type indicator and return
4065
gvn3:
4066
    addui   r8,r8,#1
4067
    lw      r2,8[sp]
4068
    shli        r2,r2,#8
4069
    or      r1,r1,r2    ; add in variable type
4070
    lw      lr,[sp]
4071
    lw          r5,16[sp]
4072
    ret         #24                     ; return Z = 0, r1 = varname
4073
 
4074
    ; not a variable name
4075
gvn1:
4076
    lw      lr,[sp]
4077
    lw          r5,16[sp]
4078
    setlo   r1,#0       ; return Z = 1 if not a varname
4079
    ret         #24
4080
 
4081
 
4082
; Find variable
4083
;   r1 = varname
4084
;       r2 = allocate flag
4085
; Returns
4086
;   r1 = variable address, Z =0 if found / allocated, Z=1 if not found
4087
 
4088
findVar:
4089
    subui   sp,sp,#16
4090
    sw      lr,[sp]
4091
    sw      r7,8[sp]
4092
    lw      r3,VARBGN
4093
fv4:
4094
    lw      r7,[r3]     ; get varname / type
4095
    beq     r7,r0,fv3   ; no more vars ?
4096
    beq     r1,r7,fv1   ; match ?
4097
    add     r3,r3,#8    ; move to next var
4098
    lw      r7,STKBOT
4099
    blt     r3,r7,fv4   ; loop back to look at next var
4100
 
4101
    ; variable not found
4102
    ; no more memory
4103
    setlo       r1,#<msgVarSpace
4104
    sethi       r1,#>msgVarSpace
4105
    bra     ERROR
4106
;    lw      lr,[sp]
4107
;    lw      r7,4[sp]
4108
;    add     sp,sp,#8
4109
;    lw      r1,#0
4110
;    ret
4111
 
4112
    ; variable not found
4113
    ; allocate new ?
4114
fv3:
4115
        beq             r2,r0,fv2
4116
    sw      r1,[r3]     ; save varname / type
4117
    ; found variable
4118
    ; return address
4119
fv1:
4120
    addui   r1,r3,#8
4121
    lw      lr,[sp]
4122
    lw      r7,8[sp]
4123
    ret         #16    ; Z = 0, r1 = address
4124
 
4125
    ; didn't find var and not allocating
4126
fv2:
4127
    lw      lr,[sp]
4128
    lw      r7,8[sp]
4129
    addui   sp,sp,#16   ; Z = 0, r1 = address
4130
        setlo   r1,#0            ; Z = 1, r1 = 0
4131
    ret
4132
 
4133
 
4134
; ===== Multiplies the 32 bit values in r1 and r2, returning
4135
;       the 32 bit result in r1.
4136
;
4137
 
4138
; ===== Divide the 32 bit value in r2 by the 32 bit value in r3.
4139
;       Returns the 32 bit quotient in r1, remainder in r2
4140
;
4141
; r2 = a
4142
; r3 = b
4143
; r6 = remainder
4144
; r7 = iteration count
4145
; r8 = sign
4146
;
4147
 
4148
; q = a / b
4149
; a = r1
4150
; b = r2
4151
; q = r2
4152
 
4153
 
4154
; ===== The PEEK function returns the byte stored at the address
4155
;       contained in the following expression.
4156
;
4157
PEEK:
4158
        call    PARN            ; get the memory address
4159
        lbu             r1,[r1]         ; get the addressed byte
4160
        lw              lr,[sp]         ; and return it
4161
        ret             #24
4162
 
4163
; ===== The PEEK function returns the byte stored at the address
4164
;       contained in the following expression.
4165
;
4166
PEEKC:
4167
        call    PARN            ; get the memory address
4168
        andi    r1,r1,#-2       ; align to char address
4169
        lcu             r1,[r1]         ; get the addressed char
4170
        lw              lr,[sp]         ; and return it
4171
        ret             #24
4172
 
4173
; ===== The PEEK function returns the byte stored at the address
4174
;       contained in the following expression.
4175
;
4176
PEEKH:
4177
        call    PARN            ; get the memory address
4178
        andi    r1,r1,#-4       ; align to half-word address
4179
        lhu             r1,[r1]         ; get the addressed char
4180
        lw              lr,[sp]         ; and return it
4181
        ret             #24
4182
 
4183
; ===== The PEEK function returns the byte stored at the address
4184
;       contained in the following expression.
4185
;
4186
PEEKW:
4187
        call    PARN            ; get the memory address
4188
        andi    r1,r1,#-8               ; align to word address
4189
        lw              r1,[r1]         ; get the addressed word
4190
        lw              lr,[sp]         ; and return it
4191
        ret             #24
4192
 
4193
; user function call
4194
; call the user function with argument in r1
4195
USRX:
4196
        call    PARN            ; get expression value
4197
        sw              r8,8[sp]        ; save the text pointer
4198
        lw      r2,usrJmp   ; get usr vector
4199
        jal             r31,[r2]        ; jump to the subroutine
4200
        lw              r8,8[sp]        ; restore the text pointer
4201
        lw              lr,[sp]
4202
        ret             #24
4203
 
4204
 
4205
; ===== The RND function returns a random number from 1 to
4206
;       the value of the following expression in D0.
4207
;
4208
RND:
4209
        call    PARN            ; get the upper limit
4210
        beq             r1,r0,rnd2      ; it must be positive and non-zero
4211
        blt             r1,r0,rnd1
4212
        lw              r2,r1
4213
        gran                            ; generate a random number
4214
        mfspr   r1,rand         ; get the number
4215
        call    modu4           ; RND(n)=MOD(number,n)+1
4216
        addui   r1,r1,#1
4217
        lw              lr,[sp]
4218
        ret             #24
4219
rnd1:
4220
        lea             r1,msgRNDBad
4221
        bra             ERROR
4222
rnd2:
4223
        gran
4224
        mfspr   r1,rand
4225
        lw              lr,[sp]
4226
        ret             #24
4227
 
4228
 
4229
; r = a mod b
4230
; a = r1
4231
; b = r2 
4232
; r = r6
4233
modu4:
4234
        subui   sp,sp,#32
4235
        sw              r3,[sp]
4236
        sw              r5,8[sp]
4237
        sw              r6,16[sp]
4238
        sw              r7,24[sp]
4239
        lw      r7,#63          ; n = 64
4240
        xor             r5,r5,r5        ; w = 0
4241
        xor             r6,r6,r6        ; r = 0
4242
mod2:
4243
        roli    r1,r1,#1        ; a <<= 1
4244
        andi    r3,r1,#1
4245
        shli    r6,r6,#1        ; r <<= 1
4246
        or              r6,r6,r3
4247
        andi    r1,r1,#-2
4248
        bgtu    r2,r6,mod1      ; b < r ?
4249
        subu    r6,r6,r2        ; r -= b
4250
mod1:
4251
    loop        r7,mod2         ; n--
4252
        mov             r1,r6
4253
        lw              r3,[sp]
4254
        lw              r5,8[sp]
4255
        lw              r6,16[sp]
4256
        lw              r7,24[sp]
4257
        ret             #32
4258
 
4259
 
4260
; ===== The ABS function returns an absolute value in r2.
4261
;
4262
ABS:
4263
        call    PARN            ; get the following expr.'s value
4264
        abs             r1,r1
4265
        lw              lr,[sp]
4266
        ret             #24
4267
 
4268
; ===== The SGN function returns the sign in r1. +1,0, or -1
4269
;
4270
SGN:
4271
        call    PARN            ; get the following expr.'s value
4272
        sgn             r1,r1
4273
        lw              lr,[sp]
4274
        ret             #24
4275
 
4276
; ===== The SIZE function returns the size of free memory in r1.
4277
;
4278
SIZEX:
4279
        lw              r1,VARBGN       ; get the number of free bytes...
4280
        lw              r2,TXTUNF       ; between 'TXTUNF' and 'VARBGN'
4281
        subu    r1,r1,r2
4282
        lw              lr,[sp]
4283
        ret             #24                     ; return the number in r2
4284
 
4285
 
4286
;******************************************************************
4287
;
4288
; *** SETVAL *** FIN *** ENDCHK *** ERROR (& friends) ***
4289
;
4290
; 'SETVAL' expects a variable, followed by an equal sign and then
4291
; an expression.  It evaluates the expression and sets the variable
4292
; to that value.
4293
;
4294
; 'FIN' checks the end of a command.  If it ended with ":",
4295
; execution continues.  If it ended with a CR, it finds the
4296
; the next line and continues from there.
4297
;
4298
; 'ENDCHK' checks if a command is ended with a CR. This is
4299
; required in certain commands, such as GOTO, RETURN, STOP, etc.
4300
;
4301
; 'ERROR' prints the string pointed to by r1. It then prints the
4302
; line pointed to by CURRNT with a "?" inserted at where the
4303
; old text pointer (should be on top of the stack) points to.
4304
; Execution of Tiny BASIC is stopped and a warm start is done.
4305
; If CURRNT is zero (indicating a direct command), the direct
4306
; command is not printed. If CURRNT is -1 (indicating
4307
; 'INPUT' command in progress), the input line is not printed
4308
; and execution is not terminated but continues at 'INPERR'.
4309
;
4310
; Related to 'ERROR' are the following:
4311
; 'QWHAT' saves text pointer on stack and gets "What?" message.
4312
; 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
4313
; 'QSORRY' and 'ASORRY' do the same kind of thing.
4314
; 'QHOW' and 'AHOW' also do this for "How?".
4315
;
4316
 
4317
; returns
4318
; r2 = variable's address
4319
;
4320
SETVAL:
4321
    subui   sp,sp,#16
4322
    sw      lr,[sp]
4323
    setlo       r1,#1           ; allocate var
4324
    call        TSTV            ; variable name?
4325
    bne         r1,r0,sv2
4326
        lea             r1,msgVar
4327
        bra             ERROR
4328
sv2:
4329
        sw      r1,8[sp]    ; save the variable's address
4330
        setlo   r3,#'='
4331
        lea             r4,SV1
4332
        call    TSTC            ; get past the "=" sign
4333
        call    OREXPR          ; evaluate the expression
4334
        lw      r2,8[sp]    ; get back the variable's address
4335
        sw      r1,[r2]     ; and save value in the variable
4336
        lw              r1,r2           ; return r1 = variable address
4337
        lw      lr,[sp]
4338
        ret             #16
4339
SV1:
4340
    bra     QWHAT               ; if no "=" sign
4341
 
4342
 
4343
FIN:
4344
        subui   sp,sp,#8
4345
        sw              lr,[sp]
4346
        setlo   r3,#':'
4347
        lea             r4,FI1
4348
        call    TSTC            ; *** FIN ***
4349
        addui   sp,sp,#8        ; if ":", discard return address
4350
        bra             RUNSML          ; continue on the same line
4351
FI1:
4352
        setlo   r3,#CR
4353
        lea             r4,FI2
4354
        call    TSTC            ; not ":", is it a CR?
4355
        lw              lr,[sp] ; else return to the caller
4356
        addui   sp,sp,#8        ; yes, purge return address
4357
        bra             RUNNXL          ; execute the next line
4358
FI2:
4359
        lw              lr,[sp] ; else return to the caller
4360
        ret             #8
4361
 
4362
 
4363
; Check that there is nothing else on the line
4364
; Registers Affected
4365
;   r1
4366
;
4367
ENDCHK:
4368
        subui   sp,sp,#8
4369
        sw              lr,[sp]
4370
        call    IGNBLK
4371
        lb              r1,[r8]
4372
        beq             r1,#CR,ec1      ; does it end with a CR?
4373
        setlo   r1,#<msgExtraChars
4374
        sethi   r1,#>msgExtraChars
4375
        jmp             ERROR
4376
ec1:
4377
        lw              lr,[sp]
4378
        ret             #8
4379
 
4380
 
4381
TOOBIG:
4382
        lea             r1,msgTooBig
4383
        bra             ERROR
4384
QSORRY:
4385
    lea         r1,SRYMSG
4386
        bra         ERROR
4387
QWHAT:
4388
        lea             r1,msgWhat
4389
ERROR:
4390
        call    PRMESG          ; display the error message
4391
        lw              r1,CURRNT       ; get the current line number
4392
        beq             r1,r0,WSTART    ; if zero, do a warm start
4393
        beq             r1,#-1,INPERR           ; is the line no. pointer = -1? if so, redo input
4394
        lb              r5,[r8]         ; save the char. pointed to
4395
        sb              r0,[r8]         ; put a zero where the error is
4396
        lw              r1,CURRNT       ; point to start of current line
4397
        call    PRTLN           ; display the line in error up to the 0
4398
        or      r6,r1,r0    ; save off end pointer
4399
        sb              r5,[r8]         ; restore the character
4400
        setlo   r1,#'?'         ; display a "?"
4401
        call    GOOUT
4402
        setlo   r2,#0       ; stop char = 0
4403
        subui   r1,r6,#1        ; point back to the error char.
4404
        call    PRTSTG          ; display the rest of the line
4405
        jmp         WSTART              ; and do a warm start
4406
 
4407
;******************************************************************
4408
;
4409
; *** GETLN *** FNDLN (& friends) ***
4410
;
4411
; 'GETLN' reads in input line into 'BUFFER'. It first prompts with
4412
; the character in r3 (given by the caller), then it fills the
4413
; buffer and echos. It ignores LF's but still echos
4414
; them back. Control-H is used to delete the last character
4415
; entered (if there is one), and control-X is used to delete the
4416
; whole line and start over again. CR signals the end of a line,
4417
; and causes 'GETLN' to return.
4418
;
4419
;
4420
GETLN:
4421
        subui   sp,sp,#16
4422
        sw              lr,[sp]
4423
        sw              r5,8[sp]
4424
        call    GOOUT           ; display the prompt
4425
        setlo   r1,#1           ; turn on cursor flash
4426
        sb              r1,cursFlash
4427
        setlo   r1,#' '         ; and a space
4428
        call    GOOUT
4429
        setlo   r8,#<BUFFER     ; r8 is the buffer pointer
4430
        sethi   r8,#>BUFFER
4431
GL1:
4432
        call    CHKIO           ; check keyboard
4433
        beq             r1,r0,GL1       ; wait for a char. to come in
4434
        beq             r1,#CTRLH,GL3   ; delete last character? if so
4435
        beq             r1,#CTRLX,GL4   ; delete the whole line?
4436
        beq             r1,#CR,GL2      ; accept a CR
4437
        bltu    r1,#' ',GL1     ; if other control char., discard it
4438
GL2:
4439
        sb              r1,[r8]         ; save the char.
4440
        add             r8,r8,#1
4441
        call    GOOUT           ; echo the char back out
4442
        lb      r1,-1[r8]   ; get char back (GOOUT destroys r1)
4443
        beq             r1,#CR,GL7      ; if it's a CR, end the line
4444
        cmpui   r1,r8,#BUFFER+BUFLEN-1  ; any more room?
4445
        blt             r1,r0,GL1       ; yes: get some more, else delete last char.
4446
GL3:
4447
        setlo   r1,#CTRLH       ; delete a char. if possible
4448
        call    GOOUT
4449
        setlo   r1,#' '
4450
        call    GOOUT
4451
        cmpui   r1,r8,#BUFFER   ; any char.'s left?
4452
        ble             r1,r0,GL1               ; if not
4453
        setlo   r1,#CTRLH       ; if so, finish the BS-space-BS sequence
4454
        call    GOOUT
4455
        sub             r8,r8,#1        ; decrement the text pointer
4456
        bra             GL1                     ; back for more
4457
GL4:
4458
        or              r1,r8,r0                ; delete the whole line
4459
        subui   r5,r1,#BUFFER   ; figure out how many backspaces we need
4460
        beq             r5,r0,GL6               ; if none needed, brnch
4461
GL5:
4462
        setlo   r1,#CTRLH       ; and display BS-space-BS sequences
4463
        call    GOOUT
4464
        setlo   r1,#' '
4465
        call    GOOUT
4466
        setlo   r1,#CTRLH
4467
        call    GOOUT
4468
        loop    r5,GL5
4469
GL6:
4470
        lea             r8,BUFFER       ; reinitialize the text pointer
4471
        bra             GL1                     ; and go back for more
4472
GL7:
4473
        setlo   r1,#0            ; turn off cursor flash
4474
        sb              r1,cursFlash
4475
        setlo   r1,#LF          ; echo a LF for the CR
4476
        call    GOOUT
4477
        lw              lr,[sp]
4478
        lw              r5,8[sp]
4479
        ret             #16
4480
 
4481
 
4482
; 'FNDLN' finds a line with a given line no. (in r1) in the
4483
; text save area.  r9 is used as the text pointer. If the line
4484
; is found, r9 will point to the beginning of that line
4485
; (i.e. the high byte of the line no.), and flags are Z.
4486
; If that line is not there and a line with a higher line no.
4487
; is found, r9 points there and flags are NC & NZ. If we reached
4488
; the end of the text save area and cannot find the line, flags
4489
; are C & NZ.
4490
; Z=1 if line found
4491
; N=1 if end of text save area
4492
; Z=0 & N=0 if higher line found
4493
; r0 = 1        <= line is found
4494
;       r9 = pointer to line
4495
; r0 = 0    <= line is not found
4496
;       r9 = zero, if end of text area
4497
;       r9 = otherwise higher line number
4498
;
4499
; 'FNDLN' will initialize r9 to the beginning of the text save
4500
; area to start the search. Some other entries of this routine
4501
; will not initialize r9 and do the search.
4502
; 'FNDLNP' will start with r9 and search for the line no.
4503
; 'FNDNXT' will bump r9 by 2, find a CR and then start search.
4504
; 'FNDSKP' uses r9 to find a CR, and then starts the search.
4505
; return Z=1 if line is found, r9 = pointer to line
4506
;
4507
; Parameters
4508
;       r1 = line number to find
4509
;
4510
FNDLN:
4511
        bleui   r1,#0xFFFF,fl1  ; line no. must be < 65535
4512
        lea             r1,msgLineRange
4513
        bra             ERROR
4514
fl1:
4515
        lw              r9,TXTBGN       ; init. the text save pointer
4516
 
4517
FNDLNP:
4518
        lw              r10,TXTUNF      ; check if we passed the end
4519
        subui   r10,r10,#1
4520
        bgtu    r9,r10,FNDRET1          ; if so, return with r9=0,r1=0
4521
        lbu             r3,[r9]         ; get low order byte of line number
4522
        lbu             r2,1[r9]        ; get high order byte
4523
        shli    r2,r2,#8
4524
        or              r2,r2,r3        ; build whole line number
4525
        bgtu    r1,r2,FNDNXT    ; is this the line we want? no, not there yet
4526
        beq             r1,r2,FNDRET2
4527
FNDRET:
4528
        xor             r1,r1,r1        ; line not found, but r9=next line pointer
4529
        ret                     ; return the cond. codes
4530
FNDRET1:
4531
        xor             r9,r9,r9        ; no higher line
4532
        xor             r1,r1,r1        ; line not found
4533
        ret
4534
FNDRET2:
4535
        setlo   r1,#1           ; line found
4536
        ret
4537
 
4538
FNDNXT:
4539
        addui   r9,r9,#2        ; find the next line
4540
 
4541
FNDSKP:
4542
        lbu             r2,[r9]
4543
        addui   r9,r9,#1
4544
        bnei    r2,#CR,FNDSKP           ; try to find a CR, keep looking
4545
        bra             FNDLNP          ; check if end of text
4546
 
4547
 
4548
;******************************************************************
4549
; 'MVUP' moves a block up from where r1 points to where r2 points
4550
; until r1=r3
4551
;
4552
MVUP1:
4553
        lb              r4,[r1]
4554
        sb              r4,[r2]
4555
        add             r1,r1,#1
4556
        add             r2,r2,#1
4557
MVUP:
4558
        bne             r1,r3,MVUP1
4559
MVRET:
4560
        ret
4561
 
4562
 
4563
; 'MVDOWN' moves a block down from where r1 points to where r2
4564
; points until r1=r3
4565
;
4566
MVDOWN1:
4567
        sub             r1,r1,#1
4568
        sub             r2,r2,#1
4569
        lb              r4,[r1]
4570
        sb              r4,[r2]
4571
MVDOWN:
4572
        bne             r1,r3,MVDOWN1
4573
        ret
4574
 
4575
 
4576
; 'POPA' restores the 'FOR' loop variable save area from the stack
4577
;
4578
; 'PUSHA' stacks for 'FOR' loop variable save area onto the stack
4579
;
4580
; Note: a single zero word is stored on the stack in the
4581
; case that no FOR loops need to be saved. This needs to be
4582
; done because PUSHA / POPA is called all the time.
4583
 
4584
POPA:
4585
        lw              r1,[sp]         ; restore LOPVAR, but zero means no more
4586
        sw              r1,LOPVAR
4587
        beq             r1,r0,PP1
4588
        lw              r1,32[sp]       ; if not zero, restore the rest
4589
        sw              r1,LOPPT
4590
        lw              r1,24[sp]
4591
        sw              r1,LOPLN
4592
        lw              r1,16[sp]
4593
        sw              r1,LOPLMT
4594
        lw              r1,8[sp]
4595
        sw              r1,LOPINC
4596
        ret             #40
4597
PP1:
4598
        ret             #8
4599
 
4600
 
4601
PUSHA:
4602
        lw              r1,STKBOT       ; Are we running out of stack room?
4603
        addui   r1,r1,#40       ; we might need this many bytes
4604
        bltu    sp,r1,QSORRY    ; out of stack space
4605
        lw              r1,LOPVAR       ; save loop variables
4606
        beq             r1,r0,PU1       ; if LOPVAR is zero, that's all
4607
        subui   sp,sp,#40
4608
        sw              r1,[sp]
4609
        lw              r1,LOPPT
4610
        sw              r1,32[sp]       ; else save all the others
4611
        lw              r1,LOPLN
4612
        sw              r1,24[sp]
4613
        lw              r1,LOPLMT
4614
        sw              r1,16[sp]
4615
        lw              r1,LOPINC
4616
        sw              r1,8[sp]
4617
        ret
4618
PU1:
4619
        subui   sp,sp,#8
4620
        sw              r1,[sp]
4621
        ret
4622
 
4623
 
4624
;******************************************************************
4625
;
4626
; *** PRTSTG *** QTSTG *** PRTNUM *** PRTLN ***
4627
;
4628
; 'PRTSTG' prints a string pointed to by r3. It stops printing
4629
; and returns to the caller when either a CR is printed or when
4630
; the next byte is the same as what was passed in r4 by the
4631
; caller.
4632
;
4633
; 'QTSTG' looks for an underline (back-arrow on some systems),
4634
; single-quote, or double-quote.  If none of these are found, returns
4635
; to the caller.  If underline, outputs a CR without a LF.  If single
4636
; or double quote, prints the quoted string and demands a matching
4637
; end quote.  After the printing, the next i-word of the caller is
4638
; skipped over (usually a branch instruction).
4639
;
4640
; 'PRTNUM' prints the 32 bit number in r3, leading blanks are added if
4641
; needed to pad the number of spaces to the number in r4.
4642
; However, if the number of digits is larger than the no. in
4643
; r4, all digits are printed anyway. Negative sign is also
4644
; printed and counted in, positive sign is not.
4645
;
4646
; 'PRTLN' prints the saved text line pointed to by r3
4647
; with line no. and all.
4648
;
4649
 
4650
; r1 = pointer to string
4651
; r2 = stop character
4652
; return r1 = pointer to end of line + 1
4653
 
4654
PRTSTG:
4655
    sub     sp,sp,#32
4656
    sw          r5,[sp]
4657
    sw          r5,8[sp]
4658
    sw          r7,16[sp]
4659
    sw          lr,24[sp]
4660
    mov     r5,r1       ; r5 = pointer
4661
    mov     r6,r2       ; r6 = stop char
4662
PS1:
4663
    lbu     r7,[r5]     ; get a text character
4664
    addui   r5,r5,#1
4665
        beq         r7,r6,PRTRET                ; same as stop character? if so, return
4666
        mov     r1,r7
4667
        call    GOOUT           ; display the char.
4668
        bnei    r7,#CR,PS1  ; is it a C.R.? no, go back for more
4669
        setlo   r1,#LF      ; yes, add a L.F.
4670
        call    GOOUT
4671
PRTRET:
4672
    mov     r2,r7       ; return r2 = stop char
4673
        mov             r1,r5           ; return r1 = line pointer
4674
    lw          lr,24[sp]
4675
    lw          r7,16[sp]
4676
    lw          r5,8[sp]
4677
    lw          r5,[sp]
4678
    ret         #32             ; then return
4679
 
4680
 
4681
QTSTG:
4682
        subui   sp,sp,#8
4683
        sw              lr,[sp]
4684
        setlo   r3,#'"'
4685
        setlo   r4,#<QT3
4686
        sethi   r4,#>QT3
4687
        call    TSTC            ; *** QTSTG ***
4688
        setlo   r2,#'"'         ; it is a "
4689
QT1:
4690
        or              r1,r8,r0
4691
        call    PRTSTG          ; print until another
4692
        lw              r8,r1
4693
        bne             r2,#LF,QT2      ; was last one a CR?
4694
        addui   sp,sp,#8
4695
        bra             RUNNXL          ; if so, run next line
4696
QT3:
4697
        setlo   r3,#''''
4698
        setlo   r4,#<QT4
4699
        sethi   r4,#>QT4
4700
        call    TSTC            ; is it a single quote?
4701
        setlo   r2,#''''        ; if so, do same as above
4702
        bra             QT1
4703
QT4:
4704
        setlo   r3,#'_'
4705
        setlo   r4,#<QT5
4706
        sethi   r4,#>QT5
4707
        call    TSTC            ; is it an underline?
4708
        setlo   r1,#CR          ; if so, output a CR without LF
4709
        call    GOOUT
4710
QT2:
4711
        lw              lr,[sp]
4712
        addui   sp,sp,#8
4713
        jal             r0,4[lr]                ; skip over next i-word when returning
4714
QT5:                                            ; not " ' or _
4715
        lw              lr,[sp]
4716
        ret             #8
4717
 
4718
 
4719
; Output a CR LF sequence
4720
;
4721
prCRLF:
4722
        subui   sp,sp,#8
4723
        sw              lr,[sp]
4724
        setlo   r1,#CR
4725
        call    GOOUT
4726
        setlo   r1,#LF
4727
        call    GOOUT
4728
        lw              lr,[sp]
4729
        ret             #8
4730
 
4731
 
4732
; r1 = number to print
4733
; r2 = number of digits
4734
; Register Usage
4735
;       r5 = number of padding spaces
4736
PRTNUM:
4737
        subui   sp,sp,#40
4738
        sw              r3,[sp]
4739
        sw              r5,8[sp]
4740
        sw              r6,16[sp]
4741
        sw              r7,24[sp]
4742
        sw              lr,32[sp]
4743
        ori             r7,r0,#NUMWKA   ; r7 = pointer to numeric work area
4744
        mov             r6,r1           ; save number for later
4745
        mov             r5,r2           ; r5 = min number of chars
4746
        bgt             r1,r0,PN1       ; is it negative? if not
4747
        neg             r1,r1           ; else make it positive
4748
        subui   r5,r5,#1        ; one less for width count
4749
PN1:
4750
        lw              r3,#10
4751
        mod             r2,r1,r3        ; r2 = r1 mod 10
4752
        divui   r1,r1,#10       ; r1 /= 10 divide by 10
4753
        addui   r2,r2,#'0'      ; convert remainder to ascii
4754
        sb              r2,[r7]         ; and store in buffer
4755
        addui   r7,r7,#1
4756
        subui   r5,r5,#1        ; decrement width
4757
        bne             r1,r0,PN1
4758
PN6:
4759
        ble             r5,r0,PN4       ; test pad count, skip padding if not needed
4760
PN3:
4761
        setlo   r1,#' '         ; display the required leading spaces
4762
        call    GOOUT
4763
        loop    r5,PN3
4764
PN4:
4765
        bgt             r6,r0,PN5       ; is number negative?
4766
        setlo   r1,#'-'         ; if so, display the sign
4767
        call    GOOUT
4768
PN5:
4769
        subui   r7,r7,#1
4770
        lb              r1,[r7]         ; now unstack the digits and display
4771
        call    GOOUT
4772
        cmpui   r1,r7,#NUMWKA
4773
        bgtu    r1,r0,PN5
4774
PNRET:
4775
        lw              lr,32[sp]
4776
        lw              r7,24[sp]
4777
        lw              r6,16[sp]
4778
        lw              r5,8[sp]
4779
        lw              r3,[sp]
4780
        ret             #40
4781
 
4782
 
4783
; r1 = number to print
4784
; r2 = number of digits
4785
PRTHEXNUM:
4786
        subui   sp,sp,#40
4787
        sw              r5,[sp]
4788
        sw              r6,8[sp]
4789
        sw              r7,16[sp]
4790
        sw              r8,24[sp]
4791
        sw              lr,32[sp]
4792
        setlo   r7,#<NUMWKA     ; r7 = pointer to numeric work area
4793
        sethi   r7,#>NUMWKA
4794
        or              r6,r1,r0        ; save number for later
4795
        setlo   r5,#20          ; r5 = min number of chars
4796
        or              r4,r1,r0
4797
        bgt             r4,r0,PHN1              ; is it negative? if not
4798
        neg             r4,r4                   ; else make it positive
4799
        sub             r5,r5,#1        ; one less for width count
4800
        setlo   r8,#20          ; maximum of 10 digits
4801
PHN1:
4802
        or              r1,r4,r0
4803
        andi    r1,r1,#15
4804
        blt             r1,#10,PHN7
4805
        addui   r1,r1,#'A'-10
4806
        bra             PHN8
4807
PHN7:
4808
        add             r1,r1,#'0'              ; convert remainder to ascii
4809
PHN8:
4810
        sb              r1,[r7]         ; and store in buffer
4811
        add             r7,r7,#1
4812
        sub             r5,r5,#1        ; decrement width
4813
        shru    r4,r4,#4
4814
        beq             r4,r0,PHN6                      ; is it zero yet ?
4815
        loop    r8,PHN1         ; safety
4816
PHN6:   ; test pad count
4817
        ble             r5,r0,PHN4      ; skip padding if not needed
4818
PHN3:
4819
        setlo   r1,#' '         ; display the required leading spaces
4820
        call    GOOUT
4821
        loop    r5,PHN3
4822
PHN4:
4823
        bgt             r6,r0,PHN5      ; is number negative?
4824
        setlo   r1,#'-'         ; if so, display the sign
4825
        call    GOOUT
4826
PHN5:
4827
        sub             r7,r7,#1
4828
        lb              r1,[r7]         ; now unstack the digits and display
4829
        call    GOOUT
4830
        cmpui   r1,r7,#NUMWKA
4831
        bgt             r1,r0,PHN5
4832
PHNRET:
4833
        lw              lr,32[sp]
4834
        lw              r8,24[sp]
4835
        lw              r7,16[sp]
4836
        lw              r6,8[sp]
4837
        lw              r5,[sp]
4838
        ret             #40
4839
 
4840
 
4841
; r1 = pointer to line
4842
; returns r1 = pointer to end of line + 1
4843
PRTLN:
4844
    subui   sp,sp,#16
4845
    sw          r5,[sp]
4846
    sw          lr,8[sp]
4847
    addi    r5,r1,#2
4848
    lbu         r1,-2[r5]       ; get the binary line number
4849
    lbu         r2,-1[r5]
4850
    shli        r2,r2,#8
4851
    or          r1,r1,r2
4852
    setlo   r2,#0       ; display a 0 or more digit line no.
4853
        call    PRTNUM
4854
        setlo   r1,#' '     ; followed by a blank
4855
        call    GOOUT
4856
        setlo   r2,#0       ; stop char. is a zero
4857
        or      r1,r5,r0
4858
        call    PRTSTG          ; display the rest of the line
4859
        lw              lr,8[sp]
4860
        lw              r5,[sp]
4861
        ret             #16
4862
 
4863
 
4864
; ===== Test text byte following the call to this subroutine. If it
4865
;       equals the byte pointed to by r8, return to the code following
4866
;       the call. If they are not equal, brnch to the point
4867
;       indicated in r4.
4868
;
4869
; Registers Affected
4870
;   r3,r8
4871
; Returns
4872
;       r8 = updated text pointer
4873
;
4874
TSTC
4875
        subui   sp,sp,#16
4876
        sw              lr,[sp]
4877
        sw              r1,8[sp]
4878
        call    IGNBLK          ; ignore leading blanks
4879
        lb              r1,[r8]
4880
        beq             r3,r1,TC1       ; is it = to what r8 points to? if so
4881
        lw              r1,8[sp]
4882
        lw              lr,[sp]
4883
        addui   sp,sp,#16
4884
        jal             r0,[r4]         ; jump to the routine
4885
TC1:
4886
        add             r8,r8,#1        ; if equal, bump text pointer
4887
        lw              r1,8[sp]
4888
        lw              lr,[sp]
4889
        ret             #16
4890
 
4891
; ===== See if the text pointed to by r8 is a number. If so,
4892
;       return the number in r2 and the number of digits in r3,
4893
;       else return zero in r2 and r3.
4894
; Registers Affected
4895
;   r1,r2,r3,r4
4896
; Returns
4897
;       r1 = number
4898
;       r2 = number of digits in number
4899
;       r8 = updated text pointer
4900
;
4901
TSTNUM:
4902
        subui   sp,sp,#8
4903
        sw              lr,[sp]
4904
        call    IGNBLK          ; skip over blanks
4905
        setlo   r1,#0            ; initialize return parameters
4906
        setlo   r2,#0
4907
TN1:
4908
        lb              r3,[r8]
4909
        bltui   r3,#'0',TSNMRET ; is it less than zero?
4910
        bgtui   r3,#'9',TSNMRET ; is it greater than nine?
4911
        setlo   r4,#0xFFFFFFFF
4912
        sethi   r4,#0x07FFFFFF
4913
        bleu    r1,r4,TN2       ; see if there's room for new digit
4914
        setlo   r1,msgNumTooBig
4915
        bra             ERROR           ; if not, we've overflowd
4916
TN2:
4917
        mului   r1,r1,#10       ; quickly multiply result by 10
4918
        addi    r8,r8,#1        ; adjust text pointer
4919
        andi    r3,r3,#0x0F     ; add in the new digit
4920
        add             r1,r1,r3
4921
        addi    r2,r2,#1        ; increment the no. of digits
4922
        bra             TN1
4923
TSNMRET:
4924
        lw              lr,[sp]
4925
        ret             #8
4926
 
4927
 
4928
;===== Skip over blanks in the text pointed to by r8.
4929
;
4930
; Registers Affected:
4931
;       r8
4932
; Returns
4933
;       r8 = pointer updateded past any spaces or tabs
4934
;
4935
IGNBLK:
4936
        subui   sp,sp,#8
4937
        sw              r1,[sp]
4938
IGB2:
4939
        lb              r1,[r8]                 ; get char
4940
        beqi    r1,#' ',IGB1    ; see if it's a space
4941
        bnei    r1,#'\t',IGBRET ; or a tab
4942
IGB1:
4943
        add             r8,r8,#1                ; increment the text pointer
4944
        bra             IGB2
4945
IGBRET:
4946
        lw              r1,[sp]
4947
        ret             #8
4948
 
4949
 
4950
; ===== Convert the line of text in the input buffer to upper
4951
;       case (except for stuff between quotes).
4952
;
4953
; Registers Affected
4954
;   r1,r3
4955
; Returns
4956
;       r8 = pointing to end of text in buffer
4957
;
4958
TOUPBUF:
4959
        subui   sp,sp,#8
4960
        sw              lr,[sp]
4961
        setlo   r8,BUFFER       ; set up text pointer
4962
        setlo   r3,#0            ; clear quote flag
4963
TOUPB1:
4964
        lb              r1,[r8]         ; get the next text char.
4965
        add             r8,r8,#1
4966
        beqi    r1,#CR,TOUPBRT          ; is it end of line?
4967
        beqi    r1,#'"',DOQUO   ; a double quote?
4968
        beqi    r1,#'''',DOQUO  ; or a single quote?
4969
        bne             r3,r0,TOUPB1    ; inside quotes?
4970
        call    toUpper         ; convert to upper case
4971
        sb              r1,-1[r8]       ; store it
4972
        bra             TOUPB1          ; and go back for more
4973
DOQUO:
4974
        bne             r3,r0,DOQUO1; are we inside quotes?
4975
        or              r3,r1,r0        ; if not, toggle inside-quotes flag
4976
        bra             TOUPB1
4977
DOQUO1:
4978
        bne             r3,r1,TOUPB1            ; make sure we're ending proper quote
4979
        setlo   r3,#0            ; else clear quote flag
4980
        bra             TOUPB1
4981
TOUPBRT:
4982
        lw              lr,[sp]
4983
        ret             #8
4984
 
4985
 
4986
; ===== Convert the character in r1 to upper case
4987
;
4988
toUpper
4989
        blt             r1,#'a',TOUPRET ; is it < 'a'?
4990
        bgt             r1,#'z',TOUPRET ; or > 'z'?
4991
        sub             r1,r1,#32       ; if not, make it upper case
4992
TOUPRET
4993
        ret
4994
 
4995
 
4996
; 'CHKIO' checks the input. If there's no input, it will return
4997
; to the caller with the r1=0. If there is input, the input byte is in r1.
4998
; However, if a control-C is read, 'CHKIO' will warm-start BASIC and will
4999
; not return to the caller.
5000
;
5001
CHKIO:
5002
        subui   sp,sp,#8        ; save link reg
5003
        sw              lr,[sp]
5004
        call    GOIN            ; get input if possible
5005
        beq             r1,#-1,CHKRET2          ; if Zero, no input
5006
        bnei    r1,#CTRLC,CHKRET        ; is it control-C?
5007
        jmp             WSTART          ; if so, do a warm start
5008
CHKRET2:
5009
        xor             r1,r1,r1
5010
CHKRET:
5011
        lw              lr,[sp]         ;r1=0
5012
        ret             #8
5013
 
5014
 
5015
; ===== Display a CR-LF sequence
5016
;
5017
CRLF:
5018
        setlo   r1,CLMSG
5019
 
5020
 
5021
; ===== Display a zero-ended string pointed to by register r1
5022
; Registers Affected
5023
;   r1,r2,r4
5024
;
5025
PRMESG:
5026
        subui   sp,sp,#16
5027
        sw              r5,[sp]
5028
        sw              lr,8[sp]
5029
        mov     r5,r1       ; r5 = pointer to message
5030
PRMESG1:
5031
        add             r5,r5,#1
5032
        lb              r1,-1[r5]       ;       get the char.
5033
        beq             r1,r0,PRMRET
5034
        call    GOOUT           ;else display it trashes r4
5035
        bra             PRMESG1
5036
PRMRET:
5037
        mov             r1,r5
5038
        lw              lr,8[sp]
5039
        lw              r5,[sp]
5040
        ret             #16
5041
 
5042
 
5043
; ===== Display a zero-ended string pointed to by register r1
5044
; Registers Affected
5045
;   r1,r2,r3
5046
;
5047
PRMESGAUX:
5048
        subui   sp,sp,#16
5049
        sw              r5,[sp]
5050
        sw              lr,8[sp]
5051
        mov     r5,r1       ; r3 = pointer
5052
PRMESGA1:
5053
        addui   r5,r5,#1
5054
        lb              r1,-1[r5]       ;       get the char.
5055
        beq             r1,r0,PRMRETA
5056
        call    GOAUXO          ;else display it
5057
        bra             PRMESGA1
5058
PRMRETA:
5059
        mov             r1,r5
5060
        lw              lr,8[sp]
5061
        lw              r5,[sp]
5062
        ret             #16
5063
 
5064
;*****************************************************
5065
; The following routines are the only ones that need *
5066
; to be changed for a different I/O environment.     *
5067
;*****************************************************
5068
 
5069
 
5070
; ===== Output character to the console (Port 1) from register r1
5071
;       (Preserves all registers.)
5072
;
5073
OUTC:
5074
        jmp             DisplayChar
5075
 
5076
 
5077
; ===== Input a character from the console into register D0 (or
5078
;       return Zero status if there's no character available).
5079
;
5080
INC:
5081
        jmp             KeybdGetChar
5082
 
5083
 
5084
;*
5085
;* ===== Input a character from the host into register r1 (or
5086 27 robfinch
;*      return Zero status if there's no character available).
5087
;*
5088
AUXIN:
5089 43 robfinch
        call    SerialGetChar
5090
        beqi    r1,#-1,AXIRET_ZERO
5091 27 robfinch
        andi    r1,r1,#0x7f             ;zero out the high bit
5092
AXIRET:
5093
        ret
5094 43 robfinch
AXIRET_ZERO:
5095
        xor             r1,r1,r1
5096
        ret
5097 27 robfinch
 
5098 43 robfinch
; ===== Output character to the host (Port 2) from register r1
5099
;       (Preserves all registers.)
5100
;
5101
AUXOUT
5102
        jmp             SerialPutChar   ; call boot rom routine
5103
 
5104
 
5105
_cls
5106
        call    clearScreen
5107
        bra             FINISH
5108
 
5109
_wait10
5110
        ret
5111
_getATAStatus
5112
        ret
5113
_waitCFNotBusy
5114
        ret
5115
_rdcf
5116
        br              FINISH
5117
rdcf6
5118
        br              ERROR
5119
 
5120
 
5121
; ===== Return to the resident monitor, operating system, etc.
5122
;
5123 27 robfinch
BYEBYE:
5124 43 robfinch
        lw              sp,OSSP
5125
    lw      lr,[sp]
5126
        ret             #8
5127
 
5128
;       MOVE.B  #228,D7         return to Tutor
5129 27 robfinch
;       TRAP    #14
5130
 
5131 43 robfinch
        .align  16
5132 27 robfinch
msgInit db      CR,LF,"Raptor64 Tiny BASIC v1.0",CR,LF,"(C) 2012  Robert Finch",CR,LF,LF,0
5133
OKMSG   db      CR,LF,"OK",CR,LF,0
5134
msgWhat db      "What?",CR,LF,0
5135
SRYMSG  db      "Sorry."
5136
CLMSG   db      CR,LF,0
5137
msgReadError    db      "Compact FLASH read error",CR,LF,0
5138
msgNumTooBig    db      "Number is too big",CR,LF,0
5139
msgDivZero              db      "Division by zero",CR,LF,0
5140
msgVarSpace     db  "Out of variable space",CR,LF,0
5141
msgBytesFree    db      " bytes free",CR,LF,0
5142
msgReady                db      CR,LF,"Ready",CR,LF,0
5143
msgComma                db      "Expecting a comma",CR,LF,0
5144
msgLineRange    db      "Line number too big",CR,LF,0
5145
msgVar                  db      "Expecting a variable",CR,LF,0
5146
msgRNDBad               db      "RND bad parameter",CR,LF,0
5147
msgSYSBad               db      "SYS bad address",CR,LF,0
5148
msgInputVar             db      "INPUT expecting a variable",CR,LF,0
5149
msgNextFor              db      "NEXT without FOR",CR,LF,0
5150
msgNextVar              db      "NEXT expecting a defined variable",CR,LF,0
5151
msgBadGotoGosub db      "GOTO/GOSUB bad line number",CR,LF,0
5152
msgRetWoGosub   db      "RETURN without GOSUB",CR,LF,0
5153
msgTooBig               db      "Program is too big",CR,LF,0
5154
msgExtraChars   db      "Extra characters on line ignored",CR,LF,0
5155
 
5156 43 robfinch
        align   8
5157
LSTROM  equ     *               ; end of possible ROM area
5158
;       END
5159 27 robfinch
 
5160 43 robfinch
;*
5161
;* ===== Return to the resident monitor, operating system, etc.
5162
;*
5163
BYEBYE:
5164
        jmp             Monitor
5165
;    MOVE.B     #228,D7         ;return to Tutor
5166
;       TRAP    #14
5167 27 robfinch
 
5168
;==============================================================================
5169 10 robfinch
; Checkerboard RAM tester
5170
;==============================================================================
5171
;
5172 27 robfinch
        code
5173
        align   16
5174 10 robfinch
ramtest:
5175
        or              r8,r0,r0                ; r8 = 0
5176
        ori             r1,r0,#0xAAAA5555AAAA5555       ; checkerboard pattern
5177
ramtest2:
5178
        sw              r1,[r8]                 ; save the checkerboard to memory
5179
        lw              r2,[r8]                 ; read it back
5180
        cmp             r3,r1,r2                ; is it the same ?
5181 27 robfinch
        bne     r3,r0,ramtest1
5182
        addui   r8,r8,#8                ; increment RAM pointer
5183
        cmpi    r3,r8,#0x0000_0000_0400_0000
5184
        blt             r3,r0,ramtest2
5185 10 robfinch
ramtest1:
5186
        or              r10,r8,r0               ; r10 = max ram address
5187
        ; readback the checkerboard pattern
5188
        or              r8,r0,r0                ; r8 = 0
5189
ramtest4:
5190
        lw              r2,[r8]
5191
        cmpi    r3,r2,#0xAAAA5555AAAA5555
5192 27 robfinch
        bne             r3,r0,ramtest3
5193 10 robfinch
        addi    r8,r8,#8
5194
        cmpi    r3,r8,#0x0000_0000_0100_0000
5195 27 robfinch
        blt     r3,r0,ramtest4
5196 10 robfinch
ramtest3:
5197
        bne             r8,r10,ramtest8 ; check for equal maximum address
5198
 
5199
        ; perform ramtest again with inverted checkerboard
5200
        or              r8,r0,r0                ; r8 = 0
5201
        ori             r1,r0,#0x5555AAAA5555AAAA
5202
ramtest5:
5203
        sw              r1,[r8]
5204
        lw              r2,[r8]
5205
        cmp             r3,r1,r2
5206 27 robfinch
        bne             r3,r0,ramtest6
5207 10 robfinch
        addi    r8,r8,#8
5208
        cmpi    r3,r8,#0x0000_0000_0100_0000
5209 27 robfinch
        blt             r3,r0,ramtest5
5210 10 robfinch
ramtest6:
5211
        or              r11,r8,r0               ; r11 = max ram address
5212
        ; readback checkerboard
5213
        or              r8,r0,r0
5214
ramtest7:
5215
        lw              r2,[r8]
5216
        cmpi    r3,r2,#0x5555AAAA5555AAAA
5217 27 robfinch
        bne             r3,r0,ramtest8
5218 10 robfinch
        addi    r8,r8,#8
5219
        cmpi    r3,r8,#0x0000_0000_0100_0000
5220 27 robfinch
        blt             r3,r0,ramtest7
5221 10 robfinch
ramtest8:
5222
        beq             r8,r11,ramtest9
5223
        min             r8,r8,r11
5224
ramtest9:
5225
        beq             r8,r10,ramtest10
5226
        min             r8,r8,r10
5227
ramtest10:
5228
        sw              r8,0x00000400   ;memend
5229 27 robfinch
        ret
5230
 
5231
;-------------------------------------------
5232 43 robfinch
;-------------------------------------------
5233
;
5234
iberr_rout:
5235
        lea             r1,msgiberr
5236
        call    DisplayString
5237
        mfspr   r1,EPC
5238
        call    DisplayWord
5239
        wait
5240
        jmp             start
5241
dberr_rout:
5242
        lea             r1,msgdberr
5243
        call    DisplayString
5244
        mfspr   r1,ERRADR
5245
        call    DisplayWord
5246
        lea             r1,msgEPC
5247
        call    DisplayString
5248
        mfspr   r1,EPC
5249
        call    DisplayWord
5250
        call    CRLF
5251
        lw              r2,#31
5252
dberr1:
5253
        mtspr   PCHI,r2
5254
        nop
5255
        nop
5256
        nop
5257
        mfspr   r1,PCHISTORIC
5258
        call    DisplayWord
5259
        call    CRLF
5260
        loop    r2,dberr1
5261
        wait
5262
        jmp             start
5263
        .align  16
5264
msgdberr:
5265
        db      "Data bus error at: ",0
5266
msgEPC:
5267
        db      " EPC: ",0
5268
msgiberr:
5269
        db      "Err fetching instruction at: ",0
5270
        .align  16
5271
 
5272
;------------------------------------------------------------------------------
5273 27 robfinch
; IRQ routine
5274 43 robfinch
;------------------------------------------------------------------------------
5275
;
5276 27 robfinch
irqrout:
5277 43 robfinch
        subui   sp,sp,#32
5278
        sw              r1,[sp]                                 ; save off a working register
5279
        sw              r2,8[sp]                                ; and a second work register
5280
        sw              r26,16[sp]                              ; save off implicit constant builder reg
5281
        sw              lr,24[sp]
5282
        inch    r1,PIC                                  ; r1= which IRQ line is active
5283
 
5284
; 1000 Hz interrupt
5285
; This IRQ must be fast, so it's placed inline
5286
; Increments the millisecond counter, and switches to the next context
5287
;
5288
irq1000Hz:
5289
        bnei    r1,#2,irq100Hz
5290
        outb    r0,0xFFFFFFFF_FFFF0000  ; acknowledge interrupt
5291
        lw              r1,Milliseconds                 ; increment milliseconds count
5292
        addui   r1,r1,#1
5293
        sw              r1,Milliseconds
5294
        lea             r2,TEXTSCR
5295
        inch    r1,332[r2]
5296
        addui   r1,r1,#1
5297
        outc    r1,332[r2]
5298
        lw              lr,24[sp]
5299
        lw              r26,16[sp]                              ; restore registers from stack
5300
        lw              r2,8[sp]
5301
        lw              r1,[sp]
5302
        addui   sp,sp,#32                               ; restore stack pointer
5303
        iepp                                                    ; move to the next context
5304
        nop
5305
        nop
5306
        nop
5307
        iret                                                    ; return to the next context
5308
 
5309
; 100 Hz interrupt
5310
; This IRQ could have some work to do, including flashing a cursor. So
5311
; we call a subroutine.
5312
;
5313
irq100Hz:
5314
        bnei    r1,#3,irqSerial
5315
        lw              r1,p100IRQvec
5316
;       jal             lr,[r1]
5317
        call    Pulse100
5318
        bra             irqret
5319
 
5320
irqSerial:
5321
        bnei    r1,#8,irqRaster
5322
        lw              r1,serialIRQvec
5323
        jal             lr,[r1]
5324
        bra             irqret
5325
 
5326
irqRaster:
5327
        bnei    r1,#13,irqKeybd
5328
        lw              r1,rasterIRQvec
5329
;       jal             lr,[r1]
5330
        call    RasterIRQfn
5331
        bra             irqret
5332
 
5333
irqKeybd:
5334
        beqi    r1,#1,ColdStart                 ; CTRL-ALT-DEL interrupt
5335
        bnei    r1,#15,irqret
5336
        lw              r1,keybdIRQvec
5337 27 robfinch
        call    KeybdIRQ
5338 43 robfinch
;       jal             lr,[r1]
5339
 
5340
irqret:
5341
        lw              lr,24[sp]
5342
        lw              r26,16[sp]                              ; restore registers from stack
5343
        lw              r2,8[sp]
5344
        lw              r1,[sp]
5345
        addui   sp,sp,#32                               ; restore stack pointer
5346 27 robfinch
        iret
5347
 
5348
;-------------------------------------------
5349
; NMI routine
5350
;-------------------------------------------
5351
nmirout:
5352
        iret
5353
 
5354
;-------------------------------------------
5355
; Handle miss on Data TLB
5356
;-------------------------------------------
5357
DTLBHandler:
5358
        sw              r1,0xFFFF_FFFF_FFFF_0000
5359
        sw              r2,0xFFFF_FFFF_FFFF_0008
5360
dh1:
5361
        omgi    r1,#0            ; try open mutex gate #0 (TLB protector)
5362
        bne             r1,r0,dh1       ; spinlock if gate is closed
5363
        mfspr   r1,PTA          ; get the page table address
5364
        mfspr   r2,BadVAddr     ; get the bad virtual address
5365
        mtspr   TLBVirtPage,r2  ; which virtual address to update
5366
        shrui   r2,r2,#13       ; turn va into index
5367
        addu    r1,r1,r2
5368
        lw              r2,[r1]         ; get the physical address from the table
5369
        and             r2,r2,#FFFF_FFFF_FFFF_E000      ; mask off lower bits
5370
        mtspr   TLBPhysPage0,r2 ;
5371
        lw              r2,8[r1]        ; get the physical address from the table
5372
        and             r2,r2,#FFFF_FFFF_FFFF_E000      ; mask off lower bits
5373
        mtspr   TLBPhysPage1,r2 ;
5374
        tlbwr                           ; update a random entry in the TLB
5375
        cmgi    #0                       ; close the mutex gate
5376
        lw              r1,0xFFFF_FFFF_FFFF_0000
5377
        lw              r2,0xFFFF_FFFF_FFFF_0008
5378
        iret
5379 43 robfinch
        .align  32
5380
 
5381 27 robfinch
        org             0xFFFF_FFFF_FFFF_FFB0
5382
        jmp             DTLBHandler
5383 10 robfinch
        nop
5384
        nop
5385 27 robfinch
        org             0xFFFF_FFFF_FFFF_FFC0
5386
        jmp             DTLBHandler
5387 10 robfinch
        nop
5388
        nop
5389 43 robfinch
 
5390
        ; NMI vector
5391 27 robfinch
        org     0xFFFF_FFFF_FFFF_FFE0
5392
        jmp             nmirout
5393 10 robfinch
        nop
5394
        nop
5395 43 robfinch
 
5396
        ; RST vector
5397 10 robfinch
        org             0xFFFF_FFFF_FFFF_FFF0
5398
        jmp             start
5399 27 robfinch
        nop
5400
        nop
5401
 
5402
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.