-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy path80EF202.lst
3451 lines (3296 loc) · 123 KB
/
80EF202.lst
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
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 1 - 1
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
; Synthesize ep8080 modules in Diamond IDE
; ep80_chip.vhd
; ep80.vhd
; ram_memory.vhd
; uart80.vhd
; gpio80.vhd
; Select Export Files/VHDL Simulation File and JEDEC 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 Programming to burn FPGA
;
;
;===============================================================
; 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:
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 2 - 1
; 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
= 0002 VER EQU 2 ;major release version
= 0003 EXT EQU 3 ;minor extension
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 3 - 1
;; Constants
=-0001 TRUEE EQU -1 ;true flag
= 0040 COMPO EQU 040H ;lexicon compile only bit
= 0080 IMEDD EQU 080H ;lexicon immediate bit
= 7F1F MASKK EQU 07F1FH ;lexicon bit mask
= 0002 CELLL EQU 2 ;size of a cell
= 0010 BASEE EQU 10H ;default radix
= 0008 VOCSS EQU 8 ;depth of vocabulary stack
= 0008 BKSPP EQU 8 ;back space
= 000A LF EQU 10 ;line feed
= 000D CRR EQU 13 ;carriage return
= 001B ERR EQU 27 ;error escape
= 0027 TIC EQU 39 ;tick
= 00CD CALLL EQU 0CDH ;NOP CALL opcodes
;; Memory allocation
= 1FFF EM EQU 01FFFH ;top of memory
= 001E US EQU 15*CELLL ;user area size in cells
= 0080 RTS EQU 64*CELLL ;return stack/TIB size
= 1FE0 UPP EQU 1FE0H ;start of user area (UP0)
= 1F80 RPP EQU 1F80H ;start of return stack (RP0)
= 1F90 TIBB EQU 1F90H ;terminal input buffer (TIB)
= 0000 SPP EQU 0H ;start of data stack (SP0)
= 0000 COLDD EQU 0 ;cold start vector
;; Initialize assembly variables
= 0000 _LINK = 0 ;force a null link
= 0000 _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
0000 MAIN SEGMENT
ASSUME CS:MAIN,DS:MAIN,ES:MAIN,SS:MAIN
0000 ORIG:
; COLD start moves the following to USER variables.
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 4 - 1
; MUST BE IN SAME ORDER AS USER VARIABLES.
ORG COLDD ;beginning of cold boot area
0000 21 80 1F DB 21h, 080h,1Fh ; LD HL, 007Ch ; init RP to 1FFEh
0003 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;
0006 C3 DB 0C3H
0007 12E8 R DW COLD
0009 UZERO:
0009 0010 DW BASEE ;BASE
000B 0000 DW 0 ;tmp
000D 0000 DW 0 ;>IN
000F 000A DW 10 ;#TIB
0011 1F90 DW TIBB ;TIB
0013 0D93 R DW INTER ;'EVAL
0015 0000 DW 0 ;HLD
0017 0000 DW 0 ;CONTEXT pointer
0019 1307 R DW CTOP ;CP
001B 12E3 R DW LASTN ;LAST
001D 1F80 DW 1F80H ;RP at 94h
001F 0000 DW 0 ;SP
0021 ULAST:
;; Device dependent I/O
; All channeled to DOS 21H services
;;ORG 0100H
0021 PUSHDE:
0021 D5 DB 0D5H
0022 PUSHHL:
0022 E5 DB 0E5H
;; NextStep
;The Forth Inner Interpreter--IP (=BC)is pointing the To-Be-Exec one
0023 NextStep: ;The Forth Inner Interpreter--IP (=BC)is pointing the To-Be-Exec one
0023 0A DB 0Ah ; LD A, (BC); 7t
0024 03 DB 03h ; INC BC ; 6t
0025 6F DB 6Fh ; LD L, A ; 4t
0026 0A DB 0Ah ; LD A, (BC); 7t
0027 03 DB 03h ; INC BC ; 6t
0028 67 DB 67h ; LD H, A ; 4t
0029 E9 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
002A 0000 2 DW _LINK
002C
002C 04 3F 4B 45 59 2 DB 4,'?KEY'
0031 2 QKEY:
0031 CD 1 DB CALLL
0032 0081 R 1 DW DOLST
0034 006E R FF02 0126 R DW DOLIT,0FF02H,CAT,DUPP ; UART80 RX C@
01A7 R
003C 00C2 R 0048 R DW QBRAN,RX1
0040 006E R FF03 0126 R DW DOLIT,0FF03H,CAT,SWAP ; UART80 RX C!
01B4 R
0048 RX1:
0048 00F1 R DW EXIT ; $1A PC! ;
; TX! ( c -- )
; Send character c to the output device.
$COLON 4,'EMIT',EMIT
004A 002C R 2 DW _LINK
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 5 - 1
004C
004C 04 45 4D 49 54 2 DB 4,'EMIT'
0051 2 EMIT:
0051 CD 1 DB CALLL
0052 0081 R 1 DW DOLST
0054 TX1:
0054 006E R FF01 0126 R DW DOLIT,0FF01H,CAT ; UART80 TX C@
005A 00C2 R 0054 R DW QBRAN,TX1 ; UNTIL
005E 006E R FF01 011B R DW DOLIT,0FF01H,CSTOR,EXIT ; UART80 TX C! ;
00F1 R
;; The kernel
; doLIT ( -- w )
; Push an inline literal.
$CODE COMPO+5,'doLit',DOLIT
0066 004C R 1 DW _LINK
0068
0068 45 64 6F 4C 69 74 1 DB COMPO+5,'doLit'
006E 1 DOLIT:
006E 0A DB 0Ah ; LD A, (BC) ; 7t
006F 03 DB 03h ; INC BC ; 6t
0070 6F DB 6Fh ; LD L,A ; 4t
0071 0A DB 0Ah ; LD A,(BC) ; 7t
0072 03 DB 03h ; INC BC ; 6t
0073 67 DB 67h ; LD H,A ; 4t
0074 E5 DB 0E5h ; PUSH HL ;11t
0075 C3 DB 0C3h
0076 0023 R DW NextStep ; JP NextStep ;10t
; doLIST ( a -- )
; Process colon list.
$CODE COMPO+6,'doList',DOLST
0078 0068 R 1 DW _LINK
007A
007A 46 64 6F 4C 69 73 1 DB COMPO+6,'doList'
74
0081 1 DOLST:
0081 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
0084 2B DB 2Bh ; DEC HL ; 6t
0085 70 DB 70h ; LD (HL), B ; 7t \ end of r-push simulation
0086 2B DB 2Bh ; DEC HL ; 6t
0087 71 DB 71h ; LD (HL), C ; 7t \ end of r-push simulation
0088 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t \ IP is r-pushed (simulated)
; ;
008B C1 DB 0C1h ; POP BC ;10t
008C C3 DB 0C3h
008D 0023 R 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
008F 007A R 1 DW _LINK
0091
0091 44 6E 65 78 74 1 DB COMPO+4,'next'
0096 1 DONXT:
0096 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
0099 7E DB 7Eh ; LD A, (HL) ; 7t
009A B7 DB 0B7h ; OR A ; 4t
009B C2 DB 0C2h ; JR NZ, DECLOW;12/7t a fast dec is ok, only failed every 255 time
009C 00AF R DW DECLOW ; ; low byte 0
009E 23 DB 23h ; INC HL ; 6t
009F 7E DB 7Eh ; LD A, (HL) ; 7t
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 6 - 1
00A0 B7 DB 0B7h ; OR A ; 4t
00A1 C2 DB 0C2h ; JR NZ, DECHILO;12/7t Hi-byte no-zero, it is also a re-loop case
00A2 00AD R DW DECHILOW ;zero bound now .. .
00A4 23 DB 23h ; INC HL ; 6tdiscard the loop count on R-stack
00A5 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
00A8 03 DB 03h ; INC BC ; 6t\ IP slip over the re-loop-addr
00A9 03 DB 03h ; INC BC ; 6t
00AA C3 DB 0C3h
00AB 0023 R DW NextStep ; JP NextStep ;10t loop is over
00AD DECHILOW: ; ; 98t==(10MHz)9.8usec
00AD 35 DB 35h ;DECHILO:DEC (HL) ;11t hi-byte
00AE 2B DB 2Bh ; DEC HL ; 6t back to low byte
00AF DECLOW:
00AF 35 DB 35h ;DECLOW:DEC (HL) ;11t low byte non-zero, just dec it and re-loop
00B0 69 DB 69h ; LD L, C ; 4t get loop-start-adr to IP and keep stepping
00B1 60 DB 60h ; LD H, B ; 4t
00B2 4E DB 4Eh ; LD C, (HL) ; 7t
00B3 23 DB 23h ; INC HL ; 6t
00B4 46 DB 46h ; LD B, (HL) ; 7t
00B5 C3 DB 0C3h
00B6 0023 R 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
00B8 0091 R 1 DW _LINK
00BA
00BA 47 3F 62 72 61 6E 1 DB COMPO+7,'?branch'
63 68
00C2 1 QBRAN:
00C2 E1 DB 0E1h ; POP HL ;10t
00C3 7D DB 7Dh ; LD A, L ; 4t ?branch adr is just after ?branch
00C4 B4 DB 0B4h ; OR H ; 4t and IP is pointing it
00C5 CA DB 0CAh ; JR Z,ZEROO ; 12/7t (Z=1,12t)
00C6 00D6 R DW BRAN
00C8 03 DB 03h ; INC BC ; 6t IP slip over the retun addr
00C9 03 DB 03h ; INC BC ; 6t ex: 'TRUE IF' will slip over
00CA C3 DB 0C3h
00CB 0023 R DW NextStep ; JP NextStep ;10t ;47t==(10MHz)4.7usec
;
; branch ( -- )
; Branch to an inline address.
$CODE COMPO+6,'branch',BRAN
00CD 00BA R 1 DW _LINK
00CF
00CF 46 62 72 61 6E 63 1 DB COMPO+6,'branch'
68
00D6 1 BRAN:
00D6 69 DB 69h ; LD L, C ; 4t get IP :=[IP] and go
00D7 60 DB 60h ; LD H, B ; 4t
00D8 4E DB 4Eh ; LD C, (HL) ; 7t
00D9 23 DB 23h ; INC HL ; 6t
00DA 46 DB 46h ; LD B, (HL) ; 7t
00DB C3 DB 0C3h
00DC 0023 R DW NextStep ; JP NextStep ;10t
; ;38t==(10MHz)3.8usec
; EXECUTE ( ca -- )
; Execute the word at ca.
$CODE 7,'EXECUTE',EXECU
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 7 - 1
00DE 00CF R 1 DW _LINK
00E0
00E0 07 45 58 45 43 55 1 DB 7,'EXECUTE'
54 45
00E8 1 EXECU:
00E8 E1 DB 0E1h ; POP HL ;10t
00E9 E9 DB 0E9h ; JP (HL) ; 4t
; EXIT ( -- )
; Terminate a colon definition.
$CODE 4,'EXIT',EXIT
00EA 00E0 R 1 DW _LINK
00EC
00EC 04 45 58 49 54 1 DB 4,'EXIT'
00F1 1 EXIT:
00F1 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
00F4 4E DB 4Eh ; LD C, (HL) ; 7t
00F5 23 DB 23h ; INC HL ; 6t
00F6 46 DB 46h ; LD B, (HL) ; 7t
00F7 23 DB 23h ; INC HL ; 6t
00F8 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP),HL ;16t
00FB C3 DB 0C3h
00FC 0023 R DW NextStep ; JP NextStep ;10t
; ;68t==6.8us
; ! ( w a -- )
; Pop the data stack to memory.
$CODE 1,'!',STORE
00FE 00EC R 1 DW _LINK
0100
0100 01 21 1 DB 1,'!'
0102 1 STORE:
0102 E1 DB 0E1h ; POP HL ;10t
0103 D1 DB 0D1h ; POP DE ;10t
0104 73 DB 73h ; LD (HL), E ; 7t
0105 23 DB 23h ; INC HL ; 6t
0106 72 DB 72h ; LD (HL), D ; 7t
0107 C3 DB 0C3h
0108 0023 R DW NextStep ; JP NextStep ;10t
; ;50t==(10Mhz)5.0 usec
; @ ( a -- w )
; Push memory location to the data stack.
$CODE 1,'@',AT
010A 0100 R 1 DW _LINK
010C
010C 01 40 1 DB 1,'@'
010E 1 AT:
010E E1 DB 0E1h ; POP HL ;10t
010F 5E DB 5Eh ; LD E, (HL) ; 7t
0110 23 DB 23h ; INC HL ; 6t
0111 56 DB 56h ; LD D, (HL) ; 7t
0112 D5 DB 0D5h ; PUSH DE ;11t
0113 C3 DB 0C3h
0114 0023 R DW NextStep ; JP NextStep ;10t
; ;51t==(10Mhz)5.1usec
; C! ( c b -- )
; Pop the data stack to byte memory.
$CODE 2,'C!',CSTOR
0116 010C R 1 DW _LINK
0118
0118 02 43 21 1 DB 2,'C!'
011B 1 CSTOR:
011B E1 DB 0E1h ; POP HL ;10t
011C D1 DB 0D1h ; POP DE ;10t
011D 73 DB 73h ; LD (HL), E ; 7t
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 8 - 1
011E C3 DB 0C3h
011F 0023 R DW NextStep ; JP NextStep ;10t
; ;37t==(10Mhz)3.7usec
; C@ ( b -- c )
; Push byte memory location to the data stack.
$CODE 2,'C@',CAT
0121 0118 R 1 DW _LINK
0123
0123 02 43 40 1 DB 2,'C@'
0126 1 CAT:
0126 E1 DB 0E1h ; POP HL ;10t
0127 5E DB 5Eh ; LD E, (HL) ; 7t
0128 16 00 DB 16h, 00h ; LD D, 0 ; 7t
012A D5 DB 0D5h ; PUSH DE ;11t
012B C3 DB 0C3h
012C 0023 R DW NextStep ; JP NextStep ;10t
; ;45t==(10Mhz)4.5usec
; R> ( -- w )
; Pop the return stack to the data stack.
$CODE COMPO+2,'R>',RFROM
012E 0123 R 1 DW _LINK
0130
0130 42 52 3E 1 DB COMPO+2,'R>'
0133 1 RFROM:
0133 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
0136 5E DB 5Eh ; LD E, (HL) ; 7t
0137 23 DB 23h ; INC HL ; 6t
0138 56 DB 56h ; LD D, (HL) ; 7t
0139 23 DB 23h ; INC HL ; 6t
013A 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
013D D5 DB 0D5h ; PUSH DE ;11t
013E C3 DB 0C3h
013F 0023 R 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
0141 0130 R 1 DW _LINK
0143
0143 02 52 40 1 DB 2,'R@'
0146 1 RAT:
0146 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
0149 5E DB 5Eh ; LD E, (HL) ; 7t
014A 23 DB 23h ; INC HL ; 6t
014B 56 DB 56h ; LD D, (HL) ; 7t
014C D5 DB 0D5h ; PUSH DE ;11t
014D C3 DB 0C3h
014E 0023 R DW NextStep ; JP NextStep ;10t
; ;57t==(10MHz)5.7usec
; >R ( w -- )
; Push the data stack to the return stack.
$CODE COMPO+2,'>R',TOR
0150 0143 R 1 DW _LINK
0152
0152 42 3E 52 1 DB COMPO+2,'>R'
0155 1 TOR:
0155 D1 DB 0D1h ; POP DE ;10t
0156 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP) ;16t
0159 2B DB 2Bh ; DEC HL ; 6t
015A 72 DB 72h ; LD (HL), D ; 7t
015B 2B DB 2Bh ; DEC HL ; 6t
015C 73 DB 73h ; LD (HL), E ; 7t
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 9 - 1
015D 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;16t
0160 C3 DB 0C3h
0161 0023 R DW NextStep ; JP NextStep ;10t
; ;78t==(10MHz)7.8usec
; RP@ ( -- a )
; Push the current RP to the data stack.
$CODE 3,'RP@',RPAT
0163 0152 R 1 DW _LINK
0165
0165 03 52 50 40 1 DB 3,'RP@'
0169 1 RPAT:
0169 2A FE 1F DB 2Ah, 0FEh,1Fh ; LD HL, (RP)
016C E5 DB 0E5h ; PUSH HL
016D C3 DB 0C3h
016E 0023 R DW NextStep ; JP NextStep
; RP! ( a -- )
; Set the return stack pointer.
$CODE COMPO+3,'RP!',RPSTO
0170 0165 R 1 DW _LINK
0172
0172 43 52 50 21 1 DB COMPO+3,'RP!'
0176 1 RPSTO:
0176 E1 DB 0E1h ; POP HL ;
0177 22 FE 1F DB 22h, 0FEh,1Fh ; LD (RP), HL ;
017A C3 DB 0C3h
017B 0023 R DW NextStep ; JP NextStep ;
; SP@ ( -- a )
; Push the current data stack pointer.
$CODE 3,'sp@',SPAT
017D 0172 R 1 DW _LINK
017F
017F 03 73 70 40 1 DB 3,'sp@'
0183 1 SPAT:
0183 21 00 00 DB 21h, 00h, 00h ; LD HL, 0
0186 39 DB 39h ; ADD HL, SP
0187 E5 DB 0E5h ; PUSH HL
0188 C3 DB 0C3h
0189 0023 R DW NextStep ; JP NextStep
; SP! ( a -- )
; Set the data stack pointer.
$CODE 3,'sp!',SPSTO
018B 017F R 1 DW _LINK
018D
018D 03 73 70 21 1 DB 3,'sp!'
0191 1 SPSTO:
0191 E1 DB 0E1h ; POP HL
0192 F9 DB 0F9h ; LD SP, HL
0193 C3 DB 0C3h
0194 0023 R DW NextStep ; JP NextStep
; DROP ( w -- )
; Discard top stack item.
$CODE 4,'DROP',DROP
0196 018D R 1 DW _LINK
0198
0198 04 44 52 4F 50 1 DB 4,'DROP'
019D 1 DROP:
019D E1 DB 0E1h ; POP HL ;10t
019E C3 DB 0C3h
019F 0023 R DW NextStep ; JP NextStep ;10t
; ;20t==(10MHz)2.0usec
; DUP ( w -- w w )
; Duplicate the top stack item.
$CODE 3,'DUP',DUPP
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 10 - 1
01A1 0198 R 1 DW _LINK
01A3
01A3 03 44 55 50 1 DB 3,'DUP'
01A7 1 DUPP:
01A7 E1 DB 0E1h ; POP HL ;10t
01A8 E5 DB 0E5h ; PUSH HL ;11t
01A9 E5 DB 0E5h ; PUSH HL ;11t
01AA C3 DB 0C3h
01AB 0023 R DW NextStep ; JP NextStep ;10t
; ;42t==(10MHz)4.2usec
; SWAP ( w1 w2 -- w2 w1 )
; Exchange top two stack items.
$CODE 4,'SWAP',SWAP
01AD 01A3 R 1 DW _LINK
01AF
01AF 04 53 57 41 50 1 DB 4,'SWAP'
01B4 1 SWAP:
01B4 E1 DB 0E1h ; POP HL ;10t
01B5 E3 DB 0E3h ; EX (SP), HL ;19t
01B6 E5 DB 0E5h ; PUSH HL ;11t
01B7 C3 DB 0C3h
01B8 0023 R 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
01BA 01AF R 1 DW _LINK
01BC
01BC 04 4F 56 45 52 1 DB 4,'OVER'
01C1 1 OVER:
01C1 D1 DB 0D1h ; POP DE ;10t
01C2 E1 DB 0E1h ; POP HL ;10t
01C3 E5 DB 0E5h ; PUSH HL ;11t
01C4 D5 DB 0D5h ; PUSH DE ;11t
01C5 E5 DB 0E5h ; PUSH HL ;11t
01C6 C3 DB 0C3h
01C7 0023 R DW NextStep ; JP NextStep ;10t
; ;63t==(10MHz)6.3usec
; 0< ( n -- t )
; Return true if n is negative.
$CODE 2,'0<',ZLESS
01C9 01BC R 1 DW _LINK
01CB
01CB 02 30 3C 1 DB 2,'0<'
01CE 1 ZLESS:
01CE E1 DB 0E1h ; POP HL ;10t
01CF 29 DB 29h ; ADD HL, HL ;11t
01D0 DA DB 0DAh ; JR C, LESSZ ;12/7t
01D1 01D9 R DW LESSZ
01D3 21 00 00 DB 21h, 00h, 00h ; LD HL, 0 ;10t
01D6 C3 DB 0C3h
01D7 0022 R DW PUSHHL ; JP NextStep ;10t 59t==(10MHz)5.9usec
01D9 LESSZ: ;
01D9 21 FF FF DB 21h,0FFh,0FFh ;LESSZ: LD HL, 0FFFFH ;10t
01DC C3 DB 0C3h
01DD 0022 R DW PUSHHL ; JP NextStep ;10t 64t==(10MHz)6.4usec
; AND ( w w -- w )
; Bitwise AND.
$CODE 3,'AND',ANDD
01DF 01CB R 1 DW _LINK
01E1
01E1 03 41 4E 44 1 DB 3,'AND'
01E5 1 ANDD:
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 11 - 1
01E5 D1 DB 0D1h ; POP DE
01E6 E1 DB 0E1h ; POP HL
01E7 7B DB 7Bh ; LD A, E
01E8 A5 DB 0A5h ; AND L
01E9 6F DB 6Fh ; LD L, A
01EA 7A DB 7Ah ; LD A, D
01EB A4 DB 0A4h ; AND H
01EC 67 DB 67h ; LD H, A
01ED E5 DB 0E5h ; PUSH HL
01EE C3 DB 0C3h
01EF 0023 R DW NextStep ; JP NextStep
; OR ( w w -- w )
; Bitwise inclusive OR.
$CODE 2,'OR',ORR
01F1 01E1 R 1 DW _LINK
01F3
01F3 02 4F 52 1 DB 2,'OR'
01F6 1 ORR:
01F6 D1 DB 0D1h ; POP DE
01F7 E1 DB 0E1h ; POP HL
01F8 7B DB 7Bh ; LD A, E
01F9 B5 DB 0B5h ; OR L
01FA 6F DB 6Fh ; LD L, A
01FB 7A DB 7Ah ; LD A, D
01FC B4 DB 0B4h ; OR H
01FD 67 DB 67h ; LD H, A
01FE E5 DB 0E5h ; PUSH HL
01FF C3 DB 0C3h
0200 0023 R DW NextStep ; JP NextStep
; XOR ( w w -- w )
; Bitwise exclusive OR.
$CODE 3,'XOR',XORR
0202 01F3 R 1 DW _LINK
0204
0204 03 58 4F 52 1 DB 3,'XOR'
0208 1 XORR:
0208 D1 DB 0D1h ; POP DE
0209 E1 DB 0E1h ; POP HL
020A 7B DB 7Bh ; LD A, E
020B AD DB 0ADh ; XOR L
020C 6F DB 6Fh ; LD L, A
020D 7A DB 7Ah ; LD A, D
020E AC DB 0ACh ; XOR H
020F 67 DB 67h ; LD H, A
0210 E5 DB 0E5h ; PUSH HL
0211 C3 DB 0C3h
0212 0023 R DW NextStep ; JP NextStep
; UM+ ( u u -- udsum )
; Add two unsigned single numbers and return a double sum.
$CODE 3,'UM+',UPLUS
0214 0204 R 1 DW _LINK
0216
0216 03 55 4D 2B 1 DB 3,'UM+'
021A 1 UPLUS:
021A D1 DB 0D1h ; POP DE ;10t
021B E1 DB 0E1h ; POP HL ;10t
021C 19 DB 19h ; ADD HL, DE ;11t
021D E5 DB 0E5h ; PUSH HL ;11t
021E DA DB 0DAh ; JR C, CARRY ;12/7t
021F 0228 R DW CARRY
0221 21 00 00 DB 21h, 00h, 00h ; LD HL, 0 ;10t
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 12 - 1
0224 E5 DB 0E5h ; PUSH HL ;11t
0225 C3 DB 0C3h
0226 0023 R DW NextStep ; JP NextStep ;10t
0228 CARRY: ;
0228 21 01 00 DB 21h, 01h, 00h ;CARRY: LD HL, 1 ;10t
022B E5 DB 0E5h ; PUSH HL ;11t
022C C3 DB 0C3h
022D 0023 R DW NextStep ; JP NextStep ;10t
;; System and user variables
; doVAR ( -- a )
; Run time routine for VARIABLE and CREATE.
$COLON COMPO+5,'doVar',DOVAR
022F 0216 R 2 DW _LINK
0231
0231 45 64 6F 56 61 72 2 DB COMPO+5,'doVar'
0237 2 DOVAR:
0237 CD 1 DB CALLL
0238 0081 R 1 DW DOLST
023A 0133 R 00F1 R DW RFROM,EXIT
; UP ( -- a )
; Pointer to the user area.
$COLON 2,'up',UP
023E 0231 R 2 DW _LINK
0240
0240 02 75 70 2 DB 2,'up'
0243 2 UP:
0243 CD 1 DB CALLL
0244 0081 R 1 DW DOLST
0246 0237 R DW DOVAR
0248 1FE0 DW UPP
; doUSER ( -- a )
; Run time routine for user variables.
$COLON COMPO+6,'doUser',DOUSE
024A 0240 R 2 DW _LINK
024C
024C 46 64 6F 55 73 65 2 DB COMPO+6,'doUser'
72
0253 2 DOUSE:
0253 CD 1 DB CALLL
0254 0081 R 1 DW DOLST
0256 0133 R 010E R 0243 R DW RFROM,AT,UP,AT,PLUS,EXIT
010E R 032B R 00F1 R
; BASE ( -- a )
; Storage of the radix base for numeric I/O.
$USER 4,'BASE',BASE
0262 024C R 2 DW _LINK
0264
0264 04 42 41 53 45 2 DB 4,'BASE'
0269 2 BASE:
0269 CD 1 DB CALLL
026A 0081 R 1 DW DOLST
026C 0253 R 0000 1 DW DOUSE,_USER
; tmp ( -- a )
; A temporary storage location used in parse and find.
$USER COMPO+3,'tmp',TEMP
0270 0264 R 2 DW _LINK
0272
0272 43 74 6D 70 2 DB COMPO+3,'tmp'
0276 2 TEMP:
0276 CD 1 DB CALLL
0277 0081 R 1 DW DOLST
0279 0253 R 0002 1 DW DOUSE,_USER
; >IN ( -- a )
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 13 - 1
; Hold the character pointer while parsing input stream.
$USER 3,'>IN',INN
027D 0272 R 2 DW _LINK
027F
027F 03 3E 49 4E 2 DB 3,'>IN'
0283 2 INN:
0283 CD 1 DB CALLL
0284 0081 R 1 DW DOLST
0286 0253 R 0004 1 DW DOUSE,_USER
; #TIB ( -- a )
; Hold the current count in and address of the terminal input buffer.
$USER 4,'#TIB',NTIB
028A 027F R 2 DW _LINK
028C
028C 04 23 54 49 42 2 DB 4,'#TIB'
0291 2 NTIB:
0291 CD 1 DB CALLL
0292 0081 R 1 DW DOLST
0294 0253 R 0006 1 DW DOUSE,_USER
= 000A _USER = _USER+CELLL ;hold the base address of the terminal input buffer
; 'EVAL ( -- a )
; Execution vector of EVAL.
$USER 5,"'eval",TEVAL
0298 028C R 2 DW _LINK
029A
029A 05 27 65 76 61 6C 2 DB 5,"'eval"
02A0 2 TEVAL:
02A0 CD 1 DB CALLL
02A1 0081 R 1 DW DOLST
02A3 0253 R 000A 1 DW DOUSE,_USER
; HLD ( -- a )
; Hold a pointer in building a numeric output string.
$USER 3,'hld',HLD
02A7 029A R 2 DW _LINK
02A9
02A9 03 68 6C 64 2 DB 3,'hld'
02AD 2 HLD:
02AD CD 1 DB CALLL
02AE 0081 R 1 DW DOLST
02B0 0253 R 000C 1 DW DOUSE,_USER
; CONTEXT ( -- a )
; A area to specify vocabulary search order.
$USER 7,'CONTEXT',CNTXT
02B4 02A9 R 2 DW _LINK
02B6
02B6 07 43 4F 4E 54 45 2 DB 7,'CONTEXT'
58 54
02BE 2 CNTXT:
02BE CD 1 DB CALLL
02BF 0081 R 1 DW DOLST
02C1 0253 R 000E 1 DW DOUSE,_USER
; CP ( -- a )
; Point to the top of the code dictionary.
$USER 2,'cp',CP
02C5 02B6 R 2 DW _LINK
02C7
02C7 02 63 70 2 DB 2,'cp'
02CA 2 CP:
02CA CD 1 DB CALLL
02CB 0081 R 1 DW DOLST
02CD 0253 R 0010 1 DW DOUSE,_USER
; LAST ( -- a )
; Point to the last name in the name dictionary.
$USER 4,'last',LAST
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 14 - 1
02D1 02C7 R 2 DW _LINK
02D3
02D3 04 6C 61 73 74 2 DB 4,'last'
02D8 2 LAST:
02D8 CD 1 DB CALLL
02D9 0081 R 1 DW DOLST
02DB 0253 R 0012 1 DW DOUSE,_USER
;; Common functions
; ?DUP ( w -- w w | 0 )
; Dup tos if its is not zero.
$COLON 4,'?DUP',QDUP
02DF 02D3 R 2 DW _LINK
02E1
02E1 04 3F 44 55 50 2 DB 4,'?DUP'
02E6 2 QDUP:
02E6 CD 1 DB CALLL
02E7 0081 R 1 DW DOLST
02E9 01A7 R DW DUPP
02EB 00C2 R 02F1 R DW QBRAN,QDUP1
02EF 01A7 R DW DUPP
02F1 QDUP1:
02F1 00F1 R DW EXIT
; ROT ( w1 w2 w3 -- w2 w3 w1 )
; Rot 3rd item to top.
$COLON 3,'ROT',ROT
02F3 02E1 R 2 DW _LINK
02F5
02F5 03 52 4F 54 2 DB 3,'ROT'
02F9 2 ROT:
02F9 CD 1 DB CALLL
02FA 0081 R 1 DW DOLST
02FC 0155 R 01B4 R 0133 R DW TOR,SWAP,RFROM,SWAP,EXIT
01B4 R 00F1 R
; 2DROP ( w w -- )
; Discard two items on stack.
$COLON 5,'2DROP',DDROP
0306 02F5 R 2 DW _LINK
0308
0308 05 32 44 52 4F 50 2 DB 5,'2DROP'
030E 2 DDROP:
030E CD 1 DB CALLL
030F 0081 R 1 DW DOLST
0311 019D R 019D R 00F1 R DW DROP,DROP,EXIT
; 2DUP ( w1 w2 -- w1 w2 w1 w2 )
; Duplicate top two items.
$COLON 4,'2DUP',DDUP
0317 0308 R 2 DW _LINK
0319
0319 04 32 44 55 50 2 DB 4,'2DUP'
031E 2 DDUP:
031E CD 1 DB CALLL
031F 0081 R 1 DW DOLST
0321 01C1 R 01C1 R 00F1 R DW OVER,OVER,EXIT
; + ( w w -- sum )
; Add top two items.
$COLON 1,'+',PLUS
0327 0319 R 2 DW _LINK
0329
0329 01 2B 2 DB 1,'+'
032B 2 PLUS:
032B CD 1 DB CALLL
032C 0081 R 1 DW DOLST
032E 021A R 019D R 00F1 R DW UPLUS,DROP,EXIT
; NOT ( w -- w )
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 15 - 1
; One's complement of tos.
$COLON 3,'NOT',INVER
0334 0329 R 2 DW _LINK
0336
0336 03 4E 4F 54 2 DB 3,'NOT'
033A 2 INVER:
033A CD 1 DB CALLL
033B 0081 R 1 DW DOLST
033D 006E R FFFF 0208 R DW DOLIT,-1,XORR,EXIT
00F1 R
; NEGATE ( n -- -n )
; Two's complement of tos.
$COLON 6,'NEGATE',NEGAT
0345 0336 R 2 DW _LINK
0347
0347 06 4E 45 47 41 54 2 DB 6,'NEGATE'
45
034E 2 NEGAT:
034E CD 1 DB CALLL
034F 0081 R 1 DW DOLST
0351 033A R 05E2 R 00F1 R DW INVER,ONEP,EXIT
; DNEGATE ( d -- -d )
; Two's complement of top double.
$COLON 7,'DNEGATE',DNEGA
0357 0347 R 2 DW _LINK
0359
0359 07 44 4E 45 47 41 2 DB 7,'DNEGATE'
54 45
0361 2 DNEGA:
0361 CD 1 DB CALLL
0362 0081 R 1 DW DOLST
0364 033A R 0155 R 033A R DW INVER,TOR,INVER
036A 006E R 0001 021A R DW DOLIT,1,UPLUS
0370 0133 R 032B R 00F1 R DW RFROM,PLUS,EXIT
; - ( n1 n2 -- n1-n2 )
; Subtraction.
$COLON 1,'-',SUBBB
0376 0359 R 2 DW _LINK
0378
0378 01 2D 2 DB 1,'-'
037A 2 SUBBB:
037A CD 1 DB CALLL
037B 0081 R 1 DW DOLST
037D 034E R 032B R 00F1 R DW NEGAT,PLUS,EXIT
; ABS ( n -- n )
; Return the absolute value of n.
$COLON 3,'ABS',ABSS
0383 0378 R 2 DW _LINK
0385
0385 03 41 42 53 2 DB 3,'ABS'
0389 2 ABSS:
0389 CD 1 DB CALLL
038A 0081 R 1 DW DOLST
038C 01A7 R 01CE R DW DUPP,ZLESS
0390 00C2 R 0396 R DW QBRAN,ABS1
0394 034E R DW NEGAT
0396 ABS1:
0396 00F1 R DW EXIT
; = ( w w -- t )
; Return true if top two are equal.
$COLON 1,'=',EQUAL
0398 0385 R 2 DW _LINK
039A
039A 01 3D 2 DB 1,'='
Microsoft (R) Macro Assembler Version 6.14.8444 03/23/16 18:30:36
80eF202 Page 16 - 1
039C 2 EQUAL:
039C CD 1 DB CALLL
039D 0081 R 1 DW DOLST
039F 0208 R DW XORR
03A1 00C2 R 03AB R DW QBRAN,EQU1
03A5 006E R 0000 00F1 R DW DOLIT,0,EXIT
03AB EQU1:
03AB 006E R FFFF 00F1 R DW DOLIT,TRUEE,EXIT
; U< ( u u -- t )