forked from dspinellis/GW-BASIC
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathGIO86.ASM
2277 lines (2077 loc) · 63.3 KB
/
GIO86.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
; [ This translation created 10-Feb-83 by Version 4.3 ]
.RADIX 8 ; To be safe
CSEG SEGMENT PUBLIC 'CODESG'
ASSUME CS:CSEG
INCLUDE OEM.H
TITLE GIO86 - BASIC-86 Interpreter Device Independent I/O Module
COMMENT *
--------- --- ---- -- ---------
COPYRIGHT (C) 1982 BY MICROSOFT
--------- --- ---- -- ---------
T. Corbett Microsoft Inc.
*
INCLUDE GIO86U
.SALL
CPM86=0
IBMCSR=IBMLIK ;IBM Compatible Cursor Handling
INCLUDE MSDOSU
DSEG SEGMENT PUBLIC 'DATASG'
ASSUME DS:DSEG
EXTRN DEVPTR:WORD,DEVTBL:WORD,DEVINI:WORD,DEVTRM:WORD
EXTRN NLONLY:WORD,RUNFLG:WORD
EXTRN FILMOD:WORD,FILDEV:WORD,FILNM:WORD,FILEXT:WORD
EXTRN PTRFIL:WORD,FILTAB:WORD,STKLOW:WORD
DSEG ENDS
EXTRN SNERR:NEAR,FCERR:NEAR
EXTRN FRESTR:NEAR,GETYPR:NEAR
EXTRN $_KYBD:NEAR,$_LPT1:NEAR,$_NDEV:NEAR
EXTRN DERBFM:NEAR,DERBFN:NEAR,DERFAO:NEAR,DERFNO:NEAR,DERIFN:NEAR
EXTRN DERDNA:NEAR,DERFDR:NEAR
DOSIO MACRO DFUN
MOV AH,LOW OFFSET DFUN
INT 33D ;MS-DOS system call
ENDM
SUBTTL OPEN statement
PUBLIC OPEN
EXTRN $LEN:NEAR,EQULTK:NEAR,$FOR:NEAR,$INPUT:NEAR,GETBYT:NEAR
EXTRN GWWID:NEAR
; OPEN Statement
; Syntax:
; OPEN filespec FOR mode AS fnum [LEN=random-record-length]
; OPEN mode,fnum,filespec[,random-record-length]
;
OPEN: CALL FRMEVL ;read the file mode or filename
MOV AL,BYTE PTR 0[BX] ;get terminator
CMP AL,LOW 54O ;followed by comma? (then
; non-spcdsk open...)
JNZ NOTNSO ;nope, must be SPCDSK form
PUSH BX ;save the text pointer
CALL FRESTR ;free string temp & check string
MOV AL,BYTE PTR 0[BX] ;make sure its not a null string
OR AL,AL
JZ ERBFM0 ;if so, "bad file mode"
INC BX
MOV BX,WORD PTR 0[BX] ;[BX] points at mode character
MOV AL,BYTE PTR 0[BX] ;[A]=mode character
AND AL,LOW OFFSET -1-" " ;force to upper case
MOV DH,LOW OFFSET MD_SQO ;assume its "O"
CMP AL,LOW "O" ;is it?
JZ HAVMOD ;[D] has correct mode
MOV DH,LOW OFFSET MD_SQI ;assume sequential
CMP AL,LOW "I" ;is it?
JZ HAVMOD ;[D] says sequential input
MOV DH,LOW OFFSET MD_APP ;append?
CMP AL,LOW "A" ;test
JZ HAVMOD ;allow it
MOV DH,LOW OFFSET MD_RND ;must be random
CMP AL,LOW "R"
JNZ ERBFM0 ;if not, no match so "bad file mode"
HAVMOD: MOV BYTE PTR FILMOD,DH ;set file mode
POP BX ;get back the text pointer
CALL SYNCHR
DB OFFSET 54O ;skip comma before file number
HAVMD1: CALL POFNUM ;[AL]=the file number
PUSH AX ;save file number
CALL SYNCHR
DB OFFSET 54O ;skip comma before name
CALL NAMSCN ;parse filename setting FILDEV, FILNM, FILEXT
CALL PORLEN ;parse reclen parm
JMP SHORT OPEN1 ;branch to common code (with Fnum on stack)
ERBFM0: JMP DERBFM ;bad file mode error
NOTNSO: CALL NAMSC1 ;parse filename setting FILDEV, FILNM, FILEXT
MOV DH,LOW OFFSET MD_RND ;Assume there is no FOR, in which
;case the default mode is random.
MOV AL,BYTE PTR 0[BX]
CMP AL,LOW OFFSET $FOR ;Is there a 'FOR'?
JNZ GOTMOD ;No, better see 'AS'
CALL CHRGTR
CMP AL,LOW OFFSET $INPUT ;Input mode?
MOV DH,LOW OFFSET MD_SQI ;Assume it is
JZ GOTMD1 ;Yes, have file mode
CMP AL,LOW "A" ;test
JNE NTAPP ;branch if not append (might be OUTPUT)
CALL SYNCHR
DB OFFSET "A"
CALL SYNCHR
DB OFFSET "P"
CALL SYNCHR
DB OFFSET "P"
CALL SYNCHR
DB OFFSET "E"
CALL SYNCHR
DB OFFSET "N"
CALL SYNCHR
DB OFFSET "D"
MOV DH,LOW OFFSET MD_APP ;append file mode
JMP SHORT GOTMOD ;allow it
NTAPP:
CALL SYNCHR
DB OFFSET "O" ;it must be OUTPUT
CALL SYNCHR
DB OFFSET "U"
CALL SYNCHR
DB OFFSET "T"
CALL SYNCHR
DB OFFSET "P"
CALL SYNCHR
DB OFFSET "U"
CALL SYNCHR
DB OFFSET "T"
MOV DH,LOW OFFSET MD_SQO
JMP SHORT GOTMOD
GOTMD1: CALL CHRGTR
GOTMOD: MOV BYTE PTR FILMOD,DH ;set file mode
CALL SYNCHR
DB OFFSET "A"
CALL SYNCHR
DB OFFSET "S" ;Must have 'AS'
CALL POFNUM ;[AL]=file #
PUSH AX ;save file#
CALL PNRLEN ;parse new reclen parameter
OPEN1: DEC BX
CALL CHRGTR
JNZ SNERR1 ;error if not end-of-statement
POP AX ;[AL]=file number
CALL OPNFIL ;branch to general file-open code
JMP FINPRT ;reset PTRFIL to 0 (keyboard/crt)
;PORLEN - parse old variable record length field
; Entry - [FILMOD]=file mode
; Exit - [CX]=reclen if reclen parm included, else 0
;
PORLEN: CALL PRLENC
JZ PRLENX
CALL SYNCHR
DB OFFSET 54O
JMP SHORT VARECS
;PNRLEN - parse new variable record length field
; Entry - [FILMOD]=file mode
; Exit - [CX]=reclen if reclen parm included, else 0
;
PNRLEN: CALL PRLENC
JZ PRLENX
CALL SYNCHR
DB OFFSET 377O ;else parse "LEN=record-length"
CALL SYNCHR
DB OFFSET $LEN ;LEN is a 2-byte token
CALL SYNCHR
DB OFFSET EQULTK
EXTRN INTID2:NEAR
VARECS: CALL INTID2 ;[DX]=record size (0..32767)
MOV CX,DX ;return it in CX
OR CX,CX
JZ FCERR1 ;0 is illegal value
PRLENX: RET
;PRLENC - see if reclen parm is expected
;
PRLENC:
MOV CX,0 ;indicates reclen parm not included
MOV AL,BYTE PTR FILMOD ;[AL]=requested file mode
CMP AL,LOW OFFSET MD_RND
JNZ NOLEN ;branch if file mode is not RANDOM
DEC BX ;decrement text pointer
CALL CHRGTR ;re-get last character parsed
JZ NOLEN ;branch if end-of-statement
MOV CL,LOW 1 ;indicates reclen parm included
NOLEN: OR CX,CX ;set NZ if reclen parm included
RET
FCERR1: JMP FCERR ;function call error
SNERR1: JMP SNERR ;syntax error
SUBTTL CLOSE, WIDTH Statements
PUBLIC CLOSE
; CLOSE Statement
; Syntax: CLOSE [[#]n [,[#]n ...]]
;
CLOSE: JNZ CLOS1 ;branch if statement has parm
JMP CLSALL ;close all files if no parm given
CLOS1: CMP AL,LOW "#"
JNZ NOLBS ;branch if no #
CALL CHRGTR ;skip #
NOLBS:
CALL GETBYT ;[AL]=file#
CALL CLSFIL ;close file [AL] and return
DEC BX
CALL CHRGTR
CMP AL,LOW 54O ;check for comma
JNZ RET6 ;branch if end of file list
CALL CHRGTR ;skip comma
JMP SHORT CLOS1 ;close next file in list
PUBLIC WIDTHS
; WIDTH Y[,X]/[#fnum,]/[device,] Statement
; Entry - (BX) = text pointer
;
WIDTHS: CMP AL,LOW "#"
JZ FILWID ;Is files WIDTH specification
CMP AL,LOW 54O
JZ CRTWD1 ;branch if Comma
EXTRN $LPRINT:NEAR,$_LPT1:NEAR
CMP AL,LOW OFFSET $LPRINT
JNZ NOTLPR ;branch if not WIDTH LPRINT
CALL CHRGTR ;skip LPRINT
MOV AL,LOW OFFSET $_LPT1
JMP SHORT ITSWLP
NOTLPR:
PUSH BX ;save Text Pointer in case CRT width
CALL FRMEVL ;evaluate string or number
CALL GETYPR
JNZ CRTWD ;brif not string argument. CRT width
POP SI ;discard old text pointer
PUSH BX ;save text pointer
CALL FRESTR ;release temporary string descriptor
;[BX] points to string descriptor
MOV CL,BYTE PTR 0[BX]
MOV CH,LOW 0 ;[CX]=length of string
MOV SI,WORD PTR 1[BX] ;SI points to start of string
CALL PARDEV ;AL=-(device number)
POP BX ;restore text pointer
PUSH AX ;save device id
CALL SYNCHR
DB OFFSET 54O
POP AX ;[AL]=device id
ITSWLP:
PUSH AX ;save device id
CALL GETWDT ;[DL]=width
POP AX ;[AL]=device id
CALL CDEVID ;[DI]=device dispatch table offset
JZ ERIFN0 ;illegal file name if device=disk
MOV AH,LOW OFFSET G_SWD ;select set-width function
JMP TBLDSP ;dispatch function [AH] for device [DI]
FILWID: CALL PRFNUM ;[AL]=file number
CALL FDBPTR ;[SI] points to file-data-block
JZ ERFNO1 ;branch if file not opened
PUSH SI
CALL SYNCHR
DB OFFSET 54O
CALL GETWDT ;[AL]=width (1..255)
POP SI ;SI points to file data block
MOV BYTE PTR F_WID[SI],AL ;save width in FDB
RET6: RET
GETWDT: CALL GETBYT
OR AL,AL
JZ FCERR2 ;width of 0 is illegal
RET ;return if width is between 1 and 255
CRTWD: POP BX ;restore text pointer
CRTWD1: JMP GWWID
FCERR2: JMP FCERR
ERIFN0: JMP DERIFN ;illegal file name error
ERFNO1: JMP DERFNO ;file not open error
ERDNA1: JMP DERDNA ;Device not available
SUBTTL BSAVE, BLOAD Statements
PUBLIC BLOAD,BSAVE
EXTRN GETBYT:NEAR,SYNCHR:NEAR,MAKINT:NEAR,CHRGTR:NEAR,SNERR:NEAR
EXTRN PRODIR:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN SAVLEN:WORD,SAVSEG:WORD
DSEG ENDS
; BSAVE Statement - Save memory image to file
; Syntax: BSAVE name, start-adr, byte-count
;
BSAVE: CALL BPARMS ;parse parms
INC AL
JNZ SNERR2 ;Error if 1 or no parms.
PUSH BX ;save text pointer
PUSH CX ;SAVE start-adr
MOV AL,LOW OFFSET MD_SQO ;open file 0 for output
CALL NULOPM
CALL SCDBIN ;set file-code to binary
MOV AL,LOW OFFSET BSVFID ;output binary file ID
CALL OUTDO ;output to file
MOV AX,WORD PTR SAVSEG ;DX=Segment from DEF SEG statement
CALL OUT16 ;write segment adr to file
POP AX ;[AX]=start-adr
PUSH AX
CALL OUT16 ;output start adr
MOV AX,WORD PTR SAVLEN ;[DX]=number of bytes
MOV CX,AX ;[CX]=length
CALL OUT16 ;output end adr + 1
POP BX ;[BX]=start-adr
MOV DX,WORD PTR SAVSEG ;DX=Segment adr
CALL OUTBLK ;output binary
JMP LODEND ;exit
SNERR2: JMP SNERR
; BLOAD Statement - load memory image from disk
; Syntax: BLOAD name[, start-adr]
;
BLOAD:
CALL BPARMS ;Get Parms if any.
OR AL,AL
JZ BLODP ;Will set -1 if start-adr only given.
INC AL
JZ SNERR2 ;error if 2 parms given
BLODP: DEC AL ;AL=1: no start-adr parm, -1: start-adr parm
PUSH BX ;save text pointer
PUSH AX ;save Parm Switch
PUSH CX ;save start-adr parm
MOV AL,LOW OFFSET MD_SQI
CALL NULOPM ;Open File 0 for INPUT
CALL SCDBIN ;set file code to binary
CALL INCHR ;[A]=1st byte from file
CMP AL,LOW OFFSET BSVFID ;make sure this was created by BSAVE
JNZ ERBFM2 ;else BAD FILE MODE
POP CX ;[CX]=start-adr parm
CALL INP16 ;[AX]=next 16 bits from file
MOV DX,AX ;[DX]=default segment
CALL INP16 ;[AX]=next 16 bits from file
MOV BX,AX ;[BX]=default start-adr
POP AX ;AL=1: no start-adr parm, -1: start-adr parm
DEC AL
JZ DEFSAD ;branch if no start-adr parm given
MOV DX,WORD PTR SAVSEG ;[DX]=segment parm
MOV BX,CX ;[BX]=start-adr parm
DEFSAD: CALL INP16 ;[AX]=file length
MOV CX,AX ;[CX]=file length
CALL INPBLK ;do the load
LODEND:
POP BX ;restore text pointer
JMP FINPRT ;close file 0, reset PTRFIL
ERBFM2: JMP DERBFM ;bad file mode error
;BPARMS - Parse parms for BLOAD and BSAVE
; Exit - [AL]=(1,0,-1) if 0,1,2 parameters parsed.
; [BX] is preserved (text pointer)
; [CX] = start-adr
; [SAVLEN] = file size (if BSAVE)
;
BPARMS:
CALL PRODIR ;Don't allow in direct mode if protected
CALL NAMSCN ;scan file name and disk number
;setting FILDEV, FILNM, FILEXT
JB BNAMOK ;Extension supplied by user
CALL NAMBAS ;Supply ".BAS" default extension
BNAMOK:
DEC BX
CALL CHRGTR ;See if any parms
JNZ BPARM2 ;Brif parms follow
MOV AL,LOW 1 ;No Parms, use file header if BLOAD.
RET ; else exit.
BPARM2:
CALL SYNCHR
DB OFFSET "," ;Must see comma first
CALL ADRGET ;get start-adr (0..65535)
PUSH DX ;save it
DEC BX
CALL CHRGTR
JNZ BPARM3 ;Brif 2nd Parm given.
POP CX ;[CX]=start adr
XOR AL,AL ;Set 0 if 1 parm only given.
RET
BPARM3:
CALL SYNCHR
DB OFFSET ","
CALL ADRGET ;[DX]=number of bytes for bsave (0..65535)
XCHG BX,DX
MOV WORD PTR SAVLEN,BX ;Save end ADDRESS+1(start+count)
XCHG BX,DX ;[BX]=text pointer
DEC BX
CALL CHRGTR
JNZ SNERR3 ;must be end of statement
POP CX ;[CX]=start-adr
MOV AL,LOW 377O ;Set -1 if 2 parms given.
RET
SNERR3: JMP SNERR
SUBTTL LPRINT, PRINT Statements
PUBLIC LPRINT,PRINT
EXTRN PRINUS:NEAR,IMOD:NEAR,FOUT:NEAR,STRLIT:NEAR,STRPRT:NEAR
EXTRN USINTK:NEAR,TABTK:NEAR,SPCTK:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN FACLO:WORD
DSEG ENDS
JPRINU: JMP PRINUS ;Print Using
PRINTX: CALL CRDO ;output terminating CR
PRNTX1: POP CX ;discard line width, last comma column
JMP FINPRT ;close file#0, reset PTRFIL to keyboard
LPRINT: MOV WORD PTR PTRFIL,-1 ;future output will go to Line Printer
JMP SHORT PRINT1
PRINT:
MOV CL,LOW OFFSET MD_SQO ;setup output file
CALL FILGET
PRINT1: CALL PTRWDC ;[CH]=width, [CL]=last comma column
PUSH CX ;save on stack
NEWCHR: DEC BX
CALL CHRGTR ;get another character
JZ PRINTX ;print CR if end without punctuation
PRINTC: JZ PRNTX1 ;branch if end of statement
POP CX ;refresh [CH]=width, [CL]=last comma column
CMP AL,LOW OFFSET USINTK ;is it "print using" ?
JZ JPRINU ;IF SO, USE A SPECIAL HANDLER
PUSH CX ;save [CH]=width, [CL]=last comma column
CMP AL,LOW OFFSET TABTK
JZ TABERJ ;the TAB function?
CMP AL,LOW OFFSET SPCTK
JZ TABERJ ;the SPC function?
PUSH BX ;save the text pointer
CMP AL,LOW 44D
JZ COMPRT ;Print Comma
CMP AL,LOW 59D ;is it a ";"
JNZ PRTS
JMP NOTABR
TABERJ: JMP TABER
PRTS: POP DX ;get rid of old text pointer
CALL FRMEVL ;evaluate the formula
PUSH BX ;save text pointer
CALL GETYPR ;see if we have a string
JZ STRDON ;if so, print special
DEC BX
CALL CHRGTR ;[BX]=addr of number terminator(non-blank)
CMP BYTE PTR 0[BX],LOW 54O
PUSHF ;remember if value was comma terminated
CALL FOUT ;make a number into a string
CALL STRLIT ;make it a string
MOV BYTE PTR 0[BX],LOW " " ;put a space at the end
POPF
POP BX
POP CX ;restore [CH]=width, [CL]=last comma column
PUSH CX
PUSH BX
MOV BX,WORD PTR FACLO ;[BX]=address of string descriptor
JNZ INCLEN ;BRIF not comma terminated(print the space too)
CALL PTRGPS ;[AL]=file's current position
ADD AL,BYTE PTR 0[BX] ;add length of string we will output
;At this point we have [AL]=posn after number is printed(without space),
; [CH]=device width, [CL]=last comma posn, [BX]=addr of string descriptor.
;IF number output stops at comma column minus one
;THEN don't append blank(This insures that another number will appear at the
;next comma column, instead of the second column posn after this string)
CMP CH,LOW 255D ;infinite width?
JZ MODCOM ;do modulus to determine next comma column
CMP AL,CL ;compare with last comma column
JNB INCLEN ;Will do CR after do output,
; make string include blank
;Determine if posn in [AL] is one less than a comma column
MODCOM: INC AL
MODCM1: SUB AL,LOW OFFSET CLMWID ;[AL]=modulus CLMWID
JA MODCM1
JZ STRDON ;BRIF at comma column, exclude trailing space
INCLEN: INC WORD PTR 0[BX] ;increment the length to include the space
;NOTE:number is less than 255(can do INC)
STRDON: POP BX
POP CX
PUSH CX ;refresh [CH]=width, [CL]=last comma column
PUSH BX
MOV BX,WORD PTR FACLO ;BX points to string descriptor
INC CH
JZ LINCH2 ;branch if infinite (255) line width
DEC CH ;restore [CH]=device width
CALL PTRGPS ;[AL]=file's current column pos
OR AL,AL ;don't CR if string longer than line
JZ LINCH2 ; length if position is 0
ADD AL,BYTE PTR 0[BX] ;[AL]=column + string size
CMC ;set nc if overflow on check
JAE LINCHK ;start on a new line if overflow
DEC AL
CMP AL,CH ;check for overlap
LINCHK: JB LINCH2 ;branch if still on current line
CALL CRDO ;else output CR
LINCH2: CALL STRPRT ;PRINT THE string/number
POP BX ;restore text pointer
JMP NEWCHR ;print some more
;PRINT comma (text pointer stacked)
;
COMPRT: CALL PTRGPS ;[AL]=file's current column position
CMP CH,LOW 255D ;infinite width?
JZ MORCOM ;do modulus
CMP AL,CL ;compare current with last comma column
CHKCOM: JB MORCOM ;branch if not beyond last comma col
CALL CRDO ;start new line
JMP SHORT NOTABR ;AND QUIT IF BEYOND LAST COMMA FIELD
MORCOM: SUB AL,LOW OFFSET CLMWID ;[AL]=MODULUS CLMWID
JAE MORCOM
NEG AL
DEC AL ;fill the print position out
;to an even CLMWID, so
;we print CLMWID-[AL] MOD CLMWID spaces
JMP SHORT ASPA2 ;go print [AL]+1 spaces
;PRINT TAB(N) & SPC(N)
;
TABER: PUSH AX ;remember IF [A]=SPCTK or TABTK
CALL CHRGTR
CALL ADRGET ;[DX]=parameter (0..65535)
POP AX ;see if its SPC or TAB
PUSH AX
OR DX,DX
JG TBNONG ;branch if greater than 0
MOV DX,0 ;map negative parms to 0
JMP SHORT SPCNDC
TBNONG: CMP AL,LOW OFFSET SPCTK ;if space leave alone
JZ SPCNDC
DEC DX ;offset TAB by 1
SPCNDC: PUSH BX ;save the text pointer
MOV BL,CH ;[BL]=file width
MOV AL,CH ;[AL]=file width
INC AL ;test for width of 255 (no folding)
JZ LNOMOD ;if so, don't mod
MOV BH,LOW 0 ;MOD out by line length
CALL IMOD ;[BX]=[DX] MOD filewidth
XCHG DX,BX ;set [DL] = position to go to
LNOMOD: POP BX ;get back the text pointer
CALL SYNCHR
DB OFFSET ")"
DEC BX
POP AX ;get back SPCTK or TABTK
SUB AL,LOW OFFSET SPCTK ;was it SPCTK?
PUSH BX ;save the text pointer
JZ DOSIZT ;value in [AL]
CALL PTRGPS ;[AL]=file position
DOSIZT: NEG AL ;print [E]-[A] spaces
DEC AL
ADD AL,DL
JB ASPA2 ;print if past current
INC AL
JZ NOTABR ;do nothing if at current
CALL CRDO ;go to a new line
MOV AL,DL ;get the position to go to
DEC AL
JS NOTABR
ASPA2: INC AL
ASPAC: MOV DL,AL ;[B]=number of spaces to print
MOV AL,LOW " " ;[A]=space
REPOUT: CALL OUTDO ;PRINT [AL]
DEC DL ;decrement the count
JNZ REPOUT
NOTABR: POP BX ;pick up text pointer
CALL CHRGTR ;and the next character
JMP PRINTC ;and since we just printed
;spaces, don't call crdo
;if it's the end of the line
SUBTTL EOF, LOC, LOF Functions
PUBLIC EOF,LOC,LOF
EXTRN CONINT:NEAR
; EOF(n) Function - returns -1 if eof, else 0
; Entry - [FAC] = file number
; Exit - [FAC] = -1 if EOF, else 0.
;
EOF: CALL FACFPT ;[SI] points to FDB for file [FAC]
JZ ERFNO4 ;error if file not opened
XOR BX,BX ;BX=0 (assume not at eof)
TEST BYTE PTR F_FLGS[SI],LOW OFFSET FL_BKC
JNZ GFUNX ;if character backed up, no eof
DEC BX ;[BX]=-1 (EOF true)
CMP BYTE PTR F_ORCT[SI],LOW 0
JE GFUNX ;branch if FDB EOF flag set
MOV AH,LOW OFFSET G_EOF ;End of file function
CALL SIDSP
JMP SHORT GFUNX ;return result in FAC
ERFNO4: JMP DERFNO ;file not open error
; LOC(n) Function
; Entry - [FAC] = file number
; Exit - [FAC] = current record number
;
LOC: MOV AH,LOW OFFSET G_LOC ;LOC function
GENFUN: CALL FACDSP ;[BX]=EOF(file [FAC])
GFUNX: JMP MAKINT ;return result in FAC
; LOF(n) Function
; Entry - [FAC] = file number
; Exit - [FAC] = length of file in bytes
;
LOF: MOV AH,LOW OFFSET G_LOF ;LOF Function
JMP FACDSP ;[FAC]=LOF(file [FAC])
SUBTTL GET/PUT - Random disk I/O Statements
PUBLIC DPUTG
;Syntax - GET fn [,recnum] (if no recnum next relative record assumed)
; PUT fn [,recnum]
; Entry - [BX] = text pointer
; [CX] = 0 for GET, 1 for PUT
;
DPUTG:
PUSH CX ;save GET/PUT Flag
CALL POFNUM ;[AL]=file number
CALL FDBPTR ;[SI] points to File Data Block of file [AL]
JZ ERFNO3 ;branch if file not open
CMP BYTE PTR F_MODE[SI],LOW OFFSET MD_RND
JNE ERBFM1 ;Not random - bad file mode
PUSH SI ;save FDB pointer
DEC BX
CALL CHRGTR ;reget next character
JZ RELRND ;branch if end-of-statement (relative record)
CALL SYNCHR
DB OFFSET 54O ;parse required comma
CALL ADRGET ;[DX]=record number (0..65535)
POP SI ;restore FDB pointer
POP AX ;restore GET/PUT flag
ADD AX,2 ;[AX]=2 for GET [DX], 3 for PUT [DX]
JMP SHORT RELRN1
RELRND: POP SI ;restore FDB pointer
POP AX
RELRN1: PUSH BX ;save text pointer
;[AL]=0,1,2,3 for GET PUT GETrel PUTrel
MOV AH,LOW OFFSET G_RND ;select Random I/O function code
CALL SIDSP ;dispatch to routine for FDB SI
POP BX ;restore text pointer
RET
ERBFM1: JMP DERBFM
SUBTTL Misc. Parsing Routines
;POFNUM - Parse optional file number "[#]n"
; Entry - [BX] = text pointer
; Exit - [BX] = updated text pointer, [AL]=file number
; All other registers preserved
;
POFNUM: CMP BYTE PTR 0[BX],LOW "#" ;[AL]=current character
JNZ GETNZB ;branch if optional # not included
;PRFNUM - Parse required file number "#n"
; Entry - [BX] = text pointer
; Exit - [BX] = updated text pointer, [AL]=file number
; All other registers preserved
;
PRFNUM: CALL SYNCHR
DB OFFSET "#"
;GETNZB - Parse byte (1..255) expression, returning result in [AL]
; Entry - [BX] = text pointer
; Exit - [BX] = updated text pointer, [AL]=byte parsed
; All other registers preserved
;
GETNZB: PUSH DX
PUSH CX
CALL GETBYT ;[AL]=file number
OR AL,AL
JZ ERBFN1 ;bad file number if 0
POP CX
POP DX
RET9: RET
ERBFN1: JMP DERBFN ;bad file number
PUBLIC FILINP,FILGET,GETPTR,FILSET,FILSCN
FILINP: MOV CL,LOW OFFSET MD_SQI ;MUST BE SEQUENTIAL INPUT
FILGET: CMP AL,LOW "#" ;NUMBER SIGN THERE?
JNZ RET9 ;NO, NOT FILE INPUT
PUSH CX ;SAVE EXPECTED MODE
CALL FILSCN ;READ AND GET POINTER
JZ ERFNO3 ;ERROR IF FILE NOT OPEN
POP DX ;[DL]=FILE MODE
CMP AL,DL ;IS IT RIGHT?
JZ GDFILM ;GOOD FILE MODE
CMP AL,LOW OFFSET MD_RND ;ALLOW STUFF WITH RANDOM FILES
JNZ ERBFM3 ;IF NOT, "BAD FILE MODE"
GDFILM:
CALL SYNCHR
DB OFFSET 54O ;GO PAST THE COMMA
FILSET: MOV DX,CX ;SETUP PTRFIL
MOV WORD PTR PTRFIL,CX
RET
ERBFM3: JMP DERBFM
ERFNO3: JMP DERFNO
;FILSCN - parse file number
; Entry - [BX]=text pointer
; Exit - [DL]=file number, [SI], [CX] point to file data block for file [DL]
; [AL]=file mode, FLAGS.Z is set if file is not open.
; note - if file is not open, no FDB exists
;
FILSCN: CALL POFNUM ;[AL]=file number
FILIDX: MOV DL,AL ;return file number in [DL]
FILID2: CALL FDBPTR ;SI points to FDB for file [AL]
JZ NTOPEN ;branch if file is not open
MOV CX,SI ;CX points to FDB
MOV AL,BYTE PTR F_MODE[SI] ;[AL]=file mode
OR AL,AL ;set non-zero (file is opened)
NTOPEN: RET
;GETPTR IS CALLED FROM VARPTR(#<EXPRESSION>)
; Entry - [AL]=file number
; Exit - [DX] points to random file buffer, or sector buffer of file
;
GETPTR: CALL FDBPTR ;SI points to File Data Block
JZ ERFNO3 ;error if file not open
MOV DX,OFFSET F_MODE ;Return pointer to MODE
ADD DX,SI ;Return result in [DX]
RET
;DIRDO is called to make sure direct statement is not found when loading file
; If device is keyboard, control transfers to GONE with AX used.
;
PUBLIC DIRDO
DIRDO: MOV AX,WORD PTR PTRFIL
OR AX,AX
JNZ ERFDR ;if device not keyboard then
; error(direct statement in file)
EXTRN GONE:NEAR
JMP GONE ;else OK
ERFDR: JMP DERFDR
;ADRGET - parse 16 bit expression
; Entry - [BX]=text pointer
; Exit - [DX]=result (0..65535)
; [BX]=updated text pointer
; AX used, other registers preserved.
;
PUBLIC ADRGET
ADRGET: PUSH CX
EXTRN FRMEVL:NEAR
CALL FRMEVL
PUSH BX
EXTRN FRQINT:NEAR
CALL FRQINT ;Make Unsigned 16 bits
POP DX
XCHG BX,DX ;Offset in [DX], text pointer in [BX]
POP CX
RET
SUBTTL Major I/O Routines
;PRGFIL is called to open file #0 (SAVE/LOAD/MERGE etc.)
; Entry - [BX]=text pointer, pointing at filename
; [DH]=file mode
; Exit - [PTRFIL] points to files FDB (directing all future I/O to file)
; [BX]=[TEMP]=updated text pointer
; SI may be destroyed.
;
PUBLIC PRGFIL
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN TEMP:WORD
DSEG ENDS
PRGFIL: MOV BYTE PTR FILMOD,DH ;save file mode (MD.SQI / MD.SQO)
CALL NAMSCN ;scan filename
MOV WORD PTR TEMP,BX ;PRGFIN restores text pointer when done
JB PRGFIX ;Exit - "." found in name
CALL NAMBAS ;Add ".BAS" extension to disk file names
PRGFIX: JMP SHORT NULOPN ;open file #0
;NAMBAS is called to add the ".BAS" extension to disk file names
;Entry - FILDEV points to device id
;Exit - SI destroyed
;
NAMBAS: MOV SI,OFFSET FILDEV ;SI points to device id
TEST BYTE PTR 0[SI],LOW 377O
JS NAMBAX ;Exit if device is not DISK
ADD SI,9D ;SI points to Extention
CMP BYTE PTR 0[SI],LOW " " ;if blank extention, default to ".BAS"
JNE NAMBAX ;Exit if device is not DISK
MOV WORD PTR 0[SI],OFFSET (400O*"A")+"B"
MOV BYTE PTR 2[SI],LOW "S"
NAMBAX: RET
;NULOPN opens File 0 with mode [AL].
; Exit - [PTRFIL] points to files FDB (directing all future I/O to file)
;
PUBLIC NULOPM
NULOPM: MOV BYTE PTR FILMOD,AL ;FILMOD=file mode
NULOPN: XOR AL,AL ;[AL]=file number
XOR CX,CX ;random record length = 0
;fall into OPNFIL
;OPNFIL - general file-open routine
; Entry - [AL]=file number (0..n)
; [CX]=record length (0=default)
; [FILMOD]=mode (MD.SQI / MD.SQO / MD.RND / MD.APP)
; [FILDEV]=device id
; [FILNM]=filename
; [FILEXT]=1..3 byte filename extension
; Exit - [PTRFIL] points to files FDB (directing all future I/O to file)
; all registers preserved
;
OPNFIL: PUSHF
PUSH AX
PUSH BX
PUSH CX
PUSH DX
PUSH SI
PUSH DI
MOV BL,AL
MOV BH,LOW 0 ;[BX]=file number
CALL FDBPTR ;see if file is already open
JNZ ERFAO1 ;error if already open
MOV AL,BYTE PTR FILDEV ;[AL]=device id
CALL CDEVID ;[DI]=device dispatch table offset (AL)
MOV AH,LOW OFFSET G_OPN ;open function code (AL is still DEVICE ID)
CALL TBLDSP ;call device-dependent open routine
POP DI
POP SI
POP DX
POP CX
POP BX
POP AX
POPF
RET
FCERR3: JMP FCERR
ERFAO1: JMP DERFAO ;file already opened error
;CLSALL - close all opened files
; Entry - none
; Exit - All registers preserved
;
PUBLIC CLSALL
CLSALL: PUSH AX
PUSH SI
MOV SI,WORD PTR FILTAB ;Get address of next file block
CLSAL1: CMP SI,WORD PTR STKLOW
JZ CLSALX ;Branch if finished
PUSH WORD PTR F_NEXT[SI] ;save pointer to next entry in chain
MOV AL,BYTE PTR F_NUM[SI] ;[AL]=file number
CALL CLSFIL ;Close file [AL]
POP SI ;SI points to next FDB in chain
JMP SHORT CLSAL1 ;Keep looping till all files closed
CLSALX: POP SI
POP AX
RET
;CLSFIL - close file [AL]
; Exit - Flags, AX, SI used, all other registers are preserved
;
PUBLIC CLSFIL
CLSFIL: MOV AH,BYTE PTR NLONLY
TEST AH,LOW 200O ;see if Chain All / Load, R in progress
JNZ RET22 ;branch if Dont-Close-Any-Files flag set
TEST AH,LOW 1 ;see if Load/Merge/Chain is in progress
JZ CLSFL1 ;branch if Dont-Close-File-0 flag not set
OR AL,AL
JZ RET22 ;branch if trying to close file 0
CLSFL1: CALL FDBPTR ;[SI] points to FDB [AL]
JZ RET22 ;branch if file already closed
PUSH BX
PUSH CX
PUSH DX
MOV WORD PTR FREFDB,SI ;So FINPRT will force close file if low-level
;close routine gets I/O error
MOV AH,LOW OFFSET G_CLS
CALL SIDSP ;close FDB pointed to by [SI]
MOV WORD PTR FREFDB,0
CALL FFREE ;Deallocate FDB and remove from FDB Chain
POP DX
POP CX
POP BX
RET22: RET
;INCHR - get next byte from file PTRFIL
; Exit - [AL]=byte, [FLAGS], [AH] destroyed.
; All other regs preserved
; if END-OF-FILE then
; if program load was in progress, file 0 closed etc.
; else Read-Past-End error is generated
;
PUBLIC INCHR
EXTRN PRGFIN:NEAR,KYBSIN:NEAR
INCHR:
PUSH SI
CALL INCHRE ;[AL]=next byte from PTRFIL, carry if EOF
JAE INCHRX ;branch if not EOF
CMP BYTE PTR F_NUM[SI],LOW 0 ;EOF on ASCII file #0 = end of Load/Chain/Merge
JE FL0EOF ;branch if EOF reached for file #0
EXTRN DERRPE:NEAR
JMP DERRPE ;Input past end error
FL0EOF: CMP BYTE PTR F_CODE[SI],LOW OFFSET FC_BIN
JNE LDREOF ;branch if not binary file (must be ascii LOAD)
STC ;else must be BLOAD/binary LOAD
RET ;return EOF indication to caller
LDREOF:
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN CHNFLG:WORD
DSEG ENDS
EXTRN CHNRET:NEAR
CMP BYTE PTR CHNFLG,LOW 0 ;chain in progress?
JE NOTCHN ;branch if not chaining
JMP CHNRET ;perform variable block transfer, etc.
; close all files
NOTCHN:
PUSH BX ;save all registers
PUSH CX
PUSH DX
MOV AL,BYTE PTR NLONLY ;get load flags
AND AL,LOW 200O ;leave others open, null gets closed
MOV BYTE PTR NLONLY,AL ;allow other files to be closed
CALL PRGFIN ;close the file
POP DX
POP CX
POP BX
MOV AL,BYTE PTR RUNFLG ;run it or not?
OR AL,AL
JZ NORUNC ;dont run program
EXTRN RUNC:NEAR
CALL RUNC ;run it
EXTRN NEWSTT:NEAR
JMP NEWSTT
NORUNC: PUSH BX
PUSH CX
PUSH DX
EXTRN REDDY:NEAR,STROUT:NEAR
MOV BX,OFFSET REDDY ;print prompt "ok"
CALL STROUT
POP DX
POP CX
POP BX
MOV AL,LOW 13D
INCHRX: POP SI
RET
;INCHRE - get next byte from file PTRFIL.
; Exit - Carry set if EOF, else [AL]=byte.
; SI points to FDB
; All other regs preserved
;
PUBLIC INDSKC ;Referenced by DSKCOM
INDSKC:
INCHRE: MOV SI,WORD PTR PTRFIL ;SI points to current FDB
;fall into INCHSI
;INCHSI - get next byte from file SI (CTL Z = end-of-file)
; Exit - Carry set if EOF, else [AL]=byte.
; All other regs preserved
;
PUBLIC INCHSI
INCHSI: INC SI
JZ ERBFM6 ;branch if Line Printer (can't input)
DEC SI
JNZ INGFDB ;branch if not Keyboard (got FDB)
EXTRN INCHRI:NEAR
JMP INCHRI
INGFDB: CMP BYTE PTR F_MODE[SI],LOW OFFSET MD_SQO
JZ ERBFM6
CMP BYTE PTR F_ORCT[SI],LOW 0
JZ INCEOF ;branch if EOF already reached
TEST BYTE PTR F_FLGS[SI],LOW OFFSET FL_BKC
JNZ GETBKC ;branch if char backed up
MOV AH,LOW OFFSET G_SIN
CALL SIDSP ;[AL]=next input from file
JB INCEOF ;branch if device detected EOF
RET
INCEOF: MOV BYTE PTR F_ORCT[SI],LOW 0 ;indicates EOF on future calls
MOV BYTE PTR F_BREM[SI],LOW 0
STC ;tells caller EOF reached
RET