forked from microsoft/GW-BASIC
-
Notifications
You must be signed in to change notification settings - Fork 0
/
GWLIST.ASM
839 lines (758 loc) · 22.4 KB
/
GWLIST.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
863
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
; [ This translation created 10-Feb-83 by Version 4.3 ]
.RADIX 8 ; To be safe
CSEG SEGMENT PUBLIC 'CODESG'
ASSUME CS:CSEG
INCLUDE BINTRP.H
TITLE GWLIST Copied from BINTRP.MAC
.RADIX 10
.XLIST
FETOK=0 ;For FE extended tokens
FDTOK=0 ;For FD tokens too. (Must have
;FETOK==1.)
;tokens.
INTDEX=0 ;For Intelledex version.
NMPAGE=1 ;Number of text pages (for GW
;Multi-page)
;KPOS, etc.
LNREAD=0 ;For LINE READ statement
MELCO=0 ;Mitsubishi Electronics Co.
SIRIUS=0
MCI=0
ZENITH=0 ;ZENITH 8086
TETRA=0
CPM86=0
HAL=0
GENFLS=0
PANDBL=0
TSHIBA=0
SGS=0
ALPS=0
ALPCPM=0
GENWID=0
NNECBS=0
CAN8=0
PC8A=0
FN2SW=0 ;IBMTOK versions dispatch from IBMRES.MAC
LABEL=PC8A
HLPEDT=PC8A
OKI=0
BUBL=0
NORNF=0
IEESLV=0
TRSHHC=0
OLVPPC=0
NECPPC=0
USA=0 ;For HHC-USA version
EUROPE=0 ;For HHC-EUROPE version
.LIST
;Local Switches
;
LTRACE=ALPCPM ;trace output selectable
LABEL=PC8A
HLPEDT=PC8A
UCEMSG=NNECBS ;Upper case error messages.
OLD86=MELCO AND CPM86 ;For "old" 8086 error messages (prior
;to alignment for IBM compatibility).
OLDBLD=ALPCPM OR ALPS OR OKI OR HAL OR PC8A OR BUBL OR GW OR TSHIBA
INCLUDE GIO86U
INCLUDE MSDOSU ;MSDOS constants
EXTRN INIT:NEAR
EXTRN SETGSB:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
ASSUME DS:DSEG
EXTRN ONGSBF:WORD
DSEG ENDS
BUFOFS=0
BUFOFS=2 ;MUST CRUNCH INTO ERALIER PLACE FOR
; SINGLE QUOTE
KBFLEN=BUFLEN (BUFLEN/4) ;MAKE KRUNCH BUFFER SOMEWHAT
; LARGER THAN SOURCE BUFFER (BUF)
EXTRN NAME:NEAR
EXTRN INLIN:NEAR,CRDO:NEAR,CRDONZ:NEAR,STRCMP:NEAR,PPSWRT:NEAR
EXTRN OUTDO:NEAR
EXTRN BLTU:NEAR,CLEARC:NEAR,GTMPRT:NEAR,ISLET:NEAR,ISLET2:NEAR
EXTRN PTRGET:NEAR
EXTRN QINLIN:NEAR,SCRTCH:NEAR,STKINI:NEAR,RUNC:NEAR,RESFIN:NEAR
EXTRN PTRGT2:NEAR,STPEND:NEAR
EXTRN SYNCHR:NEAR
EXTRN SIGN:NEAR
EXTRN PRGFIN:NEAR,FILIND:NEAR
EXTRN FILINP:NEAR,INDSKC:NEAR
EXTRN LRUN:NEAR
EXTRN INXHRT:NEAR
EXTRN ZERO:NEAR,MOVE:NEAR,FOUT:NEAR,FIN:NEAR,PUSHF:NEAR
EXTRN MOVFR:NEAR,MOVRF:NEAR,MOVRM:NEAR,INPRT:NEAR,LINPRT:NEAR
EXTRN MOVFM:NEAR,MOVMF:NEAR
EXTRN INRART:NEAR,NEG:NEAR
EXTRN FREFAC:NEAR,FRETMS:NEAR,STRCPY:NEAR,GETSTK:NEAR
EXTRN STRLIT:NEAR,STRLT2:NEAR,STRLT3:NEAR,STRLTI:NEAR,STROUT:NEAR
EXTRN STRPRT:NEAR,STROUI:NEAR
EXTRN GETSPA:NEAR,PUTNEW:NEAR,STOP:NEAR,OMERR:NEAR,REASON:NEAR
EXTRN INSTR:NEAR
EXTRN PRINUS:NEAR,PUTTMP:NEAR
EXTRN FOUTH:NEAR,FOUTO:NEAR,STRO$:NEAR,STRH$:NEAR
EXTRN STRNG$:NEAR
EXTRN TON:NEAR,TOFF:NEAR
EXTRN SPACE$:NEAR
EXTRN SIGNS:NEAR
EXTRN UMULT:NEAR
EXTRN SIGNC:NEAR,POPHRT:NEAR
EXTRN FINLPT:NEAR
EXTRN VMOVFA:NEAR,VMOVAF:NEAR,ISIGN:NEAR,VSIGN:NEAR,VDFACS:NEAR
EXTRN VMOVMF:NEAR,VMOVFM:NEAR,FRCINT:NEAR,FRCDBL:NEAR,FRCSNG:NEAR
EXTRN VNEG:NEAR,PUFOUT:NEAR,DCXBRT:NEAR,IADD:NEAR
EXTRN FINDBL:NEAR
EXTRN VMOVE:NEAR,VALINT:NEAR,VALSNG:NEAR,FRCSTR:NEAR,CHKSTR:NEAR
EXTRN MAKINT:NEAR
EXTRN MOVE1:NEAR
EXTRN SCNSEM:NEAR
EXTRN WHILE:NEAR,WEND:NEAR
EXTRN CALLS:NEAR
EXTRN PROCHK:NEAR
EXTRN WRITE:NEAR
;The following block of externals was added on Dec 19, 1982 when BINTRP was
; Split up after the freeze of GW-BASIC Version 1.0
; This Split-up was not reflected in the PS1:<BASIC>BINTRP.MAC source.
; See Tom Corbett if you have any questions.
;
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN MEMSIZ:WORD,FRETOP:WORD,VARTAB:WORD,STREND:WORD,TXTTAB:WORD
EXTRN ARYTAB:WORD
EXTRN CURLIN:WORD,DOT:WORD,DATLIN:WORD,NLONLY:WORD,ERRLIN:WORD
EXTRN ERRTXT:WORD
EXTRN MRGFLG:WORD,CHNFLG:WORD
EXTRN SAVSTK:WORD,SAVTXT:WORD,OLDLIN:WORD,NXTLIN:WORD,OLDTXT:WORD
EXTRN ONELIN:WORD,ONEFLG:WORD
EXTRN CNTOFL:WORD,TRCFLG:WORD,CONSAV:WORD,CONTXT:WORD,CONTYP:WORD
EXTRN NUMCON:WORD,CONLO:WORD
EXTRN AUTFLG:WORD,AUTLIN:WORD,AUTINC:WORD
EXTRN KBUF:WORD,BUFMIN:WORD,BUF:WORD
EXTRN PTRFIL:WORD,PTRFLG:WORD,DORES:WORD,VALTYP:WORD,FACLO:WORD
EXTRN DFACLO:WORD,FAC:WORD
EXTRN TEMP:WORD,TEMP2:WORD,TEMP3:WORD,TEMPA:WORD
EXTRN DSCTMP:WORD,TEMPST:WORD
EXTRN OPRTYP:WORD
EXTRN SUBFLG:WORD,FVALSV:WORD,DEFTBL:WORD,FLGINP:WORD,FLGSCN:WORD
EXTRN OVCSTR:WORD,INPPAS:WORD
EXTRN USRTAB:WORD,DONUM:WORD,ENDPRG:WORD,ENDFOR:WORD,DATPTR:WORD
EXTRN FLGOVC:WORD
EXTRN ERRFLG:WORD,SAVSEG:WORD,PRMLN2:WORD,PRMSIZ:WORD,PARM2:WORD
EXTRN PRMLEN:WORD,PRMSTK:WORD,PARM1:WORD
EXTRN FUNACT:WORD,NOFUNS:WORD,OPTVAL:WORD,OPTFLG:WORD,RNDX:WORD
DSEG ENDS
EXTRN INEG2:NEAR,FADD:NEAR
EXTRN $OVMSG:NEAR,ERRTAB:NEAR,LSTERR:NEAR,DSKERR:NEAR,NONDSK:NEAR
EXTRN REDDY:NEAR
EXTRN ERRSN:NEAR,ERRDV0:NEAR,ERRRE:NEAR,ERROV:NEAR,ERRMO:NEAR
EXTRN ERRTM:NEAR,ERRNF:NEAR
EXTRN ERRNR:NEAR,ERRLBO:NEAR,ERRDD:NEAR,ERRUF:NEAR,ERRFC:NEAR
EXTRN ERRIFN:NEAR,ERRFNO:NEAR,ERRDNA:NEAR,ERRFDR:NEAR,ERRRAD:NEAR
EXTRN ERRDFL:NEAR
EXTRN ERRIOE:NEAR,ERRBFM:NEAR,ERRFNF:NEAR,ERRBFN:NEAR,ERRIER:NEAR
EXTRN ERRRPE:NEAR
EXTRN ERRFAO:NEAR,ERRNMF:NEAR,ERRWH:NEAR,ERRBRN:NEAR,ERRFOV:NEAR
EXTRN ERRTMF:NEAR
EXTRN ERRFAE:NEAR,ERRUS:NEAR,ERRRG:NEAR,ERROD:NEAR,ERRFN:NEAR
EXTRN ERRUE1:NEAR ;ERRUE DSKERR-NONDSK
EXTRN DSKER1:NEAR ;DSKERR-NONDSK
;The following externs are defined in GWMAIN.MAC
;
EXTRN CHRGTR:NEAR,READY:NEAR,STPRDY:NEAR,ISFLIO:NEAR,CONFC1:NEAR
EXTRN DEPTR:NEAR
EXTRN FINI:NEAR,FCERR:NEAR,FNDLIN:NEAR,SCNLIN:NEAR
EXTRN OCTCON:NEAR,HEXCON:NEAR,DBLCON:NEAR,DBLCN1:NEAR
;The following externs are defined in GWEVAL.MAC
;
EXTRN MAKUPL:NEAR,MAKUPS:NEAR,GETYPR:NEAR,OCTCNS:NEAR,DOCNVF:NEAR
EXTRN ISMID$:NEAR
EXTRN FRMEVL:NEAR,FRMCHK:NEAR,GETINT:NEAR,GETBYT:NEAR,GETIN2:NEAR
EXTRN SNGFLT:NEAR
SUBTTL ROM VERSION INITALIZATION, AND CONSTANTS
;
; The reserved word tables are in another module. Consequently
; many things must be declared external. All of these things
; are in the code segement or are absolutes (like tokens).
; I.e., they are not in the data segment.
;
EXTRN ALPTAB:NEAR
EXTRN EQULTK:NEAR
EXTRN STMDSP:NEAR
EXTRN GREATK:NEAR
EXTRN INSRTK:NEAR
EXTRN LESSTK:NEAR,LSTOPK:NEAR
EXTRN MIDTK:NEAR,MINUTK:NEAR
EXTRN NMREL:NEAR,NOTTK:NEAR,NUMCMD:NEAR
EXTRN ONEFUN:NEAR
EXTRN POS:NEAR,PLUSTK:NEAR,PRINT:NEAR
EXTRN RESLST:NEAR
EXTRN SNGQTK:NEAR,SPCTAB:NEAR,SQRTK:NEAR,STEPTK:NEAR
EXTRN THENTK:NEAR
EXTRN USRTK:NEAR
EXTRN $DATA:NEAR,$DATCO:NEAR,$DELETE:NEAR
EXTRN $EDIT:NEAR,$ELSE:NEAR,$END:NEAR,$ERL:NEAR,$ERROR:NEAR
EXTRN $FN:NEAR,$FOR:NEAR
EXTRN $GOSUB:NEAR,$GOTO:NEAR
EXTRN $IF:NEAR,$INKEY$:NEAR,$INPUT:NEAR
EXTRN $LIST:NEAR,$LLIST:NEAR
EXTRN $NEXT:NEAR
EXTRN $POINT:NEAR,$PRINT:NEAR
EXTRN $REM:NEAR,$REMCO:NEAR,$RENUM:NEAR,$RESTORE:NEAR,$RESUME:NEAR
EXTRN $RETURN:NEAR,$RND:NEAR,$RUN:NEAR
EXTRN $SCREEN:NEAR,$STOP:NEAR,$STRING$:NEAR
EXTRN $THEN:NEAR,$TO:NEAR
EXTRN $USR:NEAR
EXTRN $VARPTR:NEAR
EXTRN $WEND:NEAR,$WHILE:NEAR
SUBTTL EXTENDED LIST, DELETE, LLIST
PUBLIC LLIST
LLIST:
PUSH BX
MOV BX,OFFSET 0-1
MOV PTRFIL,BX ;FDB pointer = LPT Pseudo FDB
POP BX
PUBLIC LIST
LIST:
POP CX ;GET RID OF NEWSTT RETURN ADDR
CALL SCNLIN ;SCAN LINE RANGE
PUSH CX ;SAVE POINTER TO 1ST LINE
CALL PROCHK ;DONT EVEN LIST LINE #
MOV BX,TEMP ;Get Text pointer
DEC BX
CALL CHRGTR
JZ SHORT LIST4 ;Brif LIST to CRT.
CALL SYNCHR
DB OFFSET 44D ; else must be ,"dev:"
CALL NAMSCN ;Crack File spec.
EXTRN NAMSCN:NEAR,NULOPM:NEAR
MOV AL,LOW OFFSET MD_SQO ;OPEN FILE 0 FOR OUTPUT
CALL NULOPM
LIST4: MOV BX,65535 ;DONT ALLOW ^C TO CHANGE
MOV CURLIN,BX ;CONTINUE PARAMETERS
POP BX ;GET POINTER TO LINE
POP DX ;GET MAX LINE # OFF STACK
MOV CL,BYTE PTR [BX] ;[B,C]=THE LINK POINTING TO THE NEXT LINE
INC BX
MOV CH,BYTE PTR [BX]
INC BX
MOV AL,CH ;SEE IF END OF CHAIN
OR AL,CL
JNZ SHORT ??L000
JMP READY ;LAST LINE, STOP.
??L000:
EXTRN POLKEY:NEAR
CALL POLKEY ;check CTL C, queue typeahead
PUSH CX ;SAVE LINK
MOV CL,BYTE PTR [BX] ;PUSH THE LINE #
INC BX
MOV CH,BYTE PTR [BX]
INC BX
PUSH CX
POP SI ;XTHL
XCHG SI,BX
PUSH SI ;GET LINE # INTO [H,L]
XCHG BX,DX ;GET MAX LINE IN [H,L]
CMP BX,DX ;PAST LAST LINE IN RANGE?
POP CX ;TEXT POINTER TO [B,C]
JAE SHORT ??L001
JMP STPRDY ;IF PAST, THEN DONE LISTING.
??L001:
POP SI ;XTHL
XCHG SI,BX
PUSH SI ;SAVE MAX ON BOTTOM OF STACK
PUSH BX ;SAVE LINK ON TOP
PUSH CX ;SAVE TEXT POINTER BACK
XCHG BX,DX ;GET LINE # IN [H,L]
MOV DOT,BX ;SAVE FOR LATER EDIT OR LIST
;AND WE WANT [H,L] ON THE STACK
CALL LINPRT ;PRINT AS INTEGER WITHOUT LEADING SPACE
POP BX
MOV AL,BYTE PTR [BX] ;GET BYTE FROM LINE
CMP AL,LOW 9 ;IS IT A TAB?
JZ SHORT NOSPAL ;THEN DONT PRINT SPACE
MOV AL,LOW " "
CALL OUTDO ;PRINT A SPACE AFTER THE LINE #
NOSPAL: CALL BUFLIN ;UNPACK THE LINE INTO BUF
MOV BX,OFFSET BUF ;POINT AT THE START OF THE UNPACKED CHARACTERS
CALL LISPRT ;PRINT THE LINE
CALL CRDO ;PRINT CRLF
JMP SHORT LIST4 ;GO BACK FOR NEXT LINE
PUBLIC LISPRT
LISPRT:
MOV AL,BYTE PTR [BX]
CMP AL,LOW 10D
JNZ SHORT ??L002
CALL LISEOL ;erase to end-of-line after LF and 0
??L002:
OR AL,AL
JNZ SHORT ??L003
CALL LISEOL
??L003:
JNZ SHORT $ 3
RET ;IF =0 THEN END OF LINE
EXTRN OUTCH1:NEAR
CALL OUTCH1 ;OUTPUT CHAR AND CHECK FOR LF
INC BX ;INCR POINTER
JMP SHORT LISPRT ;PRINT NEXT CHAR
;Routine to output sequence to Clear to end of line if current device
; is Standard Output (CRT)
; Exit - All registers preserved.
;
LISEOL: LAHF ; PUSH PSW
XCHG AL,AH
PUSH AX
XCHG AL,AH
CALL ISFLIO
JZ SHORT ??L004
JMP LISELX ;return if listing to a file
??L004:
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN F_EDIT:WORD
DSEG ENDS
MOV AL,BYTE PTR F_EDIT ;Save current edit mode
LAHF ; PUSH PSW
XCHG AL,AH
PUSH AX
XCHG AL,AH
MOV AL,LOW 5 ;05=erase to end-of-line for non-IBMLIK
MOV BYTE PTR F_EDIT,AL ;Enter edit mode(05 is control function)
CALL OUTDO ;output 05 to current device
POP AX ; POP PSW
XCHG AL,AH
SAHF
MOV BYTE PTR F_EDIT,AL ;Restore edit mode
LISELX: POP AX ; POP PSW
XCHG AL,AH
SAHF
RET
PUBLIC BUFLIN
BUFLIN: MOV CX,OFFSET BUF ;GET START OF TEXT BUFFER
MOV DH,LOW OFFSET BUFLEN ;GET ITS LENGTH INTO [D]
XOR AL,AL ;SET MODE OF DECRUNCH
MOV BYTE PTR DORES,AL ;BIT0 IS QUOTE BIT1 IS DATA BIT2 IS REM
XOR AL,AL ;SET ON SPECIAL CHAR FOR SPACE INSERTION
MOV BYTE PTR TEMPA,AL
CALL PROCHK ;ONLY PROCEED IF OK
JMP SHORT PLOOP2 ;START HERE
PLOOP: INC CX ;INCREMENT DEPOSIT PTR.
INC BX ;ADVANCE TEXT PTR
DEC DH ;BUMP DOWN COUNT
JNZ SHORT $ 3
RET ;IF BUFFER FULL, RETURN
PUBLIC PLOOP2
PLOOP2:
MOV AL,BYTE PTR [BX] ;GET CHAR FROM BUF
OR AL,AL ;SET CC'S
MOV DI,CX
STOSB ;SAVE THIS CHAR
JNZ SHORT $ 3
RET ;IF END OF SOURCE BUFFER, ALL DONE.
CMP AL,LOW OFFSET OCTCON ;IS IT SMALLER THAN SMALLEST EMBEDDED CONSTANT?
JB SHORT NTEMBL ;YES, DONT TREAT AS ONE
CMP AL,LOW OFFSET DBLCN1 ;IS IT EMBEDED CONSTANT?
MOV DL,AL ;SAVE CHAR IN [E]
JB SHORT PRTVAR ;PRINT LEADING SPACE IF NESC.
CMP AL,LOW 34D ;IS IT A QUOTATION
JNZ SHORT BFCHKC ;IF NOT CHECK FOR COLON
MOV AL,BYTE PTR DORES ;COMPLEMENT THE QUOTE BIT
XOR AL,LOW 1
MOV BYTE PTR DORES,AL
MOV AL,LOW 34D ;RESTORE THE CHARACTER
BFCHKC: CMP AL,LOW ":" ;IS IT A COLON ENDING DATA?
JNZ SHORT NTEMBL
MOV AL,BYTE PTR DORES ;DON'T END IF IN QUOTE
RCR AL,1
JB SHORT QTCOLN
RCL AL,1
AND AL,LOW 253D ;TURN OFF BIT1 (DATA BIT)
MOV BYTE PTR DORES,AL
QTCOLN: MOV AL,LOW ":"
NTEMBL: OR AL,AL ;SET CC'S
JNS SHORT ??L005
JMP PLOOPR ;RESERVED WORD OF SOME KIND
??L005:
MOV DL,AL ;SAVE CHAR IN [E]
CMP AL,LOW "." ;DOT IS PART OF VAR NAME
JZ SHORT PRTVAR
CALL TSTANM ;IS CHAR ALPHANUMERIC
JAE SHORT PRTVAR ;ALPHANUMERIC
XOR AL,AL ;MAKE SPECIAL
JMP SHORT PLOOPH
PRTVAR: MOV AL,BYTE PTR TEMPA ;WHAT DID WE DO LAST?
OR AL,AL ;SET CONDITION CODES
JZ SHORT PLOOPG ;SPECIAL, NEVER INSERT SPACE
INC AL ;IN RESERVED WORD?
JNZ SHORT PLOOPG ;NO
MOV AL,LOW " " ;PUT OUT SPACE BEFORE RESWORD
MOV DI,CX
STOSB ;STORE IN BUFFER
INC CX ;INCRMENT POINTER INTO BUFFER
DEC DH ;SPACE LEFT?
JNZ SHORT $ 3
RET ;NO, DONE
PLOOPG: MOV AL,LOW 1 ;STORE FLAG SAYING IN VAR
PLOOPH: MOV BYTE PTR TEMPA,AL
MOV AL,DL ;GET BACK CHAR WE HAD
CMP AL,LOW OFFSET OCTCON ;IS IT SMALLER THAN SMALLEST EMBEDDED CONSTANT?
JB SHORT PLOOPZ ;YES, DONT TREAT AS ONE
CMP AL,LOW OFFSET DBLCN1 ;IS IT EMBEDED CONSTANT?
JAE SHORT ??L006
JMP NUMLIN ;YES, UNPACK IT
??L006:
PLOOPZ: MOV DI,CX
STOSB ;MAKE SURE BYTE STORED AFTER SPACE
JMP PLOOP ;STORE IN BUFFER
PLOOPR:
MOV AL,BYTE PTR DORES ;SEEWHAT OUR UNCRUNCH MODE IS
RCR AL,1 ;THE LSB IS THE QUOTE BIT
JB SHORT GPLOOP
RCR AL,1 ;GET THE REM BIT
RCR AL,1 ;AND SEE IF SET
JAE SHORT CHKDRS ;IF NOT JUST CHECK DATA BIT
MOV AL,BYTE PTR [BX] ;MUST SEE IF ITS SNGQTK
CMP AL,LOW OFFSET SNGQTK ;AND PRECEDED BY ":REM"
PUSH BX
PUSH CX ;SAVE BUFFER POINTER
MOV BX,OFFSET NOSNGQ ;PLACE TO RETURN ON FAILURE
PUSH BX
JZ SHORT $ 3
RET
DEC CX
MOV SI,CX
MOV AL,[SI]
CMP AL,LOW "M"
JZ SHORT $ 3
RET
DEC CX
MOV SI,CX
MOV AL,[SI]
CMP AL,LOW "E"
JZ SHORT $ 3
RET
DEC CX
MOV SI,CX
MOV AL,[SI]
CMP AL,LOW "R"
JZ SHORT $ 3
RET
DEC CX
MOV SI,CX
MOV AL,[SI]
CMP AL,LOW ":"
JZ SHORT $ 3
RET
POP AX ;GET RID OF RETURN ON FAIL ADDRESS
POP AX ;GET RID OF BAD BUFFER POINTER
POP BX ;GET BACK POINTER INTO LINE
INC DH ;UPDATE CHAR COUNT
INC DH
INC DH
INC DH
JMP SHORT RESEXP
NOSNGQ: POP CX ;GET BACK THE BUFFERPOINTER
POP BX ;GET BACK SOURCE LINE POINTER
MOV AL,BYTE PTR [BX] ;GET BACK THE CHARACTER
GPLOOP: JMP PLOOP
DATSET: MOV AL,BYTE PTR DORES ;BIT INDICATING INSIDE DATA
OR AL,LOW 2 ;IS BIT1
SETDRS: MOV BYTE PTR DORES,AL
XOR AL,AL
RET
REMSET: MOV AL,BYTE PTR DORES
OR AL,LOW 4
JMP SHORT SETDRS
CHKDRS: RCL AL,1 ;GET DATA BIT INTO CARRY
JB SHORT GPLOOP
MOV AL,BYTE PTR [BX] ;GET BACK THE CHARACTER
CMP AL,LOW OFFSET $DATA ;NEED TO SET A BIT
JNZ SHORT ??L007
CALL DATSET
??L007:
CMP AL,LOW OFFSET $REM
JNZ SHORT ??L008
CALL REMSET
??L008:
RESEXP: MOV AL,BYTE PTR [BX]
INC AL ;SET ZERO IF FN TOKEN
MOV AL,BYTE PTR [BX] ;GET CHAR BACK
JNZ SHORT NTFNTK ;NOT FUNCTION JUST TREAT NORMALLY
INC BX ;BUMP POINTER
MOV AL,BYTE PTR [BX] ;GET CHAR
AND AL,LOW 177O ;TURN OFF HIGH BIT
NTFNTK: INC BX ;ADVANCE TO POINT AFTER
NTQTTK: CMP AL,LOW OFFSET $ELSE ;ELSE?
JNZ SHORT NOTELS
DEC CX
INC DH
NOTELS:
CMP AL,LOW OFFSET $WHILE ;MIGHT HAVE AN EXTRA " " IN WHILE FORMULA
JNZ SHORT BFNTWH ;SO SKIP OVER IT IF ITS THERE
MOV AL,BYTE PTR [BX] ;GET CHARACTER TO SEE IF ITS PLUSTK
INC BX ;ASSUME IS PLUSTK
CMP AL,LOW OFFSET PLUSTK ;MIGHT NOT BE PLUS IF BINARY SAVED IN
MOV AL,LOW OFFSET $WHILE ;RESTORE TOKEN VALUE
JZ SHORT BFNTWH ;VERSION OF BASIC BEFORE CRUNCH CHANGED
DEC BX ;MOVE POINTER BACK
BFNTWH:
PUSH BX ;SAVE TEXT PTR.
PUSH CX ;SAVE DEPOSIT PTR.
PUSH DX ;SAVE CHAR COUNT.
EXTRN LISTX:NEAR
CALL LISTX ;Handle extended reserved words.
MOV BX,OFFSET RESLST-1 ;GET PTR TO START OF RESERVED WORD LIST
MOV CH,AL ;SAVE THIS CHAR IN [B]
MOV CL,LOW OFFSET "A"-1 ;INIT LEADING CHAR VALUE
RESSR3: INC CL ;BUMP LEADING CHAR VALUE.
RESSR1: INC BX ;BUMP POINTER INTO RESLST
RESSRC: MOV DH,BH ;SAVE PTR TO START OF THIS RESWRD
MOV DL,BL
RESSR2:
INS86 56 ;FETCH FROM CODE SEGMENT
MOV AL,BYTE PTR [BX] ;GET CHAR FROM RESLST
OR AL,AL ;SET CC'S
JZ SHORT RESSR3 ;IF END OF THIS CHARS TABLE, GO BACK & BUMP C
LAHF
INC BX ;BUMP SOURCE PTR
SAHF
JS SHORT ??L009
JMP RESSR2 ;IF NOT END OF THIS RESWRD, THEN KEEP LOOKING
??L009:
INS86 56 ;FETCH FROM CODE SEGMENT
MOV AL,BYTE PTR [BX] ;GET PTR TO RESERVED WORD VALUE
CMP AL,CH ;SAME AS THE ONE WE SEARCH FOR?
JNZ SHORT RESSR1 ;NO, KEEP LOOKING.
XCHG BX,DX ;SAVE FOUND PTR IN [H,L]
CMP AL,LOW OFFSET $USR ;USR FUNCTION TOKEN?
JZ SHORT NOISPA ;DONT INSERT SPACE
CMP AL,LOW OFFSET $FN ;IS IT FUNCTION TOKEN?
NOISPA:
MOV AL,CL ;GET LEADING CHAR
POP DX ;RESTORE LINE CHAR COUNT
POP CX ;RESTORE DEPOSIT PTR
MOV DL,AL ;SAVE LEADING CHAR
JNZ SHORT NTFNEX ;NOT "FN" EXPANSION
MOV AL,BYTE PTR TEMPA ;SET CC'S ON TEMPA
OR AL,AL
MOV AL,LOW 0 ;CLEAR RESWRD FLAG - MARK AS SPECIAL
MOV BYTE PTR TEMPA,AL ;SET FLAG
JMP SHORT MORLNZ ;DO EXPANSION
NTFNEX:
CMP AL,LOW OFFSET "Z" 1 ;WAS IT A SPECIAL CHAR?
JNZ SHORT NTSPCH ;NON-SPECIAL CHAR
XOR AL,AL ;SET NON-SPECIAL
MOV BYTE PTR TEMPA,AL
JMP SHORT MORPUR ;PRINT IT
NTSPCH: MOV AL,BYTE PTR TEMPA ;WHAT DID WE DO LAST?
OR AL,AL ;SPECIAL?
MOV AL,LOW 255 ;FLAG IN RESERVED WORD
MOV BYTE PTR TEMPA,AL ;CLEAR FLAG
MORLNZ: JZ SHORT MORLN0 ;GET CHAR AND PROCEED
MOV AL,LOW " " ;PUT SPACE IN BUFFER
MOV DI,CX
STOSB
INC CX
DEC DH ;ANY SPACE LEFT IN BUFFER
JNZ SHORT ??L010
JMP PPSWRT ;NO, RETURN
??L010:
MORLN0: MOV AL,DL
JMP SHORT MORLN1 ;CONTINUE
MORPUR:
INS86 56 ;FETCH FROM CODE SEGMENT
MOV AL,BYTE PTR [BX] ;GET BYTE FROM RESWRD
INC BX ;BUMP POINTER
MORLNP: MOV DL,AL ;SAVE CHAR
MORLN1: AND AL,LOW 177O ;AND OFF HIGH ORDER BIT FOR DISK & EDIT
MOV DI,CX
STOSB ;STORE THIS CHAR
INC CX ;BUMP PTR
DEC DH ;BUMP DOWN REMAINING CHAR COUNT
JNZ SHORT ??L011
JMP PPSWRT ;IF END OF LINE, JUST RETURN
??L011:
OR AL,DL ;SET CC'S
JS SHORT ??L012
JMP MORPUR ;END OF RESWRD?
??L012:
CMP AL,LOW OFFSET "(" 128 ;SPC( OR TAB( ?
JNZ SHORT NTSPCT ;NO
XOR AL,AL ;CLEAR FLAG
MOV BYTE PTR TEMPA,AL ;TO INSERT SPACE AFTERWARDS
NTSPCT:
POP BX ;RESTORE SOURCE PTR.
JMP PLOOP2 ;GET NEXT CHAR FROM LINE
PUBLIC TSTANM
TSTANM: CALL ISLET2 ;LETTER?
JNAE SHORT $ 3
RET ;YES
CMP AL,LOW "0" ;DIGIT?
JNB SHORT $ 3
RET ;TOO SMALL
CMP AL,LOW OFFSET "9" 1 ;LAST DIGIT
CMC ;MAKE CARRY RIGHT
RET ;NO CARRY=DIGIT
NUMLIN: DEC BX ;MOVE POINTER BACK AS CHRGET INX'S
CALL CHRGTR ;SCAN THE CONSTANT
PUSH DX ;SAVE CHAR COUNT
PUSH CX ;SAVE DEPOSIT PTR
PUSH AX ;SAVE CONSTANT TYPE.
CALL CONFC1 ;MOVE CONSTANT INTO FAC
POP AX ;RESTORE CONSTANT TYPE
MOV CX,OFFSET CONLIN ;PUT RETURN ADDR ON STACK
PUSH CX ;SAVE IT
CMP AL,LOW OFFSET OCTCON ;OCTAL CONSTANT?
JNZ SHORT ??L013
JMP FOUTO ;PRINT IT
??L013:
CMP AL,LOW OFFSET HEXCON ;HEX CONSTANT?
JNZ SHORT ??L014
JMP FOUTH ;PRINT IN HEX
??L014:
MOV BX,CONLO ;GET LINE # VALUE IF ONE.
JMP FOUT ;PRINT REMAINING POSSIBILITIES.
CONLIN: POP CX ;RESTORE DEPOSIT PTR.
POP DX ;RESTORE CHAR COUNT
MOV AL,BYTE PTR CONSAV ;GET SAVED CONSTANT TOKEN
MOV DL,LOW "O" ;ASSUME OCTAL CONSTANT
CMP AL,LOW OFFSET OCTCON ;OCTAL CONSTANT?
JZ SHORT SAVBAS ;YES, PRINT IT
CMP AL,LOW OFFSET HEXCON ;HEX CONSTANT?
MOV DL,LOW "H" ;ASSUME SO.
JNZ SHORT NUMSLN ;NOT BASE CONSTANT
SAVBAS:
MOV AL,LOW "&" ;PRINT LEADING BASE INDICATOR
MOV DI,CX
STOSB ;SAVE IT
INC CX ;BUMP PTR
DEC DH ;BUMP DOWN CHAR COUNT
JNZ SHORT $ 3
RET ;RETURN IF END OF BUFFER
MOV AL,DL ;GET BASE CHAR
MOV DI,CX
STOSB ;SAVE IT
INC CX ;BUMP PTR
DEC DH ;BUMP DOWN BASE COUNT
JNZ SHORT $ 3
RET ;END OF BUFFER, DONE
NUMSLN:
MOV AL,BYTE PTR CONTYP ;GET TYPE OF CONSTANT WE ARE
CMP AL,LOW 4 ;IS IT SINGLE OR DOUBLE PREC?
MOV DL,LOW 0 ;NO, NEVER PRINT TRAILING TYPE INDICATOR
JB SHORT TYPSET
MOV DL,LOW "!" ;ASSUME SINGLE PREC.
JZ SHORT TYPSET ;IS CONTYP=4, WAS SINGLE
MOV DL,LOW "#" ;DOUBLE PREC INDICATOR
TYPSET:
MOV AL,BYTE PTR [BX] ;GET LEADING CHAR
CMP AL,LOW " " ;LEADING SPACE
JNZ SHORT ??L015
CALL INXHRT ;GO BY IT
??L015:
NUMSL2: MOV AL,BYTE PTR [BX] ;GET CHAR FROM NUMBER BUFFER
INC BX ;BUMP POINTER
OR AL,AL ;SET CC'S
JZ SHORT NUMDN ;IF ZERO, ALL DONE.
MOV DI,CX
STOSB ;SAVE CHAR IN BUF.
INC CX ;BUMP PTR
DEC DH ;SEE IF END OF BUFFER
JNZ SHORT $ 3
RET ;IF END OF BUFFER, RETURN
MOV AL,BYTE PTR CONTYP ;GET TYPE OF CONSTANT TO BE PRINTED
CMP AL,LOW 4 ;TEST FOR SINGLE OR DOUBLE PRECISION
JB SHORT NUMSL2 ;NO, WAS INTEGER
LAHF
DEC CX ;PICK UP SAVED CHAR
SAHF
MOV SI,CX
MOV AL,[SI] ;EASIER THAN PUSHING ON STACK
LAHF
INC CX ;RESTORE TO POINT WHERE IT SHOULD
SAHF
JNZ SHORT DBLSCN ;IF DOUBLE, DONT TEST FOR EMBEDED "."
CMP AL,LOW "." ;TEST FOR FRACTION
JZ SHORT ZERE ;IF SINGLE & EMBEDED ., THEN DONT PRINT !
DBLSCN: CMP AL,LOW "D" ;DOUBLE PREC. EXPONENT?
JZ SHORT ZERE ;YES, MARK NO VALUE TYPE INDICATOR NESC.
CMP AL,LOW "E" ;SINGLE PREC. EXPONENT?
JNZ SHORT NUMSL2 ;NO, PROCEED
ZERE: MOV DL,LOW 0 ;MARK NO PRINTING OF TYPE INDICATOR
JMP SHORT NUMSL2 ;KEEP MOVING NUMBER CHARS INTO BUF
NUMDN:
MOV AL,DL ;GET FLAG TO INDICATE WHETHER TO INSERT
OR AL,AL ;A "D" AFTER DOUBLE PREC. #
JZ SHORT NOD ;NO, DONT INSERT IT
MOV DI,CX
STOSB ;SAVE IN BUFFER
INC CX ;BUMP POINTER
DEC DH ;DECRMENT COUNT OF CHARS LEFT IN BUFFER
JNZ SHORT $ 3
RET ;=0, MUST TRUNCATE LIST OF THIS LINE.
NOD:
MOV BX,CONTXT ;GET BACK TEXT POINTER AFTER CONSTANT
JMP PLOOP2 ;GET NEXT CHAR
;
; THE FOLLOWING CODE IS FOR THE DELETE RANGE
; COMMAND. BEFORE THE LINES ARE DELETED, 'OK'
; IS TYPED.
;
PUBLIC DELETE
DELETE:
CALL SCNLIN ;SCAN LINE RANGE
PUSH CX
CALL DEPTR ;CHANGE POINTERS BACK TO NUMBERS
POP CX
POP DX ;POP MAX LINE OFF STACK
PUSH CX ;SAVE POINTER TO START OF DELETION
;FOR USE BY CHEAD AFTER FINI
PUSH CX ;SAVE POINTER TO START OF 1ST LINE
CALL FNDLIN ;FIND THE LAST LINE
JAE SHORT FCERRG ;MUST HAVE A MATCH ON THE UPPER BOUND
MOV DH,BH ;[D,E]=POINTER AT THE START OF THE LINE
MOV DL,BL ;BEYOND THE LAST LINE IN THE RANGE
POP SI ;XTHL
XCHG SI,BX
PUSH SI ;SAVE THE POINTER TO THE NEXT LINE
PUSH BX ;SAVE THE POINTER TO THE START OF
;THE FIRST LINE IN THE RANGE
CMP BX,DX ;MAKE SURE THE START COMES BEFORE THE END
FCERRG: JNAE SHORT ??L016
JMP FCERR ;IF NOT, "ILLEGAL FUNCTION CALL"
??L016:
;DELETE must now be at EOL
EXTRN EOSCHK:NEAR
MOV BX,TEMP ;Get text pointer
CALL EOSCHK ;Check for end of statement
MOV BX,OFFSET REDDY ;PRINT "OK" PREMATURELY
CALL STROUT
POP CX ;GET POINTER TO FIRST IN [B,C]
MOV BX,OFFSET FINI ;GO BACK TO FINI WHEN DONE
POP SI ;XTHL
XCHG SI,BX
PUSH SI ;[H,L]=POINTER TO THE NEXT LINE
; ERASE A LINE FROM MEMORY
; [B,C]=START OF LINE BEING DELETED
; [H,L]=START OF NEXT LINE
;
PUBLIC DEL
DEL: XCHG BX,DX ;[D,E] NOW HAVE THE POINTER TO THE LINE
;BEYOND THIS ONE
MOV BX,VARTAB ;COMPACTIFYING TO VARTAB
MLOOP: MOV SI,DX
MOV AL,[SI]
MOV DI,CX
STOSB ;SHOVING DOWN TO ELIMINATE A LINE
INC CX
INC DX
CMP BX,DX ;DONE COMPACTIFYING?
JNZ SHORT MLOOP ;NO
MOV BX,CX
;Clear SCALARS and ARRAYS incase we are replacing line which may force
; garbage collection in BLTU
MOV VARTAB,BX
MOV ARYTAB,BX
MOV STREND,BX
RET
PAGE
CSEG ENDS
END