forked from rachel8973/RC2014-FORTH
-
Notifications
You must be signed in to change notification settings - Fork 0
/
forth.asm
4659 lines (4342 loc) · 118 KB
/
forth.asm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;------------------------------------------------------------------------------
; FORTH - V0
;------------------------------------------------------------------------------
;
; This is not my source. I did not write this I only made it work on the
; RC2014 so I would have something the mess around with.
;
; I found a simple FORTH buried in a ZIP file on the Z80 info site at ...
; http://www.z80.info/zip/z80asm.zip
;
; V0 - Included the source from Grant Searles simple 7 chip Z80 computer
; from here http://searle.hostei.com/grant/
; Modified the CHR_RD and CHR_WR to use the routines from INT32K.ROM
; Added a def so I can build as a ROM or RAM
; A few renames so I could build it with TASM.
;
;------------------------------------------------------------------------------
;------------------------------------------------------------------------------
; This is an implementation of FORTH for the Z80 that should be easily portable
; to other Z80 systems. It assumes RAM from 9000h to 0FFFFh and a UART for
; communication with the host or VDU.
DATA_STACK: .EQU 0FD80h ;Data stack grows down
VOCAB_BASE: .EQU 0F000h ;Dictionary grows up from here
MASS_STORE: .EQU 0FEA0h ;Mass storage buffer (default)
DISK_START: .EQU 0A000h ;Pseudo disk buffer start
DISK_END: .EQU 0F000h ;Pseudo disk buffer end
BLOCK_SIZE: .EQU 0200h ;Pseudo disk block size
BUFFERS: .EQU 0001h ;Pseudo disk buffers per block
MAX_DISK_BLOCKS = (DISK_END-DISK_START)/BLOCK_SIZE
; Start of FORTH code
.section .cold
JP X_COLD
.section .warm
JP C_WARM
BACKSPACE:
.WORD 0008h ;Backspace chr
WORD1:
.WORD DATA_STACK
DEF_SYSADDR:
.WORD SYSTEM
.WORD DATA_STACK
.WORD 001Fh ;Word name length (default 31)
.WORD 0000h ;Error message control number
.WORD VOCAB_BASE ;FORGET protection
.WORD VOCAB_BASE+0Bh ;Dictionary pointer
.WORD E_FORTH ;Most recently created vocab.
START_TABLE:
.BYTE 81h,0A0h
.WORD VOCAB_BASE
.BYTE 00h,00h ;FLAST
.BYTE 81h,0A0h
.WORD W_EDITI
.WORD E_FORTH ;ELAST
.BYTE 00h ;CRFLAG
.BYTE 00h ;Free
IN A,(00h) ;I/O Port input
RET ;routine
OUT (00h),A ;I/O Port output
RET ;routine
.WORD SYSTEM ;Return stack pointer
.WORD MASS_STORE ;Mass storage buffer to use
.WORD MASS_STORE ;Storage buffer just used
.BYTE 00h ;Interrupt flag
.BYTE 00h ;Free
.WORD C_ABORT ;Interrupt vector
.WORD CF_UQTERMINAL ;C field address ?TERMINAL
.WORD CF_UKEY ;C field address KEY
.WORD CF_UEMIT ;C field address EMIT
.WORD CF_UCR ;C field address CR
.WORD CF_URW ;C field address R/W
.WORD CF_UABORT ;C field address ABORT
.WORD 0020h ;CHRs per input line
.WORD DISK_START ;Pseudo disk buf start
.WORD DISK_END ;Pseudo disk buf end
.WORD BLOCK_SIZE ;Bytes per block
.WORD BUFFERS ;Buffers per block
NEXTS2:
PUSH DE
NEXTS1:
PUSH HL
NEXT:
LD A,(INTFLAG) ;Interrupt flag
BIT 7,A ;Check for interrupt
JR Z,NOINT ;No interrupt
BIT 6,A ;Interrupt enabled ?
JR NZ,NOINT ;No interrupt
LD HL,(INTVECT) ;Get nterrupt vector
LD A,40h ;Clear flag byte
LD (INTFLAG),A ;Interrupt flag into HL
JR NEXTADDR ;JP (HL)
NOINT:
LD A,(BC) ;effectively LD HL,(BC)
INC BC ;
LD L,A ;
LD A,(BC) ;
INC BC ;BC now points to next vector
LD H,A ;HL has addr vector
NEXTADDR:
LD E,(HL) ;effectively LD HL,(HL)
INC HL ;
LD D,(HL) ;
EX DE,HL ;
JP (HL) ;Jump to it
W_LIT: ;Puts next 2 bytes on the stack
.BYTE 83h
.ascii "LI"
.byte 'T'+80h
.WORD 0000h ;First word in vocabulary
C_LIT:
.WORD 2+$ ;Vector to code
LD A,(BC) ;Gets next word from (BC)
INC BC ;then increments BC to point
LD L,A ;to the next addr. Pushes the
LD A,(BC) ;result onto the stack.
INC BC ;
LD H,A ;
JP NEXTS1 ;Save & NEXT
W_EXECUTE: ;Jump to address on stack
.BYTE 87h
.ascii "EXECUT"
.byte 'E'+80h
.WORD W_LIT
C_EXECUTE:
.WORD 2+$ ;Vector to code
POP HL ;Get addr off data stack
JP NEXTADDR ;Basically JP (HL)
W_BRANCH: ;Add following offset to BC
.BYTE 86h
.ascii "BRANC"
.byte 'H'+80h
.WORD W_EXECUTE
C_BRANCH:
.WORD 2+$ ;Vector to code
X_BRANCH:
LD H,B ;Next pointer into HL
LD L,C ;
LD E,(HL) ;Get word offset LD DE,(HL)
INC HL ;Incr to point at next byte
LD D,(HL) ;
DEC HL ;Restore HL
ADD HL,DE ;Calculate new address
LD C,L ;Put it in BC
LD B,H ;
JP NEXT ;Go do it
W_0BRANCH: ;Add offset to BC if stack top = 0
.BYTE 87h
.ascii "0BRANC"
.byte 'H'+80h ;Conditional branch
.WORD W_BRANCH
C_0BRANCH:
.WORD 2+$ ;Vector to code
POP HL ;Get value off stack
LD A,L ;Set flags
OR H ;
JR Z,X_BRANCH ;If zero then do the branch
INC BC ;Else dump branch address
INC BC ;
JP NEXT ;Continue execution
W_LLOOP: ;Increment loop & branch if not done
.BYTE 86h
.ascii "<LOOP"
.byte '>'+80h
.WORD W_0BRANCH
C_LLOOP:
.WORD 2+$ ;Vector to code
LD DE,0001
C_ILOOP:
LD HL,(RPP) ;Get return stack pointer
LD A,(HL) ;Add DE to value on return stack
ADD A,E ;
LD (HL),A ;
LD E,A ;
INC HL ;
LD A,(HL) ;
ADC A,D ;
LD (HL),A ;
INC HL ;HL now points to limit value
INC D ;Get DS sign bit
DEC D ;
LD D,A ;Result now in DE
JP M,DECR_LOOP ;Decrement loop so check > limit
;otherwies check < limit
LD A,E ;Low byte back
SUB (HL) ;Subtract limit low
LD A,D ;High byte back
INC HL ;Point to limit high
SBC A,(HL) ;Subtract it
JR TEST_LIMIT ;
DECR_LOOP:
LD A,(HL) ;Get limit low
SUB E ;Subtract index low
INC HL ;Point to limit high
LD A,(HL) ;Get it
SBC A,D ;Subtract index high
TEST_LIMIT:
JP M,X_BRANCH ;Not reached limit so jump
INC HL ;Drop index & limit from return stack
LD (RPP),HL ;Save stack pointer
INC BC ;Skip branch offset
INC BC ;
JP NEXT
W_PLOOP: ;Loop + stack & branch if not done
.BYTE 87h
.ascii "<+LOOP"
.byte '>'+80h
.WORD W_LLOOP
C_PLOOP:
.WORD 2+$ ;Vector to code
POP DE ;Get value from stack
JR C_ILOOP ;Go do loop increment
W_LDO: ;Put start & end loop values on RPP
.BYTE 84h
.ascii "<DO"
.byte '>'+80h
.WORD W_PLOOP
C_LDO:
.WORD 2+$
LD HL,(RPP) ;Get return stack pointer
DEC HL ;Add space for two values
DEC HL ;
DEC HL ;
DEC HL ;
LD (RPP),HL ;Save new stack pointer
POP DE ;Get start value &
LD (HL),E ;put on return stack top
INC HL ;
LD (HL),D ;
INC HL ;
POP DE ;Get end value &
LD (HL),E ;put on return stack - 1
INC HL ;
LD (HL),D ;
JP NEXT
W_I: ;Copy LOOP index to data stack
.BYTE 81h,'I'+80h
.WORD W_LDO
C_I:
.WORD 2+$
X_I:
LD HL,(RPP) ;Get return stack pointer
X_I2:
LD E,(HL) ;Get LOOP index off return stack
INC HL ;
LD D,(HL) ;
PUSH DE ;Push onto data stack
JP NEXT
W_DIGIT: ;Convert digit n2 using base n1
.BYTE 85h
.ascii "DIGI"
.byte 'T'+80h
.WORD W_I
C_DIGIT:
.WORD 2+$
POP HL ;Get base to use
POP DE ;Get char
LD A,E ;A = char
SUB 30h ;Subtract 30h
JP M,NDIGIT ;
CP 0Ah ;Greater than 9 ?
JP M,LESS10 ;If not then skip
SUB 07h ;Convert 'A' to 10
CP 0Ah ;Is it 10?
JP M,NDIGIT ;If not an error occured
LESS10:
CP L ;L is 1 digit limit
JP P,NDIGIT ;Out of range for digit
LD E,A ;Result into DE
LD HL,0001 ;Leave TRUE flag
JP NEXTS2 ;Save both & NEXT
NDIGIT:
LD L,H ;Leave FALSE flag
JP NEXTS1 ;Save & NEXT
W_FIND: ;Find word & return vector,byte & flag
.BYTE 86h
.ascii "<FIND"
.byte '>'+80h
.WORD W_DIGIT
C_FIND:
.WORD 2+$ ;Vector to code
POP DE ;Get pointer to next vocabulary word
COMPARE:
POP HL ;Copy pointer to word we're looking 4
PUSH HL ;
LD A,(DE) ;Get 1st vocabulary word letter
XOR (HL) ;Compare with what we've got
AND 3Fh ;Ignore start flag
JR NZ,NOT_END_CHR ;No match so skip to next word
MATCH_NO_END:
INC HL ;Compare next chr
INC DE ;
LD A,(DE) ;
XOR (HL) ;
ADD A,A ;Move bit 7 to C flag
JR NZ,NO_MATCH ;No match jump
JR NC,MATCH_NO_END ;Match & not last, so next chr
LD HL,0005 ;Offset to start of code
ADD HL,DE ;HL now points to code start for word
EX (SP),HL ;Swap with value on stack
NOT_WORD_BYTE:
DEC DE ;Search back for word type byte
LD A,(DE) ;
OR A ;
JP P,NOT_WORD_BYTE ;Not yet so loop
LD E,A ;Byte into DE
LD D,00 ;
LD HL,0001 ;Leave TRUE flag
JP NEXTS2 ;Save both & NEXT
NO_MATCH:
JR C,END_CHR ;If last chr then jump
NOT_END_CHR:
INC DE ;Next chr of this vocab word
LD A,(DE) ;Get it
OR A ;Set flags
JP P,NOT_END_CHR ;Loop if not end chr
END_CHR:
INC DE ;Now points to next word vector
EX DE,HL ;Swap
LD E,(HL) ;Vector into DE
INC HL ;
LD D,(HL) ;
LD A,D ;Check it's not last (first) word
OR E ;
JR NZ,COMPARE ;No error so loop
POP HL ;Dump pointer
LD HL,0000 ;Flag error
JP NEXTS1 ;Save & NEXT
W_ENCLOSE:
.BYTE 87h
.ascii "ENCLOS"
.byte 'E'+80h
.WORD W_FIND
C_ENCLOSE:
.WORD 2+$ ;Vector to code
POP DE ; get delimiter character
POP HL ; get address 1
PUSH HL ; duplicate it
LD A,E ; delimiter char into A
LD D,A ; copy to D
LD E,00FFh ; -1 for offset
DEC HL ; to allow for first INCR
J21E6:
INC HL ; point to next chr
INC E ; next offset
CP (HL) ; compare chr with (address)
JR Z,J21E6 ; loop if = delimiter chr
LD A,0Dh ; else set CR
CP (HL) ; compare with (address)
LD A,D ; restore delimiter chr
JR Z,J21E6 ; loop if it was = CR
LD D,00h ; zero high byte
PUSH DE ; save offset
LD D,A ; restore delimiter chr
LD A,(HL) ; get byte from address
AND A ; set the flags
JR NZ,J2202 ; branch if not null
LD D,00h ; clear high byte
INC E ; point to next addr
PUSH DE ; save address
DEC E ; point to end
PUSH DE ; push address
JP NEXT ; done
J2202:
LD A,D ; restore delimiter chr
INC HL ; increment address
INC E ; increment offset
CP (HL) ; compare delimiter with (address)
JR Z,J2218 ; jump if =
LD A,0Dh ; else get CR
CP (HL) ; compare with (address)
JR Z,J2218 ; jump if =
LD A,(HL) ; else get byte
AND A ; set the flags
JR NZ,J2202 ; loop if not null
LD D,00h ; clear gigh byte
PUSH DE ; save address
PUSH DE ; save address
JP NEXT ; done
J2218:
LD D,00h ; clear high byte
PUSH DE ; save address
INC E ; increment offset
PUSH DE ; save address
JP NEXT ; done
W_EMIT: ;Output CHR from stack
.BYTE 84h
.ascii "EMI"
.byte 'T'+80h
.WORD W_ENCLOSE
C_EMIT:
.WORD E_COLON ;Interpret following word sequence
.WORD C_UEMIT ;Put UEMIT addr on stack
.WORD C_FETCH ;Get UEMIT code field address
.WORD C_EXECUTE ;Jump to address on stack
.WORD C_1
.WORD C_OUT
.WORD C_PLUSSTORE
.WORD C_STOP ;Pop BC from return stack (=next)
W_KEY: ;Wait for key, value on stack
.BYTE 83h
.ascii "KE"
.byte 'Y'+80h
.WORD W_EMIT
C_KEY:
.WORD 2+$ ;Vector to code
LD HL,(UKEY) ;Get the vector
JP (HL) ;Jump to it
W_TERMINAL:
.BYTE 89h
.ascii "?TERMINA"
.byte 'L'+80h
.WORD W_KEY
C_TERMINAL:
.WORD E_COLON ;Interpret following word sequence
.WORD C_UTERMINAL
.WORD C_FETCH ;Get word from addr on stack
.WORD C_EXECUTE ;Jump to address on stack
.WORD C_STOP ;Pop BC from return stack (=next)
W_CR: ;Output [CR][LF]
.BYTE 82h,'C','R'+80h
.WORD W_TERMINAL
C_CR:
.WORD E_COLON ;Interpret following word sequence
.WORD C_UCR ;Push UCR addr
.WORD C_FETCH ;Get UCR code field addr
.WORD C_EXECUTE ;Jump to address on stack
.WORD C_STOP ;Pop BC from return stack (=next)
W_CLS: ;Clear screen
.BYTE 83h
.ascii "CL"
.byte 'S'+80h
.WORD W_CR
C_CLS:
.WORD E_COLON ;Interpret following word sequence
.WORD C_LIT ;Put clear screen code on stack
.WORD 000Ch ;
.WORD C_EMIT ;Output it
.WORD C_STOP ;Pop BC from return stack (=next)
W_CMOVE: ;Move block
.BYTE 85h
.ascii "CMOV"
.byte 'E'+80h
.WORD W_CLS
C_CMOVE:
.WORD 2+$ ;Vector to code
LD L,C ;Save BC for now
LD H,B ;
POP BC ;Get no. of bytes to move
POP DE ;Get destination address
EX (SP),HL ;Get source address
LD A,B ;Check it's not a 0 length block
OR C ;
JR Z,NO_BYTES ;If 0 length then do nothing
LDIR ;Move block
NO_BYTES:
POP BC ;Get BC back
JP NEXT
W_USTAR: ;Unsigned multiply
.BYTE 82h,'U','*'+80h
.WORD W_CMOVE
C_USTAR:
.WORD 2+$ ;Vector to code
POP DE ; get n2
POP HL ; get n1
PUSH BC ; save BC for now
LD C,H ; save H
LD A,L ; low byte to multiply by
CALL HALF_TIMES ; HL = A * DE
PUSH HL ; save partial result
LD H,A ; clear H
LD A,C ; high byte to multiply by
LD C,H ; clear B
CALL HALF_TIMES ; HL = A * DE
POP DE ; get last partial result
LD B,C ; add partial results
LD C,D ; add partial results
ADD HL,BC ;
ADC A,00h ;
LD D,L ;
LD L,H ;
LD H,A ;
POP BC ; get BC back
JP NEXTS2 ; save 32 bit result & NEXT
HALF_TIMES: ;
LD HL,0000h ; clear partial result
LD B,08h ; eight bits to do
NEXT_BIT:
ADD HL,HL ; result * 2
RLA ; multiply bit into C
JR NC,NO_MUL ; branch if no multiply
ADD HL,DE ; add multiplicand
ADC A,00h ; add in any carry
NO_MUL:
DJNZ NEXT_BIT ; decr and loop if not done
RET ;
W_UMOD: ;Unsigned divide & MOD
.BYTE 85h
.ascii "U/MO"
.byte 'D'+80h
.WORD W_USTAR
C_UMOD:
.WORD 2+$ ;Vector to code
LD HL,0004
ADD HL,SP
LD E,(HL)
LD (HL),C
INC HL
LD D,(HL)
LD (HL),B
POP BC
POP HL
LD A,L
SUB C
LD A,H
SBC A,B
JR C,J22.BYTE
LD HL,0FFFFh
LD DE,0FFFFh
JR J2301
J22.BYTE:
LD A,10h
J22DD:
ADD HL,HL
RLA
EX DE,HL
ADD HL,HL
JR NC,J22E5
INC DE
AND A
J22E5:
EX DE,HL
RRA
PUSH AF
JR NC,J22F2
LD A,L
SUB C
LD L,A
LD A,H
SBC A,B
LD H,A
JR J22FC
J22F2:
LD A,L
SUB C
LD L,A
LD A,H
SBC A,B
LD H,A
JR NC,J22FC
ADD HL,BC
DEC DE
J22FC:
INC DE
POP AF
DEC A
JR NZ,J22DD
J2301:
POP BC
PUSH HL
PUSH DE
JP NEXT
W_AND: ;AND
.BYTE 83h
.ascii "AN"
.byte 'D'+80h
.WORD W_UMOD
C_AND:
.WORD 2+$ ;Vector to code
POP DE ;Get n1 off stack
POP HL ;Get n2 off stack
LD A,E ;AND lo bytes
AND L ;
LD L,A ;Result in L
LD A,D ;AND hi bytes
AND H ;
LD H,A ;Result in H
JP NEXTS1 ;Save & next
W_OR: ;OR
.BYTE 82h,'O','R'+80h
.WORD W_AND
C_OR:
.WORD 2+$ ;Vector to code
POP DE ;Get n1 off stack
POP HL ;Get n2 off stack
LD A,E ;OR lo bytes
OR L ;
LD L,A ;Result in L
LD A,D ;OR hi bytes
OR H ;
LD H,A ;Result in H
JP NEXTS1 ;Save & next
W_XOR: ;XOR
.BYTE 83h
.ascii "XO"
.byte 'R'+80h
.WORD W_OR
C_XOR:
.WORD 2+$ ;Vector to code
POP DE ;Get n1 off stack
POP HL ;Get n2 off stack
LD A,E ;XOR lo bytes
XOR L ;
LD L,A ;Result in L
LD A,D ;XOR hi bytes
XOR H ;
LD H,A ;Result in H
JP NEXTS1 ;Save & NEXT
W_SPFETCH: ;Stack pointer onto stack
.BYTE 83h
.ASCII "SP"
.BYTE '@'+80h
.WORD W_XOR
C_SPFETCH:
.WORD 2+$ ;Vector to code
LD HL,0000 ;No offset
ADD HL,SP ;Add SP to HL
JP NEXTS1 ;Save & NEXT
W_SPSTORE: ;Set initial stack pointer value
.BYTE 83h
.ASCII "SP"
.BYTE '!'+80h
.WORD W_SPFETCH
C_SPSTORE:
.WORD 2+$ ;Vector to code
LD HL,(DEF_SYSADDR) ;Get system base addr
LD DE,S0-SYSTEM ;Offset to stack pointer value (0006)
ADD HL,DE ;Add to base addr
LD E,(HL) ;Get SP from ram
INC HL ;
LD D,(HL) ;
EX DE,HL ;Put into HL
LD SP,HL ;Set SP
JP NEXT
W_RPFETCH: ;Get return stack pointer
.BYTE 83h
.ascii "RP"
.byte '@'+80h
.WORD W_SPSTORE
C_RPFETCH:
.WORD 2+$ ;Vector to code
LD HL,(RPP) ;Return stack pointer into HL
JP NEXTS1 ;Save & NEXT
W_RPSTORE: ;Set initial return stack pointer
.BYTE 83h
.ascii "RP"
.byte '!'+80h
.WORD W_RPFETCH
C_RPSTORE:
.WORD 2+$ ;Vector to code
LD HL,(DEF_SYSADDR) ;Get system base addr
LD DE,0008 ;Offset to return stack pointer value
ADD HL,DE ;Add to base addr
LD E,(HL) ;Get SP from ram
INC HL ;
LD D,(HL) ;
EX DE,HL ;Put into HL
LD (RPP),HL ;Set return SP
JP NEXT
W_STOP: ;Pop BC from return stack (=next)
.BYTE 82h,';','S'+80h
.WORD W_RPSTORE
C_STOP:
.WORD 2+$ ;Vector to code
X_STOP:
LD HL,(RPP) ;Return stack pointer to HL
LD C,(HL) ;Get low byte
INC HL ;
LD B,(HL) ;Get high byte
INC HL ;
LD (RPP),HL ;Save stack pointer
JP NEXT
W_LEAVE: ;Quit loop by making index = limit
.BYTE 85h
.ascii "LEAV"
.byte 'E'+80h
.WORD W_STOP
C_LEAVE:
.WORD 2+$ ;Vector to code
LD HL,(RPP) ;Get return stack pointer
LD E,(HL) ;Get loop limit low
INC HL ;
LD D,(HL) ;Get loop limit high
INC HL ;
LD (HL),E ;Set index low to loop limit
INC HL ;
LD (HL),D ;Set index high to loop limit
JP NEXT
W_MOVER: ;Move from data to return stack
.BYTE 82h,'>','R'+80h
.WORD W_LEAVE
C_MOVER:
.WORD 2+$ ;Vector to code
POP DE ;Get value
LD HL,(RPP) ;Get return stack pointer
DEC HL ;Set new value
DEC HL ;
LD (RPP),HL ;Save it
LD (HL),E ;Push low byte onto return stack
INC HL ;
LD (HL),D ;Push high byte onto return stack
JP NEXT
W_RMOVE: ;Move word from return to data stack
.BYTE 82h,'R','>'+80h
.WORD W_MOVER
C_RMOVE:
.WORD 2+$ ;Vector to code
LD HL,(RPP) ;Get return stack pointer
LD E,(HL) ;Pop word off return stack
INC HL ;
LD D,(HL) ;
INC HL ;
LD (RPP),HL ;Save new return stack pointer
PUSH DE ;Push on data stack
JP NEXT
W_RFETCH: ;Return stack top to data stack
.BYTE 82h,'R','@'+80h
.WORD W_RMOVE
C_RFETCH:
.WORD X_I ;Return stack top to data stack
W_0EQUALS: ;=0
.BYTE 82h,'0','='+80h
.WORD W_RFETCH
C_0EQUALS:
.WORD 2+$ ;Vector to code
X_0EQUALS:
POP HL ;Get value from stack
LD A,L ;set flags
OR H ;
LD HL,0000 ;Not = 0 flag
JR NZ,NO_ZERO ;
INC HL ;= 0 flag
NO_ZERO:
JP NEXTS1 ;Save & NEXT
W_NOT: ;Convert flag, same as 0=
.BYTE 83h
.ascii "NO"
.byte 'T'+80h
.WORD W_0EQUALS
C_NOT:
.WORD X_0EQUALS
W_0LESS: ;Less than 0
.BYTE 82h,'0','<'+80h
.WORD W_NOT
C_0LESS:
.WORD 2+$ ;Vector to code
POP HL ;Get value
ADD HL,HL ;S bit into C
LD HL,0000 ;Wasn't < 0 flag
JR NC,NOT_LT0 ;
INC HL ;Was < 0 flag
NOT_LT0: ;
JP NEXTS1 ;Save & NEXT
W_PLUS: ;n1 + n2
.BYTE 81h,'+'+80h
.WORD W_0LESS
C_PLUS:
.WORD 2+$ ;Vector to code
POP DE ;Get n2
POP HL ;Get n1
ADD HL,DE ;Add them
JP NEXTS1 ;Save & NEXT
W_DPLUS: ;32 bit add
.BYTE 82h,'D','+'+80h
.WORD W_PLUS
C_DPLUS:
.WORD 2+$ ;Vector to code
LD HL,0006 ; offset to low word
ADD HL,SP ; add stack pointer
LD E,(HL) ; get d1 low word low byte
LD (HL),C ; save BC low byte
INC HL ; point to high byte
LD D,(HL) ; get d1 low word high byte
LD (HL),B ; save BC high byte
POP BC ; get high word d2
POP HL ; get low word d2
ADD HL,DE ; add low wor.BLOCK
EX DE,HL ; save result low word in DE
POP HL ; get d1 high word
LD A,L ; copy d1 high word low byte
ADC A,C ; add d2 high word low byte
; + carry from low word add
LD L,A ; result from high word low byte into L
LD A,H ; copy d1 high word low byte
ADC A,B ; add d2 high word low byte
; + carry from high word low byte add
LD H,A ; result from high word high byte into H
POP BC ; restore BC
JP NEXTS2 ;Save 32 bit result & NEXT
W_NEGATE: ;Form 2s complement of n
.BYTE 86h
.ascii "NEGAT"
.byte 'E'+80h
.WORD W_DPLUS
C_NEGATE:
.WORD 2+$ ;Vector to code
POP HL ;Get number
LD A,L ;Low byte into A
CPL ;Complement it
LD L,A ;Back into L
LD A,H ;High byte into A
CPL ;Complement it
LD H,A ;Back into H
INC HL ;+1
JP NEXTS1 ;Save & NEXT
W_DNEGATE: ;Form 2s complement of 32 bit n
.BYTE 87h
.ascii "DNEGAT"
.byte 'E'+80h
.WORD W_NEGATE
C_DNEGATE:
.WORD 2+$ ;Vector to code
POP HL ; get high word
POP DE ; get low word
SUB A ; clear A
SUB E ; negate low word low byte
LD E,A ; copy back to E
LD A,00h ; clear A
SBC A,D ; negate low word high byte
LD D,A ; copy back to D
LD A,00h ; clear A
SBC A,L ; negate high word low byte
LD L,A ; copy back to L
LD A,00h ; clear A
SBC A,H ; negate high word high byte
LD H,A ; copy back to H
JP NEXTS2 ;Save 32 bit result & NEXT
W_OVER: ;Copy 2nd down to top of stack
.BYTE 84h
.ascii "OVE"
.byte 'R'+80h
.WORD W_DNEGATE
C_OVER:
.WORD 2+$ ;Vector to code
POP DE ;Get top
POP HL ;Get next
PUSH HL ;Save it back
JP NEXTS2 ;Save both & NEXT
W_DROP: ;Drop top value from stack
.BYTE 84h
.ascii "DRO"
.byte 'P'+80h
.WORD W_OVER
C_DROP:
.WORD 2+$ ;Vector to code
POP HL ;Get top value
JP NEXT
W_2DROP: ;Drop top two values from stack
.BYTE 85h
.ascii "2DRO"
.byte 'P'+80h
.WORD W_DROP
C_2DROP:
.WORD 2+$ ;Vector to code
POP HL ;Get top value
POP HL ;Get top value
JP NEXT
W_SWAP: ;Swap top 2 values on stack
.BYTE 84h
.ascii "SWA"
.byte 'P'+80h
.WORD W_2DROP
C_SWAP:
.WORD 2+$ ;Vector to code
POP HL ;Get top value
EX (SP),HL ;Exchanhe with next down
JP NEXTS1 ;Save & NEXT
W_DUP: ;Duplicate top value on stack
.BYTE 83h
.ascii "DU"
.byte 'P'+80h
.WORD W_SWAP
C_DUP:
.WORD 2+$ ;Vector to code
POP HL ;Get value off stack
PUSH HL ;Copy it back
JP NEXTS1 ;Save & NEXT
W_2DUP: ;Dup top 2 values on stack
.BYTE 84h
.ascii "2DU"
.byte 'P'+80h
.WORD W_DUP
C_2DUP:
.WORD 2+$ ;Vector to code
POP HL ;Get top two values from stack
POP DE ;
PUSH DE ;Copy them back
PUSH HL ;
JP NEXTS2 ;Save both & NEXT
W_BOUNDS: ;Convert address & n to start & end
.BYTE 86h
.ascii "BOUND"
.byte 'S'+80h
.WORD W_2DUP
C_BOUNDS:
.WORD 2+$ ;Vector to code
POP HL ; get n
POP DE ; get addr
ADD HL,DE ; add addr to n
EX DE,HL ; swap them
JP NEXTS2 ; save both & NEXT
W_PLUSSTORE: ;Add n1 to addr
.BYTE 82h,'+','!'+80h
.WORD W_BOUNDS
C_PLUSSTORE:
.WORD 2+$ ;Vector to code
POP HL ;Get addr
POP DE ;Get DE
LD A,(HL) ;Add low bytes
ADD A,E ;
LD (HL),A ;Store result
INC HL ;Point to high byte
LD A,(HL) ;Add high bytes
ADC A,D ;
LD (HL),A ;Store result
JP NEXT
W_TOGGLE: ;XOR (addr) with byte
.BYTE 86h
.ascii "TOGGL"
.byte 'E'+80h
.WORD W_PLUSSTORE
C_TOGGLE:
.WORD 2+$ ;Vector to code
POP DE ;Get byte
POP HL ;Get addr
LD A,(HL) ;Get byte from addr
XOR E ;Toggle it
LD (HL),A ;Save result
JP NEXT
W_FETCH: ;Get word from addr on stack
.BYTE 81h,'@'+80h
.WORD W_TOGGLE
C_FETCH:
.WORD 2+$ ;Vector to code
POP HL ;Get addr
LD E,(HL) ;Get low byte
INC HL ;
LD D,(HL) ;Get high byte
PUSH DE ;Save it