-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathTinybasic_IL_Fixed.asm
2130 lines (2115 loc) · 68.7 KB
/
Tinybasic_IL_Fixed.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
; Netronic TinyBasic For The ELF II Recreation
; By Richard Peters, [email protected]
; Special THANKS to TOM PITTMAN for Writing Program,
; To LEE A. HART for Posting Necessary Parts
; And To Dave Ruske for creating COMACELF group
; Which Made This Recreation Possible
; Assembled With QELFEXE V2.0 Multiformat Assembler
; Current Code Running In Tinybasi.zip Emulator
; Requires Giant Board And ROM Monitor
; To Use LOAD And SAVE to Tape
; Designed to run In RAM Starting at 0000
; I Have Done What I Could To Make This Source
; Moveable And To Follow Itself, But I Still Could
; Could Have Missed Something. I Also Tried To Figure
; Out Some Of The IL Code and Add Comments To It.
; If There Is Something To Add Or Change, Let Me Know.
; Code Has Only Been Verified With What I Have
; Hope The Above Changes Soon.
; Last Update 01/29/2004 09:40PM
;
; INTERNAL MACRO DEFINITIONS
;
; CALL = SEP R4 + DW SUB LOCATION
; RETURN = SEP R5
; SEP R7 = SEP R7 + DB LOW LOCATION OF BYTE
;
FETCH MACRO address
SEP R7
db (address)&255
ENDM
CALL MACRO address
SEP R4
dw address
ENDM
RETURN MACRO
SEP R5
ENDM
SERIAL_B MACRO address
B4 address
ENDM
SERIAL_BN MACRO address
BN4 address
ENDM
KB_B MACRO address
B3 address
ENDM
KB_BN MACRO address
BN3 address
ENDM
KB_INP MACRO address
INP 7
ENDM
LDI0 MACRO
GHI RD
ENDM
R0 EQU 0 ;REGISTER DEFINITION
R1 EQU 1 ;REGISTER DEFINITION
R2 EQU 2 ;REGISTER DEFINITION
R3 EQU 3 ;REGISTER DEFINITION
R4 EQU 4 ;REGISTER DEFINITION
R5 EQU 5 ;REGISTER DEFINITION
R6 EQU 6 ;REGISTER DEFINITION
R7 EQU 7 ;REGISTER DEFINITION
R8 EQU 8 ;REGISTER DEFINITION
R9 EQU 9 ;REGISTER DEFINITION
RA EQU 10 ;REGISTER DEFINITION
RB EQU 11 ;REGISTER DEFINITION
RC EQU 12 ;REGISTER DEFINITION
RD EQU 13 ;REGISTER DEFINITION
RE EQU 14 ;REGISTER DEFINITION
RF EQU 15 ;REGISTER DEFINITION
;
; The Following Register And EQU Assignments Are Not Used
; In Every Part Of Program
;
; REGISTER ASSIGNMENTS:
;
; 0 ; PC (VIA RESET) AT ENTRY
; 1 ; INTERRUPT PROGRAM COUNTER
; 2 ; STACK POINTER
; 3 ; NORMAL PROGRAM COUNTER
; 4 ; BASIC: SCRT "CALL" PC
; 5 ; BASIC: SCRT "RETURN" PC
; 6 ; BASIC: SCRT RETURN ADDR.
; 7 ; BASIC: PC FOR "FECH"
XX EQU 8 ;BASIC: WORK REGISTER
PC EQU 9 ;IL PROGRAM COUNTER
AC EQU 10 ;BASIC: 16-BIT ACCUMULATOR
BP EQU 11 ;BASIC POINTER
; 12 SERIAL AND TAPE ROUTINES
PZ EQU 13 ;BASE: PAGE 0 POINTER
; 14 ; RE.0=BAUD RATE CONSTANT
; IF RE.0=0 USES 1861 AND KEYBOARD P7,EF3
; RE.1= USED FOR INPUT,OUTPUT
X EQU 15 ;BASIC: SCRATCH REGISTER
;
; DISPLAY BUFFER EQU
;
BUFF EQU 0DB0h ;ONLY CHANGE PAGE, UNLESS YOU
BUFE EQU BUFF+344 ;WANT TO CHANGE INTERUPT ROUTINE
BUFX EQU BUFE+56 ;ALSO LIMITED TO 1DB0 BY PLOT
;
MONITOR EQU 0F000h ;Monitor address
;Putting C8 in first byte allows Monitor To Run instead of Tiny
PAGE LBR COLDV
LBR MONITOR
SEP R0
IDL
;
; DATA AREA, COULD BE EQUATES
;
TVXY DB 00Fh ;DISPLAY CURSOR LOCATION
DB 000h
DB 000h ;BIT LOCATION OF CURSOR
DB 000h
MASK DB 0E0h
TIME_ DB 09Ah
DB 027h
DB 03Ah
DB 000h
DB 000h
DB 000h
BS DB 008h
CAN DB 01Bh
PAD DB 000h
TAPEMODE DB 000h
SPARE DB 019h
XEQ DB 019h
LEND DB 034h
AEPTR DB 080h
TTYCC DB 000h
NXA DW STMT ;START OF Statements
AIL DW STRT ;START OF IL
BASIC DW 00F40h ;LOWEST ADD. FOR PROGRAM
STACK DW 03FF7h ;HIGHEST ADD. FOR PROGRAM
MEND DW 0109Bh ;PROGRAM END + STACK RESERVE
TOPS DW 03FF7h ;TOP OF GOSUB STACK
LINO DW 000AAh ;CURRENT BASIC LINE NUMBER
WORK DW 01083h
DW 00034h
SP DW 00033h
LINE DW 00000h ;INPUT LINE BUFFER
;
ORG 080h
AESTK DW 00000h ;RANDOM NUMBER GEN.
DW 00000h ;VAR. A
DW 00000h ;VAR. B
DW 00000h ;VAR. C
DW 00000h ;VAR. D
DW 00000h ;VAR. E
DW 00000h ;VAR. F
DW 00000h ;VAR. G
DW 00000h ;VAR. H
DW 00000h ;VAR. I
DW 00000h ;VAR. J
DW 00000h ;VAR. K
DW 00000h ;VAR. L
DW 00000h ;VAR. M
DW 00000h ;VAR. N
DW 00000h ;VAR. O
DW 00000h ;VAR. P
DW 00000h ;VAR. Q
DW 00000h ;VAR. R
DW 00000h ;VAR. S
DW 00000h ;VAR. T
DW 00000h ;VAR. U
DW 00000h ;VAR. V
DW 00000h ;VAR. W
DW 00000h ;VAR. X
DW 00000h ;VAR. Y
DW 00000h ;VAR. Z
Z165 PLO R7 ;I/O ROUTINES
LBDF PEND ;GOTO WARM START
GHI RD
Z149 KB_B Z148 ;CHECK FOR KEYBOARD OR SERIAL
SERIAL_B Z149 ;INPUT
Z150 KB_B Z148
SERIAL_BN Z150 ;FINED TIMING OF SERIAL INPUT
SEQ
Z153 PLO RE
LDI 8
Z151 SMI 1
BNZ Z151
GLO RE
ADI 2
BNQ Z152
SERIAL_B Z153
REQ
Z152 SERIAL_BN Z153 ;MUST GOTO #C4
NOP ;|
NOP ;|
SMI 1 ;|
SERIAL_BN Z154 ;|
BNZ Z152+1 ;BECAUSE OF THIS
INC RE
Z154 GLO RE
SMI 6
Z148 PHI RE
LDI 00Ch
CALL OUTPUTR ;OUTPUT 0C CLEARSCREEN
LBR CLEAR
BRKTST ADI 0 ;BREAK TEST
GHI RE
BNZ Z156
KB_BN Z157
LSKP
Z156 SERIAL_B Z157
SMI 0
SERIAL_DELAY GHI RE
ANI 0FEh
Z158 PLO RE
LSZ
DEC RE
GLO RE
BNZ Z158
Z157 RETURN
COLDV NOP ;COLD START
BR COLD
LBR WARM ;WARM START ENTRY
KEYV LBR INPUTR ;BRANCH TO CHARATER INPUT
TYPEV LBR OUTPUTR ;BRANCH TO CHARATER OUPUT
BREAKV LBR BRKTST ;BRANCH TO BREAK TEST
; DEFAULTS LOADED TO DIRECT PAGE
DB 008h ;BACKSPACE CODE
DB 01Bh ;LINE CANCEL CODE
DB 000h ;PAD CHARATER
DB 000h ;TAPE MODE ENABLE FLAG 80=ENABLED
DB 019h ;SPARE STACK SIZE
ILPEEK BR PEEK ;BRANCH TO PEEK
DB 000h
DB 000h
ILPOKE DB 058h ;POKE
DB 0D5h
DW STRT ;ADDRESS OF IL PROGRAM START
CONST DW 00F40h ;DEFAULT START OF PROGRAM SPACE
DB 07Fh ;END MEM STOP
DB 000h
; END DEFAULTS
LDA R8 ;DOUBLE PEEK ENTRY
SKP
PEEK GHI RD ;PEEK ENTRY
PHI RA
LDA R8
RETURN
ILINPOUT LBR IO
CALL_S SEP R3
CALL_ PHI RF ;CALL ROUTINE
SEX R2
GLO R6
STXD
GHI R6
STXD
GLO R3
PLO R6
GHI R3
PHI R6
LDA R6
PHI R3
LDA R6
PLO R3
GHI RF
BR CALL_S
RETURN_S SEP R3
RETURN_ PHI RF ;RETURN ROUTINE
SEX R2
GHI R6
PHI R3
GLO R6
PLO R3
INC R2
LDA R2
PHI R6
LDN R2
PLO R6
GHI RF
BR RETURN_S
SEP R3
FETCH_ LDA R3 ;LOAD TEMP IMMEDIATE ROUTINE
PLO RD
LDI (PAGE)&255 ;MEMORY BASE PAGE
PHI RD
LDA RD
SEX RD ;AND SET X TO D AND +
BR FETCH_-1
TABLE DW BACK
DW HOP
DW MATCH
DW TSTV
DW TSTN
DW TEND
DW RTN
DW HOOK
DW WARM
DW XINIT
DW CLEAR
DW INSRT
DW RETN
DW RETN
DW GETLN
DW RETN
DW RETN
DW STRNG
DW CRLF
DW TAB
DW PRS
DW PRN
DW LIST
DW RETN
DW NXT
DW CMPR
DW IDIV
DW IMUL
DW ISUB
DW IADD
DW INEG
DW XFER
DW RSTR
DW SAV
DW STORE
DW IND
DW RSBP
DW SVBP
DW RETN
DW RETN
DW BPOP
DW APOP
DW DUPS
DW LITN
DW LIT1
DW RETN
TBEND:
; COLD & WARM START INITIALIZATION ;
;
; COLD START;
;
COLD LDI ($+3)&255 ;CHANGE PROGRAM COUNTER
PLO R3 ;FROM R0 TO R3
LDI ($)>>8
PHI R3
SEP R3
; DETERMINE SIZE OF USER RAM
PHI AC ;GET LOW END ADDR.
LDI (CONST)&255 ;OF USER PROGRAM
PLO AC ;RAM (AT "CONST")
LDA AC
PHI R2 ;..AND PUT IN R2
LDA AC
PLO R2
LDA AC ;SET PZ TO WRAP POINT
PHI PZ ;(END OF SEARCH)
LDI 0FFh
PLO PZ
LDN PZ ;..AND SAVE BYTE
PHI X ;NOW AT ADDR. PZ
SCAN SEX R2 ;REPEAT TO SEARCH RAM..
INC R2 ;- GET NEXT BYTE
LDX
PLO X ;- SAVE A COPY
XRI 0FFh ;- COMPLEMENT IT
STR R2 ;- STORE IT
XOR ;- SEE IF IT WORKED
SEX PZ
LSNZ ;- IF MATCHES, IS RAM
GHI X ;SET CARRY IF AT
XOR ;WRAP POINT..
ADI 0FFh ;- ELSE IS NOT RAM
GLO X ;RESTORE ORIGINAL BYTE
STR R2
BNF SCAN ;- ..UNTIL END OR WRAP POINT
DEC R2
LDN AC ;RAM SIZED: SET
PHI PZ ;POINTER PZ TO
LDI STACK+1 ;WORK AREA
PLO PZ
GLO R2 ;STORE RAM END ADDRESS
STXD
GHI R2
STXD ;GET & STORE RAM BEGINNIG
DEC AC ;REPEAT TO COPY PARAMETERS..
DEC AC ;- POINT TO NEXT
LDN AC ;- GET PARAMETER
STXD ;- STORE IN WORK AREA
GLO PZ
XRI BS-1 ;- TEST FOR LAST PARAMETER
BNZ $-6 ;- ..UNTIL LAST COPIED
SHR ;SET DF=0 FOR "CLEAR"
LSKP
;
; WARM START:
;
WARM SMI 0 ;SET DF=1 FOR "DON'T CLEAR"
LDI ($+3)&255
PLO R3 ;BE SURE PROGRAM COUNTER IS R3
LDI ($)>>8
PHI R3
SEP R3
PHI R4 ;INITIALIZE R4, R5, R7
PHI R5 ;ASSUMES CALL,RETURN,FETCH
PHI R7 ;IS IN SAME PAGE AS WARM
LDI (CALL_)&255
PLO R4
LDI (RETURN_)&255
PLO R5
LDI (FETCH_)&255
LBR Z165 ;GOTO #00B6
CLEAR FETCH BASIC;- MARK PROGRAM EMPTY
PHI BP
LDA PZ
PLO BP
LDI0 ;WITH LINE# = 0
STR BP
INC BP
STR BP
FETCH SPARE-1 ;SET MEND = START + SPARE
GLO BP ;GET START
ADD ;ADD ;LOW BYTE OF SPARE
PHI X ;SAVE TEMPORARILY
FETCH MEND ;GET MEND
GHI X
STXD ;STORE LOW BYTE OF MEND
GHI BP
ADCI 0 ;ADD CARRY
STXD ;STORE ;HIGH BYTE OF MEND
PEND FETCH STACK ;SET STACK TO END OF MEMORY
PHI R2
LDA PZ
PLO R2
FETCH TOPS
GLO R2 ;SET TOPS TO EMPTY
STXD ;(I.E. STACK END)
GHI R2
STXD
CALL FORCE ;SET TAPE MODE "OFF"
IIL FETCH AIL ;SET IL PC
PHI PC
LDA PZ
PLO PC ;CONTINUE INTO "NEXT"
;
; EXECUTE NEXT INTERMEDIATE LANGUAGE (IL) INSTRUCTION
;
NEXT SEX R2 ;GET OPCODE
LDA PC
SMI 030h ;IF JUMP OR BRANCH,
BDF TBR ;GO HANDLE IT
SDI 0D7h ;IF STACK BYTE EXCHANGE,
BDF XCHG ;GO HANDLE IT
SHL ;ELSE ;MULTIPLY BY 2
ADI (TBEND)&255 ;TO POINT INTO TABLE
PLO R6
LDI (NEXT)&255 ;& SET RETURN TO HERE
DEC R2 ;(DUMMY STACK ENTRY)
DEC R2
STXD
GHI R3
STXD
DOIT GHI R7 ;TABLE PAGE
PHI R6
LDA R6 ;FETCH SERVICE ADDRESS
STR R2
LDA R6
PLO R6
LDX
PHI R6
SEP R5 ;GO DO IT
;
TBR SMI 010h ;IF JUMP OR CALL,
BNF TJMP ;GO DO IT
PLO R6 ;ELSE BRANCH; SAVE OPCODE
ANI 01Fh ;COMPUTE DESTINATION
BZ TBERR ;IF BRANCh, 0ADh DR = 0, GOTO ERROR
STR R2 ;PUSh, 0ADh DRESS ONTO STACK
GLO PC ;ADD RELATIVE OFFSET
ADD ;LOW BYTE
STXD
GHI PC ;HIGH BYTE W. CARRY
ADCI 0
SKP
TBERR STXD ;STORE 0 FOR ERROR
STXD
GLO R6 ;NOW COMPUTE SERVICE ADDRESS
SHR ;WHICH ;IS HIGH 3 BITS
SHR
SHR
SHR
ANI 0FEh
ADI (TABLE)&255 ;INDEX INTO TABLE
PLO R6
BR DOIT
;
TJMP ADI 8 ;NOTE IF JUMP IN CARRY
ANI 7 ;GET ADDRESS
PHI R6
LDA PC
PLO R6
BDF JMP ;JUMP
GLO PC ;PUSH PC
STXD
GHI PC
STXD
CALL STEST ;CHECK STACK DEPTH
;
JMP FETCH AIL ;ADD JUMP ADDRESS TO IL BASE
GLO R6
ADD
PLO PC
GHI R6
DEC PZ
ADC
PHI PC
BR NEXT
;
XCHG SDI 7 ;SAVE OFFSET
STR R2
FETCH AEPTR
PLO PZ
SEX R2
ADD
PLO R6 ;R6 IS OTHER POINTER
GHI PZ
PHI R6
LDN PZ ;NOW SWAP THEM:
STR R2 ;SAVE OLD TOP
LDN R6 ;GET INNER BYTE
STR PZ ;PUT ON TOP
LDN R2 ;GET OLD TOP
STR R6 ;PUT IN
BR NEXT
;
BACK GLO R6 ;REMOVE OFFSET
SMI 020h ;FOR BACKWARDS HOP
PLO R6
GHI R6
SMBI 0
SKP
;
HOP GHI R6 ;FORWARD HOP
LBZ ERR ;IF ZERO, GOTO ERROR
PHI PC ;ELSE PUT INTO PC
GLO R6
PLO PC
BR NEXT
;
INC BP ;ADVANCE TO NEXT NON-BLANK CHAR.
NONBL LDN BP ;GET CHARACTER
SMI 020h ;IF BLANK,
BZ NONBL-1 ;INCREMENT POINTER AND TRY AGAIN
SMI 010h ;IF NUMERIC (0-9),
LSNF
SDI 9 ;SET DF=1
NONBX LDN BP ;GET CHARACTER
RETURN AND ;RETURN
;
STORE CALL APOP ;GET VARIABLE
LDA PZ ;GET POINTER
PLO PZ
GHI AC ;STORE THE NUMBER
STR PZ
INC PZ
GLO AC
STR PZ
BR BPOP ;GO POP POINTER
;
CALL APOP ;POP 4 BYTES
APOP CALL BPOP ;POP 2 BYTES
PHI AC ;FIRST BYTE TO AC.1
BPOP FETCH AEPTR ;POP 1 BYTE
DEC PZ
ADI 1 ;INCREMENT
STR PZ
PLO PZ
DEC PZ
LDA PZ ;LEAVE IT IN D
PLO AC ;AND AC.0
RETN RETURN
;
TEND CALL NONBL ;GET NEXT CHARACTER
XRI 00Dh ;IF CARRIAGE RETURN,
BZ NEXT ;THEN FALL THRU IN IL
BR HOP ;ELSE TAKE BRANCH
;
TSTV CALL NONBL ;GET NEXT CHARACTER
SMI 041h ;IF LESS THAN 'A',
BNF HOP ;THEN HOP
SMI 01Ah ;IF GREATER THAN 'Z'
BDF HOP ;THEN HOP
INC BP ;ELSE IS LETTER A-Z
GHI X ;GET SAVED COPY
SHL ;CONVERT ;TO VARIABLE'S ADDRESS
CALL BPUSH ;AND PUSH ONTO STACK
BR NEXT
;
TSTN CALL NONBL ;GET NEXT CHARACTER
BNF HOP ;IF NOT A DIGIT, HOP
LDI0 ;ELSE COMPUTE NUMBER
PHI AC ;INITIALLY 0
PLO AC
CALL APUSH ;PUSH ONTO STACK
NUMB LDA BP ;GET CHARACTER
ANI 00Fh ;CONVERT FROM ASCII TO NUMBER
PLO AC
LDI0
PHI AC
LDI 10 ;ADD 10 TIMES THE..
PLO X
SEX PZ
NM10 INC PZ
GLO AC ;..PREVIOUS VALUE..
ADD
PLO AC
GHI AC
DEC PZ ;..WHICH IS ON STACK.
ADC
PHI AC
DEC X ;COUNT THE ITERATIONS
GLO X
BNZ NM10
GHI AC ;SAVE NEW VALUE
STR PZ
INC PZ
GLO AC
STXD
CALL NONBL ;IF ANY MORE DIGITS,
LBDF NUMB ;THEN DO IT AGAIN
NHOP LBR NEXT ;UNTIL DONE
;
MATCH GHI BP ;SAVE PB IN CASE NO MATCH
PHI AC
GLO BP
PLO AC
MAL CALL NONBL ;GET A BYTE (IN CAPS)
;
INC BP ;COMPARE THEM
STR R2
LDA PC
XOR
BZ MAL ;STILL EQUAL
XRI 80H ;END?
BZ NHOP ;YES
GHI AC ;NO GOOD
PHI BP ;PUT POINTER BACK
GLO AC
PLO BP
JHOP LBR HOP ;THEN TAKE BRANCH
;
STEST FETCH MEND ;POINT TO PROGRAM END
GLO R2 ;COMPARE TO STACK TOP
SD
DEC PZ
GHI R2
SDB
BDF ERR ;AHA; OVERFLOW
RETURN ;ELSE ;EXIT
;
LIT1 LDA PC ;ONE BYTE
BR BPUSH
LITN LDA PC ;TWO BYTES
PHI AC ;FIRST IS HIGH BYTE,
LDA PC ;THEN LOW BYTE
BR APUSH+1 ;PUSH RESULT ONTO STACK
;
HOOK CALL HOOP ;GO DO IT, LEAVE EXIT HERE
BR APUSH+1 ;PUSH RESULT ONTO STACK
;
DUPS CALL APOP ;POP 2 BYTES INTO AC
CALL APUSH ;THEN PUSH TWICE
APUSH GLO AC ;PUSH 2 BYTES
CALL BPUSH
GHI AC
BPUSH STR R2 ;PUSH ONE BYTE (IN D)
FETCH LEND ;CHECK FOR OVERFLOW
SM ;COMPARE ;AEPTR TO LEND
BDF ERR ;OOPS!
LDI 1
SD
STR PZ
PLO PZ
LDN R2 ;GET SAVED BYTE
STR PZ ;STORE INTO STACK
SEP5 RETURN ; & RETURN
;
IND CALL BPOP ;GET POINTER
PLO PZ
LDA PZ ;GET VARIABLE
PHI AC
LDA PZ
BR APUSH+1 ;GO PUSH IT
;
QUOTE XRI 02Fh ;TEST FOR QUOTE
BZ SEP5 ;IF QUOTE, GO EXIT
XRI 022h ;ELSE RESTORE CHARACTER
CALL TYPER
PRS LDA BP ;GET NEXT BYTE
XRI 00Dh ;IF NOT CARRIAGE RETURN,
BNZ QUOTE ;THEN CONTINUE
DEC PC ;ELSE CONTINUE INTO ERROR
;
ERR FETCH XEQ ;ERROR:
PHI XX ;SAVE XEQ FLAG
CALL FORCE ;TURN TAPE MODE OFF
LDI "!" ;PRINT "!" ON NEW LINE
CALL TYPER
FETCH AIL
GLO PC ;CONVERT IL PC TO ERROR#
SM ;BY ;SUBTRACTING
PLO AC ;IL START FROM PC
GHI PC
DEC PZ ;X MUST POINT TO
SMB ;PAGE0 ;REGISTER PZ=RD
PHI AC
CALL PRNA ;PRINT ERROR#
GHI XX ;GET XEQ FLAG
BZ BELL ;IF XEQ SET,
LDI (ATMSG)&255 ;- THEN TYPE "AT"
PLO PC
GHI R3
PHI PC
CALL STRNG
FETCH LINO ;- GET LINE NUMBER
PHI AC ;- AND PRINT IT, TOO
LDA PZ
PLO AC
CALL PRNA
BELL LDI 7 ;RING THE BELL
CALL TYPEV
CALL CRLF ;PRINT <CR><LF>
FIN FETCH TTYCC-1
LDI0 ;TURN TAPE MODE OFF
STR PZ
EXIT FETCH TOPS ;RESET STACK POINTER
PHI R2
LDA PZ
PLO R2
LBR IIL ;RESTART IL FROM BEGINNING
;
ATMSG DB ' ','A','T' ;ERROR MESSAGE TEMPLATE
DB ' ', 0A3H
;
TSTR CALL TYPER-2 ;PRINT CHARACTER STRING
STRNG LDA PC ;GET NEXT CHARACTER OF STRING
ADI 080h ;IF HI BIT=0,
BNF TSTR ;THEN GO PRINT & CONTINUE
BR TYPER-2 ;PRINT LAST CHAR AND EXIT
;
FORCE FETCH AEPTR-1
LDI AESTK ;CLEAR A.E.STACK
STXD
LDI0 ;SET "NOT EXECUTING"
STXD ;LEND=0 ZERO LINE LENGTH
STXD ;XEQ=0 NOT EXECUTING
LSKP ;CONTINUE TO CRLF
;
CRLF FETCH TTYCC ;GET COLUMN COUNT
SHL ;IF IN TAPE MODE (MSB=1),
BDF SEP5 ;THEN JUST EXIT
FETCH PAD ;GET # OF PAD CHARS
PLO AC ;& SAVE IT
LDI 00Dh ;TYPE <CR>
PADS CALL TYPEV
FETCH TTYCC-1 ;POINT PZ TO COLUMN COUNTER
GLO AC ;GET # OF PADS TO GO
SHL ;MSB SELECTS NULL OR DELETE
BZ PLF ;UNTIL NO MORE PADS..
DEC AC ;DECREMENT # OF PADS TO GO
LDI0 ;PAD=NULL=0 IF MSB=0
LSNF
LDI 0FFh ;PAD=DELETE=FFH IF MSB=1
BR PADS ;..REPEAT
;
PLF STXD ;SET COLUMN COUNTER TTYCC=0
LDI 08Ah ;TYPE <LF>
;
SMI 080h ;FIX HI BIT
TYPER PHI X ;SAVE CHAR
FETCH TTYCC ;CHECK OUTPUT MODE
DEC PZ
ADI 081h ;INCREMENT COLUMN COUNTER TTYCC
ADI 080h ;WITHOUT DISTURBING MSB
BNF SEP5 ;IF MSB=1, IN TAPE MODE, NOT PRINTIN
STR PZ ;ELSE UPDATE COLUMN COUNTER
GHI X ;GET CHAR
LBR TYPEV ;AND GO TYPE IT
;
TAB LDI 020h
CALL TYPER
FETCH TTYCC ;GET COLUMN COUNT
TABS ANI 7 ;LOW 3 BITS
BNZ TAB
RETURN
CALL TYPER
DEC AC ;DECREMENT SPACES TO GO
BR TABS ;...REPEAT
;
PRNA CALL APUSH ;NUMBER IN AC
PRN FETCH AEPTR ;CHECK SIGN
PLO PZ
CALL DNEG ;IF NEGATIVE,
BNF PRP
LDI '-' ;PRINT '-'
CALL TYPER
PRP LDI0 ;PUSH ZERO FLAG
STXD ;WHICH ;MARKS NUMBER END
PHI AC ;PUSh, 010h (=DIVISOR)
LDI 10
CALL APUSH+1
INC PZ
PDVL CALL PDIV ;DIVIDE BY 10
GLO AC ;REMAINDER IS NEXT DIGIT
SHR ;BUT ;DOUBLED; HALVE IT
ORI 030h ;CONVERT TO ASCII
STXD ;PUSH ;IT
INC PZ ;IS QUOTIENT=0?
LDA PZ
SEX PZ
OR
DEC PZ ;RESTORE POINTER
DEC PZ
BNZ PDVL ;..REPEAT
PRNL INC R2 ;NOW, TO PRINT IT
LDN R2 ;GET CHAR
LBZ APOP-3 ;UNTIL ZERO (END FLAG)..
CALL TYPER ;PRINT IT
BR PRNL ;..REPEAT
;
RSBP FETCH SP ;GET SP
SKP
SVBP GHI BP ;GET BP
XRI (LINE)>>8 ;IN THE LINE?
BNZ SWAP ;NO, NOT IN SAME PAGE
GLO BP
STR R2
LDX
SMI (AESTK)&255
BDF SWAP ;NO, BEYOND ITS END
FETCH SP
GLO BP ;YES, JUST COPY BP TO SP
STXD
GHI BP
STR PZ
TYX RETURN
;
SWAP FETCH SP ;EXCHANGE BP AND SP
PHI XX ;PUT SP IN TEMP
LDN PZ
PLO XX
GLO BP ;STORE BP IN SP
STXD
GHI BP
STR PZ
GHI XX ;STORE TEMP IN BP
PHI BP
GLO XX
PLO BP
RETURN
;
CMPR CALL APOP ;GET FIRST NUMBER
GHI AC ;PUSH ONTO STACK WITH BIAS
XRI 080h ;(FOR 2'S COMPLEMENT)
STXD ;(BACKWARDS)
GLO AC
STXD
CALL BPOP ;GET AND SAVE
PLO X ;COMPARE BITS
CALL APOP ;GET SECOND NUMBER
INC R2
GLO AC ;COMARE THEM
SM ;LOW BYTE
PLO AC
INC R2
GHI AC ;HIGH BYTE
XRI 080h ;BIAS: 0 TO 65535 INSTEAD
SMB ;OF -32768 TO +32767
STR R2
BNF CLT ;LESS IF NO CARRY OUT
GLO AC
OR
BZ CEQ ;EQUAL IF BOTH BYTES 0
GLO X ;ELSE GREATER
SHR ;MOVE PROPER BIT
SKP
CEQ GLO X ;(BIT 1)
SHR
SKP
CLT GLO X ;(BIT 0)
SHR ;TO CARRY
LSNF
NOP
SKIP INC PC ;SKIP ONE BYTE IF TRUE
RETURN
;
ISUB CALL INEG ;SUBTRACT IS ADD NEGATIVE
IADD CALL APOP ;PUT ADDEND IN AC
SEX PZ
INC PZ ;ADD TO AUGEND
GLO AC
ADD
STXD
GHI AC ;CARRY INTO HIGH BYTE
ADC
STR PZ
RETURN
;
IMUL CALL APOP ;MULTIPLIER IN AC
LDI 010h ;BIT COUNTER IN X
PLO X
LDA PZ ;MULTIPLICAND IN XX
PHI XX
LDN PZ
PLO XX
MULL LDN PZ ;SHIFT PRODUCT LEFT
SHL ;(ON STACK)
STR PZ
DEC PZ
LDN PZ
SHLC ;DISCARD HIGh, 016h BITS
STR PZ
CALL SHAL ;GET A BIT
BNF MULC ;NOT THIS TIME
SEX PZ ;IF MULTIPLIER BIT=1,
INC PZ
GLO XX ;ADD MULTIPLICAND
ADD
STXD
GHI XX
ADC
STR PZ
MULC DEC X ;REPEAT 16 TIMES
GLO X
INC PZ
BNZ MULL
RETURN
;
IDIV CALL APOP ;GET DIVISOR
GHI AC
STR R2 ;CHECK FOR DIVIDE BY ZERO
GLO AC
OR
LBZ ERR ;IF YES, FORGET IT
LDN PZ ;COMPARE SIGN OF DIVISOR
XOR
STXD ;SAVE FOR LATER
CALL DNEG ;MAKE DIVEDEND POSITIVE
DEC PZ ;SAME FOR DIVISOR
DEC PZ
CALL DNEG
INC PZ
LDI0
LSKP
PDIV LDI0 ;MARK "NO SIGN CHANGE"
STXD ;FOR PRN ENTRY
PLO AC ;CLEAR HIGH END
PHI AC ;OF DIVIDEND IN AC
LDI 17 ;COUNTER TO X
PLO X
DIVL SEX PZ ;DO TRIAL SUBTRACT
GLO AC
SM
STR R2 ;HOLD LOW BYTE FOR NOW
DEC PZ
GHI AC
SMB
BNF $+5 ;IF NEGATIVE, CANCEL IT
PHI AC ;IF POSITIVE, MAKE IT REAL
LDN R2
PLO AC
INC PZ ;SHIFT EVERYTHING LEFT
INC PZ
INC PZ
LDX
SHLC
STXD
LDX
SHLC
STXD
GLO AC ;HIGh, 016h
SHLC
CALL SHCL
DEC X ;DO IT 16 TIMES MORE
GLO X
LBNZ DIVL
INC R2 ;CHECK SIGN OF QUOTIENT
LDN R2
SHL
BNF NEGX ;POSITIVE IS DONE
INEG FETCH AEPTR ;POINT TO STACK
PLO PZ
BR NEG
DNEG SEX PZ
LDX ;FOR DIVIDE,
SHL ;TEST SIGN