-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy path80ef202.asm
1639 lines (1633 loc) · 47.1 KB
/
80ef202.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
TITLE 80eF202
PAGE 62,132 ;62 lines per page, 132 characters per line
;===============================================================
; 80eF 2.02, C. H. Ting, 02/15/06
; ep8080, recreate 8080 proceesor, based on ep16
; Combine ZEF80 with 86eforth to test 8080 core
; Assembling 80ef202 with ep8080.bat
; c:\masm615\bin\ml /Fl 80EF202.asm >80EF202.err
; c:\masm615\bin\link 80EF202.obj
; Covert 80ef202.exe to .mem file used inDiammond IDE
; copy 80ef202.exe to \F#\F#MIDI
; Execute COMtoMEM.FEX
; MIDI @ 200 + 160 COMdump
; Copy mem dumo to \ep8080x\ep8080.mem
; Synthesize ram_memory with IPexpress
; Select EBR component/RAMDQ
; Enter file name ram_memoery, VHDL output
; Select 8192 bytes, no output latch
; Select Address Hex type, enter ep8080.mem file
; Select None for Bus Order Type
; Add ep8080.lpf to File List/LPF Constraint Files
; Define physical pin outs for ep80_chip
; Synthesize ep8080 modules in Diamond IDE
; ep80_chip.vhd
; ep80.vhd
; ram_memory.vhd
; uart80.vhd
; gpio80.vhd
; Select Export Files/VHDL Simulation File
; Click Process/Run All
; Select Simulation Wizard to simulate
; Select 10 MHz for aclk
; Select 1,0ns,0,200ns for arst
; Run 10ms to see message output on uart_o
; Select Export Files/JEDEC File
; Click Process/Run All
; Select Programming to burn FPGA
; Bring up HyperTerminal
; Set up 57600 baud, 8 data bits, 1 stop bit, no flow
; Press reset of Brevia2 kit
; eP8080 v2.2 will sign on
;
;===============================================================
; 86eForth 2.02, C. H. Ting, 06/03/99
; A sample session looks like:
; c>86ef202
; DOWNLOAD LESSONS.TXT
; WORDS
; ' THEORY 'BOOT !
; UPLOAD TEST.EXE
; BYE
; c>test
;
; 86eForth 2.01, C. H. Ting, 05/24/99
; Merge Zen2.asm with eForth 1.12
;1. Eliminate most of the @EXECUTE thru user variables
;2. Combine name and code dictionary
;3. Eliminate code pointer fields
;4. elimiate catch-throw
;5. eliminate most user variables
;6. extend top memory to FFF0H where the stacks and user area are.
;7. add open, close, read, write; improve BYE
;8 add 1+, 1-, 2/
;
;
; eForth 1.12, C. H. Ting, 03/30/99
; Change READ and LOAD to 'read' and 'load'.
; Make LOAD to read and compile a file. The file
; buffer is from CP+1000 to NP-100.
; To load all the lessons, type:
; LOAD LESSONS.TXT
; and you can test all the examples in this file.
; eForth 1.11, C. H. Ting, 03/25/99
; Change BYE to use function 4CH of INT 21H.
; Add read, write, open, close, READ, and LOAD
; To read a text file into memory:
; HEX 2000 1000 READ TEST.TXT
; READ returns the number of byte actually read.
; To compile the source code in the text file:
; 2000 FCD LOAD
; where FCD is the length returned by READ.
; These additions allow code for other eForth systems
; to be tested on PC first.
; It is part of the Firmware Engineering Workshop.
;
;
; eForth 1.0 by Bill Muench and C. H. Ting, 1990
; Much of the code is derived from the following sources:
; 8086 figForth by Thomas Newman, 1981 and Joe smith, 1983
; aFORTH by John Rible
; bFORTH by Bill Muench
;
; The goal of this implementation is to provide a simple eForth Model
; which can be ported easily to many 8, 16, 24 and 32 bit CPU's.
; The following attributes make it suitable for CPU's of the '90:
;
; small machine dependent kernel and portable high level code
; source code in the MASM format
; direct threaded code
; separated code and name dictionaries
; simple vectored terminal and file interface to host computer
; aligned with the proposed ANS Forth Standard
; easy upgrade path to optimize for specific CPU
;
; You are invited to implement this Model on your favorite CPU and
; contribute it to the eForth Library for public use. You may use
; a portable implementation to advertise more sophisticated and
; optimized version for commercial purposes. However, you are
; expected to implement the Model faithfully. The eForth Working
; Group reserves the right to reject implementation which deviates
; significantly from this Model.
;
; As the ANS Forth Standard is still evolving, this Model will
; change accordingly. Implementations must state clearly the
; version number of the Model being tracked.
;
; Representing the eForth Working Group in the Silicon Valley FIG Chapter.
; Send contributions to:
;
; Dr. C. H. Ting
; 156 14th Avenue
; San Mateo, CA 94402
; (650) 571-7639
;
;===============================================================
;; Version control
VER EQU 2 ;major release version
EXT EQU 3 ;minor extension
;; Constants
TRUEE EQU -1 ;true flag
COMPO EQU 040H ;lexicon compile only bit
IMEDD EQU 080H ;lexicon immediate bit
MASKK EQU 07F1FH ;lexicon bit mask
CELLL EQU 2 ;size of a cell
BASEE EQU 10H ;default radix
VOCSS EQU 8 ;depth of vocabulary stack
BKSPP EQU 8 ;back space
LF EQU 10 ;line feed
CRR EQU 13 ;carriage return
ERR EQU 27 ;error escape
TIC EQU 39 ;tick
CALLL EQU 0CDH ;NOP CALL opcodes
;; Memory allocation
EM EQU 01FFFH ;top of memory
US EQU 15*CELLL ;user area size in cells
RTS EQU 64*CELLL ;return stack/TIB size
UPP EQU 1FE0H ;start of user area (UP0)
RPP EQU 1F80H ;start of return stack (RP0)
TIBB EQU 1F90H ;terminal input buffer (TIB)
SPP EQU 0H ;start of data stack (SP0)
COLDD EQU 0 ;cold start vector
;; Initialize assembly variables
_LINK = 0 ;force a null link
_USER = 0 ;first user variable offset
;; Define assembly macros
; Compile a code definition header.
$CODE MACRO LEX,NAME,LABEL
DW _LINK ;;token pointer and link
_LINK = $ ;;link points to a name string
DB LEX,NAME ;;name string
LABEL: ;;assembly label
ENDM
; Compile a colon definition header.
$COLON MACRO LEX,NAME,LABEL
$CODE LEX,NAME,LABEL
DB CALLL
DW DOLST ;;include CALL doLIST
ENDM
; Compile a user variable header.
$USER MACRO LEX,NAME,LABEL
$CODE LEX,NAME,LABEL
DB CALLL
DW DOLST ;;include CALL doLIST
DW DOUSE,_USER ;;followed by doUSER and offset
_USER = _USER+CELLL ;;update user area offset
ENDM
; Assemble inline direct threaded code ending.
$NEXT MACRO
DB 0C3H \;;read the next code address into AX
DW NextStep ;;jump directly to the code address
ENDM
;; Main entry points and COLD start data
MAIN SEGMENT
ASSUME CS:MAIN,DS:MAIN,ES:MAIN,SS:MAIN
ORIG:
; COLD start moves the following to USER variables.
; MUST BE IN SAME ORDER AS USER VARIABLES.
ORG COLDD ;beginning of cold boot area
DB 21h, 080h,1Fh ; LD HL, 007Ch ; init RP to 1FFEh
DB 22h, 0FEh,1Fh ; LD (RP), HL ;
DB 0C3H
DW COLD
UZERO:
DW BASEE ;BASE
DW 0 ;tmp
DW 0 ;>IN
DW 10 ;#TIB
DW TIBB ;TIB
DW INTER ;'EVAL
DW 0 ;HLD
DW 0 ;CONTEXT pointer
DW CTOP ;CP
DW LASTN ;LAST
DW 1F80H ;RP at 94h
DW 0 ;SP
ULAST:
;; Device dependent I/O
; All channeled to DOS 21H services
;;ORG 0100H
PUSHDE:
DB 0D5H
PUSHHL:
DB 0E5H
;; NextStep
;The Forth Inner Interpreter--IP (=BC)is pointing the To-Be-Exec one
NextStep: ;The Forth Inner Interpreter--IP (=BC)is pointing the To-Be-Exec one
DB 0Ah ; LD A, (BC); 7t
DB 03h ; INC BC ; 6t
DB 6Fh ; LD L, A ; 4t
DB 0Ah ; LD A, (BC); 7t
DB 03h ; INC BC ; 6t
DB 67h ; LD H, A ; 4t
DB 0E9h ; JP (HL) ; 4t
; ; 38t==(10MHz)3.8 usec.
; ?RX ( -- c T | F )
; Return input character and true, or a false if no input.
$COLON 4,'?KEY',QKEY
DW DOLIT,0FF02H,CAT,DUPP ; UART80 RX C@
DW QBRAN,RX1
DW DOLIT,0FF03H,CAT,SWAP ; UART80 RX C!
RX1:
DW EXIT ; $1A PC! ;
; TX! ( c -- )
; Send character c to the output device.
$COLON 4,'EMIT',EMIT
TX1:
DW DOLIT,0FF01H,CAT ; UART80 TX C@
DW QBRAN,TX1 ; UNTIL
DW DOLIT,0FF01H,CSTOR,EXIT ; UART80 TX C! ;
;; The kernel
; doLIT ( -- w )
; Push an inline literal.
$CODE COMPO+5,'doLit',DOLIT
DB 0Ah ; LD A, (BC) ; 7t
DB 03h ; INC BC ; 6t
DB 6Fh ; LD L,A ; 4t
DB 0Ah ; LD A,(BC) ; 7t
DB 03h ; INC BC ; 6t
DB 67h ; LD H,A ; 4t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; doLIST ( a -- )
; Process colon list.
$CODE COMPO+6,'doList',DOLST
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 2Bh ; DEC HL ; 6t
DB 70h ; LD (HL), B ; 7t \ end of r-push simulation
DB 2Bh ; DEC HL ; 6t
DB 71h ; LD (HL), C ; 7t \ end of r-push simulation
DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t \ IP is r-pushed (simulated)
; ;
DB 0C1h ; POP BC ;10t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;99t==9.9usec (+ 2.4usec for NextStep)
; next ( -- )
; Run time code for the single index loop.
; : next ( -- ) \ hilevel model
; r> r> dup if 1 - >r @ >r exit then drop cell+ >r ;
$CODE COMPO+4,'next',DONXT
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 7Eh ; LD A, (HL) ; 7t
DB 0B7h ; OR A ; 4t
DB 0C2h ; JR NZ, DECLOW;12/7t a fast dec is ok, only failed every 255 time
DW DECLOW ; ; low byte 0
DB 23h ; INC HL ; 6t
DB 7Eh ; LD A, (HL) ; 7t
DB 0B7h ; OR A ; 4t
DB 0C2h ; JR NZ, DECHILO;12/7t Hi-byte no-zero, it is also a re-loop case
DW DECHILOW ;zero bound now .. .
DB 23h ; INC HL ; 6tdiscard the loop count on R-stack
DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
DB 03h ; INC BC ; 6t\ IP slip over the re-loop-addr
DB 03h ; INC BC ; 6t
DB 0C3h
DW NextStep ; JP NextStep ;10t loop is over
DECHILOW: ; ; 98t==(10MHz)9.8usec
DB 35h ;DECHILO:DEC (HL) ;11t hi-byte
DB 2Bh ; DEC HL ; 6t back to low byte
DECLOW:
DB 35h ;DECLOW:DEC (HL) ;11t low byte non-zero, just dec it and re-loop
DB 69h ; LD L, C ; 4t get loop-start-adr to IP and keep stepping
DB 60h ; LD H, B ; 4t
DB 4Eh ; LD C, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 46h ; LD B, (HL) ; 7t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; low byte dec: 88t==(10MHz)8.8usec
; lo&Hi byte dec: 134t==(10MHz)13.4usec
; ?branch ( f -- )
; Branch if flag is zero.
$CODE COMPO+7,'?branch',QBRAN
DB 0E1h ; POP HL ;10t
DB 7Dh ; LD A, L ; 4t ?branch adr is just after ?branch
DB 0B4h ; OR H ; 4t and IP is pointing it
DB 0CAh ; JR Z,ZEROO ; 12/7t (Z=1,12t)
DW BRAN
DB 03h ; INC BC ; 6t IP slip over the retun addr
DB 03h ; INC BC ; 6t ex: 'TRUE IF' will slip over
DB 0C3h
DW NextStep ; JP NextStep ;10t ;47t==(10MHz)4.7usec
;
; branch ( -- )
; Branch to an inline address.
$CODE COMPO+6,'branch',BRAN
DB 69h ; LD L, C ; 4t get IP :=[IP] and go
DB 60h ; LD H, B ; 4t
DB 4Eh ; LD C, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 46h ; LD B, (HL) ; 7t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;38t==(10MHz)3.8usec
; EXECUTE ( ca -- )
; Execute the word at ca.
$CODE 7,'EXECUTE',EXECU
DB 0E1h ; POP HL ;10t
DB 0E9h ; JP (HL) ; 4t
; EXIT ( -- )
; Terminate a colon definition.
$CODE 4,'EXIT',EXIT
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 4Eh ; LD C, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 46h ; LD B, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 22h, 0FEh,1Fh ; LD (RP),HL ;16t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;68t==6.8us
; ! ( w a -- )
; Pop the data stack to memory.
$CODE 1,'!',STORE
DB 0E1h ; POP HL ;10t
DB 0D1h ; POP DE ;10t
DB 73h ; LD (HL), E ; 7t
DB 23h ; INC HL ; 6t
DB 72h ; LD (HL), D ; 7t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;50t==(10Mhz)5.0 usec
; @ ( a -- w )
; Push memory location to the data stack.
$CODE 1,'@',AT
DB 0E1h ; POP HL ;10t
DB 5Eh ; LD E, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 56h ; LD D, (HL) ; 7t
DB 0D5h ; PUSH DE ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;51t==(10Mhz)5.1usec
; C! ( c b -- )
; Pop the data stack to byte memory.
$CODE 2,'C!',CSTOR
DB 0E1h ; POP HL ;10t
DB 0D1h ; POP DE ;10t
DB 73h ; LD (HL), E ; 7t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;37t==(10Mhz)3.7usec
; C@ ( b -- c )
; Push byte memory location to the data stack.
$CODE 2,'C@',CAT
DB 0E1h ; POP HL ;10t
DB 5Eh ; LD E, (HL) ; 7t
DB 16h, 00h ; LD D, 0 ; 7t
DB 0D5h ; PUSH DE ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;45t==(10Mhz)4.5usec
; R> ( -- w )
; Pop the return stack to the data stack.
$CODE COMPO+2,'R>',RFROM
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 5Eh ; LD E, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 56h ; LD D, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
DB 0D5h ; PUSH DE ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;67t==(10MHz)5.7.usec
; R@ ( -- w )
; Copy top of return stack to the data stack.
$CODE 2,'R@',RAT
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 5Eh ; LD E, (HL) ; 7t
DB 23h ; INC HL ; 6t
DB 56h ; LD D, (HL) ; 7t
DB 0D5h ; PUSH DE ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;57t==(10MHz)5.7usec
; >R ( w -- )
; Push the data stack to the return stack.
$CODE COMPO+2,'>R',TOR
DB 0D1h ; POP DE ;10t
DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
DB 2Bh ; DEC HL ; 6t
DB 72h ; LD (HL), D ; 7t
DB 2Bh ; DEC HL ; 6t
DB 73h ; LD (HL), E ; 7t
DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;78t==(10MHz)7.8usec
; RP@ ( -- a )
; Push the current RP to the data stack.
$CODE 3,'RP@',RPAT
DB 2Ah, 0FEh,1Fh ; LD HL, (RP)
DB 0E5h ; PUSH HL
DB 0C3h
DW NextStep ; JP NextStep
; RP! ( a -- )
; Set the return stack pointer.
$CODE COMPO+3,'RP!',RPSTO
DB 0E1h ; POP HL ;
DB 22h, 0FEh,1Fh ; LD (RP), HL ;
DB 0C3h
DW NextStep ; JP NextStep ;
; SP@ ( -- a )
; Push the current data stack pointer.
$CODE 3,'sp@',SPAT
DB 21h, 00h, 00h ; LD HL, 0
DB 39h ; ADD HL, SP
DB 0E5h ; PUSH HL
DB 0C3h
DW NextStep ; JP NextStep
; SP! ( a -- )
; Set the data stack pointer.
$CODE 3,'sp!',SPSTO
DB 0E1h ; POP HL
DB 0F9h ; LD SP, HL
DB 0C3h
DW NextStep ; JP NextStep
; DROP ( w -- )
; Discard top stack item.
$CODE 4,'DROP',DROP
DB 0E1h ; POP HL ;10t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;20t==(10MHz)2.0usec
; DUP ( w -- w w )
; Duplicate the top stack item.
$CODE 3,'DUP',DUPP
DB 0E1h ; POP HL ;10t
DB 0E5h ; PUSH HL ;11t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;42t==(10MHz)4.2usec
; SWAP ( w1 w2 -- w2 w1 )
; Exchange top two stack items.
$CODE 4,'SWAP',SWAP
DB 0E1h ; POP HL ;10t
DB 0E3h ; EX (SP), HL ;19t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;50t==(10MHz)5.0usec
; OVER ( w1 w2 -- w1 w2 w1 )
; Copy second stack item to top.
$CODE 4,'OVER',OVER
DB 0D1h ; POP DE ;10t
DB 0E1h ; POP HL ;10t
DB 0E5h ; PUSH HL ;11t
DB 0D5h ; PUSH DE ;11t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
; ;63t==(10MHz)6.3usec
; 0< ( n -- t )
; Return true if n is negative.
$CODE 2,'0<',ZLESS
DB 0E1h ; POP HL ;10t
DB 29h ; ADD HL, HL ;11t
DB 0DAh ; JR C, LESSZ ;12/7t
DW LESSZ
DB 21h, 00h, 00h ; LD HL, 0 ;10t
DB 0C3h
DW PUSHHL ; JP NextStep ;10t 59t==(10MHz)5.9usec
LESSZ: ;
DB 21h,0FFh,0FFh ;LESSZ: LD HL, 0FFFFH ;10t
DB 0C3h
DW PUSHHL ; JP NextStep ;10t 64t==(10MHz)6.4usec
; AND ( w w -- w )
; Bitwise AND.
$CODE 3,'AND',ANDD
DB 0D1h ; POP DE
DB 0E1h ; POP HL
DB 7Bh ; LD A, E
DB 0A5h ; AND L
DB 6Fh ; LD L, A
DB 7Ah ; LD A, D
DB 0A4h ; AND H
DB 67h ; LD H, A
DB 0E5h ; PUSH HL
DB 0C3h
DW NextStep ; JP NextStep
; OR ( w w -- w )
; Bitwise inclusive OR.
$CODE 2,'OR',ORR
DB 0D1h ; POP DE
DB 0E1h ; POP HL
DB 7Bh ; LD A, E
DB 0B5h ; OR L
DB 6Fh ; LD L, A
DB 7Ah ; LD A, D
DB 0B4h ; OR H
DB 67h ; LD H, A
DB 0E5h ; PUSH HL
DB 0C3h
DW NextStep ; JP NextStep
; XOR ( w w -- w )
; Bitwise exclusive OR.
$CODE 3,'XOR',XORR
DB 0D1h ; POP DE
DB 0E1h ; POP HL
DB 7Bh ; LD A, E
DB 0ADh ; XOR L
DB 6Fh ; LD L, A
DB 7Ah ; LD A, D
DB 0ACh ; XOR H
DB 67h ; LD H, A
DB 0E5h ; PUSH HL
DB 0C3h
DW NextStep ; JP NextStep
; UM+ ( u u -- udsum )
; Add two unsigned single numbers and return a double sum.
$CODE 3,'UM+',UPLUS
DB 0D1h ; POP DE ;10t
DB 0E1h ; POP HL ;10t
DB 19h ; ADD HL, DE ;11t
DB 0E5h ; PUSH HL ;11t
DB 0DAh ; JR C, CARRY ;12/7t
DW CARRY
DB 21h, 00h, 00h ; LD HL, 0 ;10t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
CARRY: ;
DB 21h, 01h, 00h ;CARRY: LD HL, 1 ;10t
DB 0E5h ; PUSH HL ;11t
DB 0C3h
DW NextStep ; JP NextStep ;10t
;; System and user variables
; doVAR ( -- a )
; Run time routine for VARIABLE and CREATE.
$COLON COMPO+5,'doVar',DOVAR
DW RFROM,EXIT
; UP ( -- a )
; Pointer to the user area.
$COLON 2,'up',UP
DW DOVAR
DW UPP
; doUSER ( -- a )
; Run time routine for user variables.
$COLON COMPO+6,'doUser',DOUSE
DW RFROM,AT,UP,AT,PLUS,EXIT
; BASE ( -- a )
; Storage of the radix base for numeric I/O.
$USER 4,'BASE',BASE
; tmp ( -- a )
; A temporary storage location used in parse and find.
$USER COMPO+3,'tmp',TEMP
; >IN ( -- a )
; Hold the character pointer while parsing input stream.
$USER 3,'>IN',INN
; #TIB ( -- a )
; Hold the current count in and address of the terminal input buffer.
$USER 4,'#TIB',NTIB
_USER = _USER+CELLL ;hold the base address of the terminal input buffer
; 'EVAL ( -- a )
; Execution vector of EVAL.
$USER 5,"'eval",TEVAL
; HLD ( -- a )
; Hold a pointer in building a numeric output string.
$USER 3,'hld',HLD
; CONTEXT ( -- a )
; A area to specify vocabulary search order.
$USER 7,'CONTEXT',CNTXT
; CP ( -- a )
; Point to the top of the code dictionary.
$USER 2,'cp',CP
; LAST ( -- a )
; Point to the last name in the name dictionary.
$USER 4,'last',LAST
;; Common functions
; ?DUP ( w -- w w | 0 )
; Dup tos if its is not zero.
$COLON 4,'?DUP',QDUP
DW DUPP
DW QBRAN,QDUP1
DW DUPP
QDUP1:
DW EXIT
; ROT ( w1 w2 w3 -- w2 w3 w1 )
; Rot 3rd item to top.
$COLON 3,'ROT',ROT
DW TOR,SWAP,RFROM,SWAP,EXIT
; 2DROP ( w w -- )
; Discard two items on stack.
$COLON 5,'2DROP',DDROP
DW DROP,DROP,EXIT
; 2DUP ( w1 w2 -- w1 w2 w1 w2 )
; Duplicate top two items.
$COLON 4,'2DUP',DDUP
DW OVER,OVER,EXIT
; + ( w w -- sum )
; Add top two items.
$COLON 1,'+',PLUS
DW UPLUS,DROP,EXIT
; NOT ( w -- w )
; One's complement of tos.
$COLON 3,'NOT',INVER
DW DOLIT,-1,XORR,EXIT
; NEGATE ( n -- -n )
; Two's complement of tos.
$COLON 6,'NEGATE',NEGAT
DW INVER,ONEP,EXIT
; DNEGATE ( d -- -d )
; Two's complement of top double.
$COLON 7,'DNEGATE',DNEGA
DW INVER,TOR,INVER
DW DOLIT,1,UPLUS
DW RFROM,PLUS,EXIT
; - ( n1 n2 -- n1-n2 )
; Subtraction.
$COLON 1,'-',SUBBB
DW NEGAT,PLUS,EXIT
; ABS ( n -- n )
; Return the absolute value of n.
$COLON 3,'ABS',ABSS
DW DUPP,ZLESS
DW QBRAN,ABS1
DW NEGAT
ABS1:
DW EXIT
; = ( w w -- t )
; Return true if top two are equal.
$COLON 1,'=',EQUAL
DW XORR
DW QBRAN,EQU1
DW DOLIT,0,EXIT
EQU1:
DW DOLIT,TRUEE,EXIT
; U< ( u u -- t )
; Unsigned compare of top two items.
$COLON 2,'U<',ULESS
DW DDUP,XORR,ZLESS
DW QBRAN,ULES1
DW SWAP,DROP,ZLESS,EXIT
ULES1:
DW SUBBB,ZLESS,EXIT
; < ( n1 n2 -- t )
; Signed compare of top two items.
$COLON 1,'<',LESS
DW DDUP,XORR,ZLESS
DW QBRAN,LESS1
DW DROP,ZLESS,EXIT
LESS1:
DW SUBBB,ZLESS,EXIT
; MAX ( n n -- n )
; Return the greater of two top stack items.
$COLON 3,'MAX',MAX
DW DDUP,LESS
DW QBRAN,MAX1
DW SWAP
MAX1:
DW DROP,EXIT
; MIN ( n n -- n )
; Return the smaller of top two stack items.
$COLON 3,'MIN',MIN
DW DDUP,SWAP,LESS
DW QBRAN,MIN1
DW SWAP
MIN1:
DW DROP,EXIT
; WITHIN ( u ul uh -- t )
; Return true if u is within the range of ul and uh. ( ul <= u < uh )
$COLON 6,'WITHIN',WITHI
DW OVER,SUBBB,TOR
DW SUBBB,RFROM,ULESS,EXIT
;; Divide
; UM/MOD ( udl udh un -- ur uq )
; Unsigned divide of a double by a single. Return mod and quotient.
$COLON 6,'UM/MOD',UMMOD
DW DDUP,ULESS
DW QBRAN,UMM4
DW NEGAT,DOLIT,15,TOR
UMM1:
DW TOR,DUPP,UPLUS
DW TOR,TOR,DUPP,UPLUS
DW RFROM,PLUS,DUPP
DW RFROM,RAT,SWAP,TOR
DW UPLUS,RFROM,ORR
DW QBRAN,UMM2
DW TOR,DROP,ONEP,RFROM
DW BRAN,UMM3
UMM2:
DW DROP
UMM3:
DW RFROM
DW DONXT,UMM1
DW DROP,SWAP,EXIT
UMM4:
DW DROP,DDROP
DW DOLIT,-1,DUPP,EXIT
; M/MOD ( d n -- r q )
; Signed floored divide of double by single. Return mod and quotient.
$COLON 5,'M/MOD',MSMOD
DW DUPP,ZLESS,DUPP,TOR
DW QBRAN,MMOD1
DW NEGAT,TOR,DNEGA,RFROM
MMOD1:
DW TOR,DUPP,ZLESS
DW QBRAN,MMOD2
DW RAT,PLUS
MMOD2:
DW RFROM,UMMOD,RFROM
DW QBRAN,MMOD3
DW SWAP,NEGAT,SWAP
MMOD3:
DW EXIT
; /MOD ( n n -- r q )
; Signed divide. Return mod and quotient.
$COLON 4,'/MOD',SLMOD
DW OVER,ZLESS,SWAP,MSMOD,EXIT
; MOD ( n n -- r )
; Signed divide. Return mod only.
$COLON 3,'MOD',MODD
DW SLMOD,DROP,EXIT
; / ( n n -- q )
; Signed divide. Return quotient only.
$COLON 1,'/',SLASH
DW SLMOD,SWAP,DROP,EXIT
;; Multiply
; UM* ( u u -- ud )
; Unsigned multiply. Return double product.
$COLON 3,'UM*',UMSTA
DW DOLIT,0,SWAP,DOLIT,15,TOR
UMST1:
DW DUPP,UPLUS,TOR,TOR
DW DUPP,UPLUS,RFROM,PLUS,RFROM
DW QBRAN,UMST2
DW TOR,OVER,UPLUS,RFROM,PLUS
UMST2:
DW DONXT,UMST1
DW ROT,DROP,EXIT
; * ( n n -- n )
; Signed multiply. Return single product.
$COLON 1,'*',STAR
DW UMSTA,DROP,EXIT
; M* ( n n -- d )
; Signed multiply. Return double product.
$COLON 2,'M*',MSTAR
DW DDUP,XORR,ZLESS,TOR
DW ABSS,SWAP,ABSS,UMSTA
DW RFROM
DW QBRAN,MSTA1
DW DNEGA
MSTA1:
DW EXIT
; */MOD ( n1 n2 n3 -- r q )
; Multiply n1 and n2, then divide by n3. Return mod and quotient.
$COLON 5,'*/MOD',SSMOD
DW TOR,MSTAR,RFROM,MSMOD,EXIT
; */ ( n1 n2 n3 -- q )
; Multiply n1 by n2, then divide by n3. Return quotient only.
$COLON 2,'*/',STASL
DW SSMOD,SWAP,DROP,EXIT
;; Miscellaneous
; CELL+ ( a -- a )
; Add cell size in byte to address.
$COLON 5,'CELL+',CELLP
DW DOLIT,CELLL,PLUS,EXIT
; CELL- ( a -- a )
; Subtract cell size in byte from address.
$COLON 5,'CELL-',CELLM
DW DOLIT,0-CELLL,PLUS,EXIT
; CELLS ( n -- n )
; Multiply tos by cell size in bytes.
$COLON 5,'CELLS',CELLS
DW DOLIT,CELLL,STAR,EXIT
; 1+ ( a -- a )
; Add cell size in byte to address.
$COLON 2,'1+',ONEP
DW DOLIT,1,PLUS,EXIT
; 1- ( a -- a )
; Subtract cell size in byte from address.
$COLON 2,'1-',ONEM
DW DOLIT,-1,PLUS,EXIT
; 2/ ( n -- n )
; Multiply tos by cell size in bytes.
$COLON 2,'2/',TWOSL
DW DOLIT,CELLL,SLASH,EXIT
; BL ( -- 32 )
; Return 32, the blank character.
$COLON 2,'BL',BLANK
DW DOLIT,' ',EXIT
; >CHAR ( c -- c )
; Filter non-printing characters.
$COLON 5,'>CHAR',TCHAR
DW DOLIT,07FH,ANDD,DUPP ;mask msb
DW DOLIT,127,BLANK,WITHI ;check for printable
DW QBRAN,TCHA1
DW DROP,DOLIT,'_' ;replace non-printables
TCHA1:
DW EXIT
;; Memory access
; +! ( n a -- )
; Add n to the contents at address a.
$COLON 2,'+!',PSTOR
DW SWAP,OVER,AT,PLUS
DW SWAP,STORE,EXIT
; 2! ( d a -- )
; Store the double integer to address a.
$COLON 2,'2!',DSTOR
DW SWAP,OVER,STORE
DW CELLP,STORE,EXIT
; 2@ ( a -- d )
; Fetch double integer from address a.
$COLON 2,'2@',DAT
DW DUPP,CELLP,AT
DW SWAP,AT,EXIT
; COUNT ( b -- b +n )
; Return count byte of a string and add 1 to byte address.
$COLON 5,'COUNT',COUNT
DW DUPP,ONEP
DW SWAP,CAT,EXIT
; HERE ( -- a )
; Return the top of the code dictionary.
$COLON 4,'HERE',HERE
DW CP,AT,EXIT
; PAD ( -- a )
; Return the address of the text buffer above the code dictionary.
$COLON 3,'PAD',PAD
DW HERE,DOLIT,80,PLUS,EXIT
; TIB ( -- a )
; Return the address of the terminal input buffer.
$COLON 3,'TIB',TIB
DW DOLIT,TIBB,EXIT
; @EXECUTE ( a -- )
; Execute vector stored in address a.
$COLON 8,'@EXECUTE',ATEXE
DW AT,QDUP ;?address or zero
DW QBRAN,EXE1
DW EXECU ;execute if non-zero
EXE1:
DW EXIT ;do nothing if zero
; CMOVE ( b1 b2 u -- )
; Copy u bytes from b1 to b2.
$COLON 5,'CMOVE',CMOVEE
DW TOR
DW BRAN,CMOV2
CMOV1:
DW TOR,DUPP,CAT
DW RAT,CSTOR
DW ONEP
DW RFROM,ONEP
CMOV2:
DW DONXT,CMOV1
DW DDROP,EXIT
; FILL ( b u c -- )
; Fill u bytes of character c to area beginning at b.
$COLON 4,'FILL',FILL
DW SWAP,TOR,SWAP
DW BRAN,FILL2
FILL1:
DW DDUP,CSTOR,ONEP
FILL2:
DW DONXT,FILL1
DW DDROP,EXIT
; ERASE ( b u -- )
; Erase u bytes beginning at b.
$COLON 5,'ERASE',ERASE
DW DOLIT,0,FILL
DW EXIT
; PACK$ ( b u a -- a )
; Build a counted string with u characters from b. Null fill.
$COLON 5,'PACK$',PACKS
DW DUPP,TOR ;strings only on cell boundary
DW DDUP,CSTOR,ONEP ;save count
DW SWAP,CMOVEE,RFROM,EXIT ;move string
;; Numeric output, single precision
; DIGIT ( u -- c )
; Convert digit u to a character.
$COLON 5,'DIGIT',DIGIT
DW DOLIT,9,OVER,LESS
DW DOLIT,7,ANDD,PLUS
DW DOLIT,'0',PLUS,EXIT
; EXTRACT ( n base -- n c )
; Extract the least significant digit from n.
$COLON 7,'EXTRACT',EXTRC
DW DOLIT,0,SWAP,UMMOD
DW SWAP,DIGIT,EXIT
; <# ( -- )
; Initiate the numeric output process.
$COLON 2,'<#',BDIGS
DW PAD,HLD,STORE,EXIT
; HOLD ( c -- )
; Insert a character into the numeric output string.
$COLON 4,'HOLD',HOLD
DW HLD,AT,ONEM
DW DUPP,HLD,STORE,CSTOR,EXIT
; # ( u -- u )
; Extract one digit from u and append the digit to output string.
$COLON 1,'#',DIG
DW BASE,AT,EXTRC,HOLD,EXIT
; #S ( u -- 0 )
; Convert u until all digits are added to the output string.
$COLON 2,'#S',DIGS
DIGS1:
DW DIG,DUPP
DW QBRAN,DIGS2
DW BRAN,DIGS1
DIGS2:
DW EXIT
; SIGN ( n -- )
; Add a minus sign to the numeric output string.
$COLON 4,'SIGN',SIGN
DW ZLESS
DW QBRAN,SIGN1
DW DOLIT,'-',HOLD
SIGN1:
DW EXIT
; #> ( w -- b u )
; Prepare the output string to be TYPE'd.
$COLON 2,'#>',EDIGS
DW DROP,HLD,AT
DW PAD,OVER,SUBBB,EXIT
; str ( w -- b u )
; Convert a signed integer to a numeric string.
$COLON 3,'str',STRR
DW DUPP,TOR,ABSS
DW BDIGS,DIGS,RFROM
DW SIGN,EDIGS,EXIT
; HEX ( -- )
; Use radix 16 as base for numeric conversions.
$COLON 3,'HEX',HEX
DW DOLIT,16,BASE,STORE,EXIT
; DECIMAL ( -- )
; Use radix 10 as base for numeric conversions.
$COLON 7,'DECIMAL',DECIM
DW DOLIT,10,BASE,STORE,EXIT
;; Numeric input, single precision
; DIGIT? ( c base -- u t )
; Convert a character to its numeric value. A flag indicates success.
$COLON 6,'DIGIT?',DIGTQ
DW TOR,DOLIT,'0',SUBBB
DW DOLIT,9,OVER,LESS
DW QBRAN,DGTQ1
DW DOLIT,7,SUBBB
DW DUPP,DOLIT,10,LESS,ORR
DGTQ1:
DW DUPP,RFROM,ULESS,EXIT
; NUMBER? ( a -- n T | a F )
; Convert a number string to integer. Push a flag on tos.
$COLON 7,'NUMBER?',NUMBQ
DW BASE,AT,TOR,DOLIT,0,OVER,COUNT
DW OVER,CAT,DOLIT,'$',EQUAL
DW QBRAN,NUMQ1
DW HEX,SWAP,ONEP
DW SWAP,ONEM
NUMQ1:
DW OVER,CAT,DOLIT,'-',EQUAL,TOR
DW SWAP,RAT,SUBBB,SWAP,RAT,PLUS,QDUP
DW QBRAN,NUMQ6
DW ONEM,TOR
NUMQ2:
DW DUPP,TOR,CAT,BASE,AT,DIGTQ
DW QBRAN,NUMQ4
DW SWAP,BASE,AT,STAR,PLUS,RFROM
DW ONEP
DW DONXT,NUMQ2
DW RAT,SWAP,DROP
DW QBRAN,NUMQ3
DW NEGAT
NUMQ3:
DW SWAP
DW BRAN,NUMQ5
NUMQ4:
DW RFROM,RFROM,DDROP,DDROP,DOLIT,0