forked from microsoft/GW-BASIC
-
Notifications
You must be signed in to change notification settings - Fork 0
/
FIVEO.ASM
822 lines (801 loc) · 23.5 KB
/
FIVEO.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
; [ 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 FIVEO 5.0 Features -WHILE/WEND, CALL, CHAIN, WRITE /P. Allen
.SALL
.RADIX 10
TSHIBA=0
PC8A=0
_LABEL=PC8A
OKI=0
INCLUDE GIO86U
INCLUDE MSDOSU
IF CPM86
INCLUDE CPM86U
ENDIF
EXTRN RESTORE:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
ASSUME DS:DSEG
EXTRN SUBFLG:WORD,TEMP:WORD
DSEG ENDS
; Code Segment ( terminated by END at bottom of file )
EXTRN CHRGTR:NEAR,SYNCHR:NEAR,DCOMPR:NEAR
EXTRN GETYPR:NEAR
EXTRN SNERR:NEAR,GETSTK:NEAR,PTRGET:NEAR,CRDO:NEAR
EXTRN VMOVFM:NEAR
EXTRN FRQINT:NEAR
SUBTTL _WHILE, WEND
PUBLIC _WHILE, WEND
EXTRN ERROR:NEAR,FRMCHK:NEAR,$FOR:NEAR,$WHILE:NEAR,WNDSCN:NEAR
EXTRN FRMEVL:NEAR
EXTRN NEWSTT:NEAR,FORSZC:NEAR,ERRWE:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN SAVSTK:WORD,NXTLIN:WORD,CURLIN:WORD,ENDFOR:WORD
DSEG ENDS
;
; THIS CODE HANDLES THE STATEMENTS WHILE/WEND
; THE 8080 STACK IS USED TO PUT AN ENTRY ON FOR EACH ACTIVE WHILE
; THE SAME WAY ACTIVE GOSUB AND FOR ENTRIES ARE MADE.
; THE FORMAT IS AS FOLLOWS:
; $WHILE - THE TOKEN IDENTIFYING THE ENTRY (1 BYTE)
; A TEXT POINTER AT THE CHARACTER AFTER THE WEND OF THE WHILE BODY (2 BYTES)
; A TEXT POINTER AT THE CHARACTER AFTER THE WHILE OF THE WHILE BODY (2 BYTES)
; THE LINE NUMBER OF THE LINE THAT THE WHILE IS ON (2 BYTES)
;
; TOTAL 7 BYTES
;
_WHILE: ;KEEP THE WHILE TEXT POINTER HERE
MOV ENDFOR,BX ;SAVE TEXT ADDRESS
CALL WNDSCN ;SCAN FOR THE MATCHING WEND
;CAUSE AN ERRWH IF NO WEND TO MATCH
CALL CHRGTR ;POINT AT CHARACTWER AFTER WEND
XCHG BX,DX ;POSITION OF MATCHING WEND
CALL FNDWND ;SEE IF THERE IS A STACK ENTRY FOR THIS WHILE
LAHF
INC SP ;GET RID OF THE NEWSTT ADDRESS ON THE STACK
SAHF
LAHF
INC SP
SAHF
JNZ SHORT WNOTOL ;IF NO MATCH NO NEED TO TRUNCATE THE STACK
ADD BX,CX ;ELIMINATE EVERYTHING UP TO AND INCLUDING
;THE MATCHING WHILE ENTRY
MOV SP,BX
MOV SAVSTK,BX
WNOTOL: MOV BX,CURLIN ;MAKE THE STACK ENTRY
PUSH BX
MOV BX,ENDFOR ;GET TEXT POINTER FOR WHILE BACK
PUSH BX
PUSH DX ;SAVE THE WEND TEXT POINTER
JMP SHORT FNWEND ;FINISH USING WEND CODE
WEND: JZ SHORT ??L000
JMP SNERR ;STATEMENT HAS NO ARGUMENTS
??L000:
XCHG BX,DX ;FIND MATCHING WHILE ENTRY ON STACK
CALL FNDWND
JNZ SHORT WEERR ;MUST MATCH OR ELSE ERROR
MOV SP,BX ;TRUNCATE STACK AT MATCH POINT
MOV SAVSTK,BX ;[H,L] POINTING INTO STACK ENTRY
MOV DX,CURLIN ;REMEMBER WEND LINE #
MOV NXTLIN,DX ;IN NXTLIN
INC BX ;INDEX INTO STACK ENTRY TO GET VALUES
INC BX ;SKIP OVER TEXT POINTER OF WEND
MOV DX,[BX] ;SET [D,E]=TEXT POINTER OF WHILE
INC BX
INC BX
MOV BX,[BX] ;[H,L]=LINE NUMBER OF WHILE
MOV CURLIN,BX ;IN CASE OF ERROR OR CONTINUATION FIX CURLIN
XCHG BX,DX ;GET TEXT POINTER OF WHILE FORMULA INTO [H,L]
FNWEND: CALL FRMEVL ;EVALUATE FORMULA
EXTRN VSIGN:NEAR
PUSH BX ;SAVE TEXT POINTER
CALL VSIGN ;GET IF TRUE OR FALSE
POP BX ;GET BACK WHILE TEXT POINTER
JZ SHORT FLSWHL ;GO BACK AT WEND IF FALSE
MOV CX,OFFSET $WHILE ;COMPLETE WHILE ENTRY
MOV CH,CL ;NEED IT IN THE HIGH BYTE
PUSH CX
JMP NEWSTT
FLSWHL: MOV BX,NXTLIN ;SETUP CURLIN FOR WEND
MOV CURLIN,BX
POP BX ;TAKE OFF TEXT OF WEND AS NEW TEXT POINTER
POP CX ;GET RID OF TEXT POINTER OF WHILE
POP CX ;TAKE OFF LINE NUMBER OF WHILE
JMP NEWSTT
;
; THIS SUBROUTINE SEARCHES THE STACK FOR AN WHILE ENTRY
; WHOSE WEND TEXT POINTER MATCHES [D,E]. IT RETURNS WITH ZERO TRUE
; IF A MATCH IS FOUND AND ZERO FALSE OTHERWISE. FOR ENTRIES
; ARE SKIPPED OVER, BUT GOSUB ENTRIES ARE NOT.
;
WHLSIZ=7
;
; Note - 8086 versions force stack entries to be an even length
; so stack accesses won't cross word boundaries. This is done
; for speed. To accomplish this, an extra byte is pushed on
; top of the WHILE token. This extra byte is NOT reflected in
; the value of WHLSIZ but is taken care of by the code.
;
FNDWND: MOV BX,4 ;SKIP OVER RETURN ADDRESS AND NEWSTT
ADD BX,SP
FNDWN2:
INC BX
MOV AL,BYTE PTR [BX] ;GET THE ENTRY TYPE
INC BX
MOV CX,OFFSET $FOR
CMP AL,CL ;SEE IF ITS $FOR
JNZ SHORT FNDWN3
MOV CX,OFFSET FORSZC-1 ;Yes, so skip over it. Note that
ADD BX,CX ;the pointer has already been
JMP SHORT FNDWN2 ;incremented once.
FNDWN3: MOV CX,OFFSET $WHILE
CMP AL,CL
JZ SHORT $+3
RET
INS86 71,27 ;CMP [BX],DX-SAME WEND?
MOV CX,OFFSET WHLSIZ-1 ;Note that the pointer has
;already been incremented once.
JNZ SHORT $+3
RET ;RETURN IF ENTRY MATCHES
ADD BX,CX
JMP SHORT FNDWN2
WEERR: MOV DX,OFFSET ERRWE
JMP ERROR
SUBTTL CHAIN
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN TXTTAB:WORD,VALTYP:WORD
DSEG ENDS
EXTRN $COMMON:NEAR,$MERGE:NEAR,FRMEVL:NEAR,OMERR:NEAR,SCRTCH:NEAR
EXTRN LINGET:NEAR
EXTRN $DELETE:NEAR
PUBLIC CHAIN,COMMON
EXTRN PTRGTN:NEAR,PTRGTR:NEAR
EXTRN MOVE1:NEAR,NEWSTT:NEAR,PTRGET:NEAR,STRCPY:NEAR
EXTRN GARBA2:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN FRETOP:WORD
DSEG ENDS
;
;
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN SAVFRE:WORD
DSEG ENDS
EXTRN IADAHL:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN TEMP3:WORD,TEMP9:WORD,VARTAB:WORD,ARYTAB:WORD,CHNFLG:WORD
EXTRN STREND:WORD
EXTRN CURLIN:WORD,SAVSTK:WORD,ENDBUF:WORD,MRGFLG:WORD,MDLFLG:WORD
EXTRN CHNLIN:WORD,CMEPTR:WORD,CMSPTR:WORD
DSEG ENDS
EXTRN BLTUC:NEAR,DATA:NEAR
EXTRN FNDLIN:NEAR,USERR:NEAR,ERSFIN:NEAR,FCERR:NEAR,NOARYS:NEAR
EXTRN DEL:NEAR,LINKER:NEAR,SCNLIN:NEAR,FRQINT:NEAR
; This is the code for the CHAIN statement
; The syntax is:
; CHAIN [MERGE]<file name>[,[<line number>][,ALL][,DELETE <range>]]
; The steps required to execute a CHAIN are:
;
; 1.) Scan arguments
;
; 2.) Scan program for all COMMON statements and
; mark specified variables.
;
; 3.) Squeeze unmarked entries from symbol table.
;
; 4.) Copy string literals to string space
;
; 5.) Move all simple variables and arrays into the
; bottom of string space.
;
; 6.) Load new program
;
; 7.) Move variables back down positioned after program.
;
; 8.) Run program
CHAIN:
XOR AL,AL ;Assume no MERGE
MOV BYTE PTR MRGFLG,AL
MOV BYTE PTR MDLFLG,AL ;Also no MERGE w/ DELETE option
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN OPTFLG:WORD,TOPTFG:WORD,OPTVAL:WORD,TOPTVL:WORD
DSEG ENDS
MOV AL,BYTE PTR OPTFLG
MOV BYTE PTR TOPTFG,AL ;SAVE OPTION BASE VALUE
MOV AL,BYTE PTR OPTVAL ;SAVE OPTION VALUE FOR ARRAY BASE
MOV BYTE PTR TOPTVL,AL
MOV AL,BYTE PTR [BX] ;Get current char
MOV DX,OFFSET $MERGE ;Is it MERGE?
CMP AL,DL ;Test
JNZ SHORT NTCHNM ;NO
MOV BYTE PTR MRGFLG,AL ;Set MERGE flag
INC BX
NTCHNM: DEC BX ;Rescan file name
CALL CHRGTR
EXTRN PRGFLI:NEAR
CALL PRGFLI ;Evaluate file name and OPEN it
PUSH BX ;Save text pointer
MOV BX,0 ;Get zero
MOV CHNLIN,BX ;Assume no CHAIN line #
POP BX ;Restore text pointer
DEC BX ;Back up pointer
CALL CHRGTR ;Scan char
JNZ SHORT ??L001
JMP NTCHAL ;No line number etc.
??L001:
CALL SYNCHR
DB OFFSET 54O ;Must be comma
CMP AL,LOW 54O ;Ommit line # (Use ALL for instance)
JZ SHORT NTLINF ;YES
CALL FRMEVL ;Evaluate line # formula
PUSH BX ;Save text poiner
CALL FRQINT ;Force to int in [H,L]
MOV CHNLIN,BX ;Save it for later
POP BX ;Restore text poiner
DEC BX ;Rescan last char
CALL CHRGTR
JZ SHORT NTCHAL ;No ALL i.e. preserve all vars across CHAIN
NTLINF: CALL SYNCHR
DB OFFSET 54O ;Should be comma here
MOV DX,OFFSET $DELETE ;Test for DELETE option
CMP AL,DL ;Is it?
JZ SHORT CHMWDL ;Yes
CALL SYNCHR
DB OFFSET "A" ;Check for "ALL"
CALL SYNCHR
DB OFFSET "L"
CALL SYNCHR
DB OFFSET "L"
JNZ SHORT ??L002
JMP DNCMDA ;Goto step 3
??L002:
CALL SYNCHR
DB OFFSET 54O ;Force comma to appear
CMP AL,DL ;Must be DELETE
JZ SHORT ??L003
JMP SNERR ;No, give error
??L003:
OR AL,AL ;Flag to goto DNCMDA
CHMWDL: PUSHF ;Save ALL flag
MOV BYTE PTR MDLFLG,AL ;Set MERGE w/ DELETE
CALL CHRGTR ;Get char after comma
CALL SCNLIN ;Scan line range
EXTRN DEPTR:NEAR
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 1st line
MOV BX,CX ;Save pointer to start line
MOV CMSPTR,BX
CALL FNDLIN ;Find the last line
JAE SHORT FCERRG ;Must have exact match on end of range
MOV DH,BH ;[D,E] = pointer at the start of the line
MOV DL,BL ;beyond the last line in the range
MOV CMEPTR,BX ;Save pointer to end line
POP BX ;Get back pointer to start of range
CMP BX,DX ;Make sure the start comes before the end
FCERRG: JNAE SHORT ??L004
JMP FCERR ;If not, "Illegal function call"
??L004:
POPF ;Flag that says whether to go to DNCMDA
JZ SHORT ??L005
JMP DNCMDA ;"ALL" option was present
??L005:
NTCHAL: MOV BX,CURLIN ;Save current line number on stack
PUSH BX
MOV BX,TXTTAB ;Start searching for COMMONs at program start
DEC BX ;Compensate for next instr
CLPSC1: INC BX ;Look at first char of next line
CLPSCN: MOV AL,BYTE PTR [BX] ;Get char from program
INC BX
OR AL,BYTE PTR [BX] ;Are we pointing to program end?
JNZ SHORT ??L006
JMP CLPFIN ;Yes
??L006:
INC BX
MOV DX,[BX] ;Get line # in [D,E]
INC BX
MOV CURLIN,DX ;Save current line # in CURLIN for errors
CSTSCN: CALL CHRGTR ;Get statment type
AFTCOM: OR AL,AL
JZ SHORT CLPSC1 ;EOL Scan next one
CMP AL,LOW ":" ;Are we looking at colon
JZ SHORT CSTSCN ;Yes, get next statement
CMP AL,LOW 254D ;COMMONs prceeded by 254
JNZ SHORT NOCOMM ;not one
INC BX ;move ahead
MOV AL,BYTE PTR [BX]
MOV DX,OFFSET $COMMON ;Test for COMMON, avoid byte externals
CMP AL,DL ;Is it a COMMON?
JZ SHORT DOCOMM ;Yes, handle it
DEC BX ;Back up the pointer.
NOCOMM: CALL CHRGTR ;Get first char of statement
CALL DATA ;Skip over statement
DEC BX ;Back up to rescan terminator
JMP SHORT CSTSCN ;Scan next one
DOCOMM: CALL CHRGTR ;Get thing after COMMON
JZ SHORT AFTCOM ;Get next thing
NXTCOM: PUSH BX ;Save text pointer
MOV AL,LOW 1 ;Call PTRGET to search for array
MOV BYTE PTR SUBFLG,AL
CALL PTRGTN ;This subroutine in F3 scans variables
JZ SHORT FNDAAY ;Found array
MOV AL,CH ;Try finding array with COMMON bit set
OR AL,LOW 128D
MOV CH,AL
XOR AL,AL ;Set zero CC
CALL ERSFIN ;Search array table
MOV AL,LOW 0 ;Clear SUBFLG in all cases
MOV BYTE PTR SUBFLG,AL
JNZ SHORT NTFN2T ;Not found, try simple
MOV AL,BYTE PTR [BX] ;Get terminator, should be "("
CMP AL,LOW "(" ;Test
JNZ SHORT SCNSMP ;Must be simple then
POPF ;Get rid of saved text pointer
JMP SHORT COMADY ;Already was COMMON, ignore it
NTFN2T: MOV AL,BYTE PTR [BX] ;Get terminator
CMP AL,LOW "(" ;Array specifier?
POP DX ;(DE:=saved text pointer.)
JZ SHORT SKPCOM ;Yes, undefined array - just skip it.
PUSH DX ;No, resave pointer to start of variable
SCNSMP: POP BX ;Rescan variable name for start
CALL PTRGTN ;Evaluate as simple
OR DX,DX ;If var not found, [D,E]=0
JNZ SHORT COMFNS ;Found it
MOV AL,CH ;Try to find in COMMON
OR AL,LOW 128D ;Set COMMON bit
MOV CH,AL
MOV DX,OFFSET COMPT2 ;push on return address
PUSH DX
MOV DX,OFFSET PTRGTR ;address to common return point
PUSH DX
MOV AL,BYTE PTR VALTYP ;Must have VALTYP in [D]
MOV DH,AL
JMP NOARYS ;Search symbol table
COMPT2: OR DX,DX ;Found?
JZ SHORT SKPCOM ;No, just skip over this variable.
COMFNS: PUSH BX ;Save text pointer
MOV CH,DH ;Get pointer to var in [B,C]
MOV CL,DL
MOV BX,OFFSET BCKUCM ;Loop back here
PUSH BX
CBAKBL: DEC CX ;Point at first char of rest
LPBKNC: MOV SI,CX
MOV AL,[SI] ;Back up until plus byte
DEC CX
OR AL,AL
JNS SHORT ??L007
JMP LPBKNC
??L007:
;Now point to 2nd char of var name
MOV SI,CX
MOV AL,[SI] ;set COMMON bit
OR AL,LOW 128D
MOV DI,CX
STOSB
RET ;done
FNDAAY: MOV BYTE PTR SUBFLG,AL ;Array found, clear SUBFLG
MOV AL,BYTE PTR [BX] ;Make sure really array spec
CMP AL,LOW "(" ;Really an array?
JNZ SHORT SCNSMP ;No, scan as simp
POP SI ;XTHL
XCHG SI,BX
PUSH SI ;Save text pointer, get rid of saved text pointer
BAKCOM: DEC CX ;Point at last char of name extension
DEC CX
CALL CBAKBL ;Back up before variable and mark as COMMON
BCKUCM: POP BX ;Restore text pointer
SKPCOM: DEC BX ;Rescan terminator
CALL CHRGTR
JNZ SHORT ??L008
JMP AFTCOM ;End of COMMON statement
??L008:
CMP AL,LOW "(" ;End of COMMON array spec?
JNZ SHORT CHKCST ;No, should be comma
COMADY: PUSH BX
CALL CHRGTR ;Fetch char after paren
CMP AL,LOW ")"
JZ SHORT COMRPN ;Only right paren follows
POP BX
EXTRN EVAL:NEAR
CALL EVAL ;Possible number of dimensions(compiler compatible)
CALL GETYPR
JNZ SHORT ??L009
JMP FCERR ;Dimensions argument cannot be string
??L009:
JMP SHORT COMRP1
COMRPN: POP DX
COMRP1: CALL SYNCHR
DB OFFSET ")" ;Right paren should follow
JNZ SHORT ??L010
JMP AFTCOM ;End of COMMON
??L010:
CHKCST: CALL SYNCHR
DB OFFSET 54O ;Force comma to appear here
JMP NXTCOM ;Get next COMMON variable
; Step 3 - Squeeze..
CLPFIN: POP BX ;Restore previous CURLIN
MOV CURLIN,BX
MOV DX,ARYTAB ;End of simple var squeeze to [D,E]
MOV BX,VARTAB ;Start of simps
CLPSLP: CMP BX,DX ;Are we done?
JZ SHORT DNCMDS ;Yes done, with simps
PUSH BX ;Save where this simp is
MOV CL,BYTE PTR [BX] ;Get VALTYP
INC BX
INC BX
MOV AL,BYTE PTR [BX] ;Get COMMON bit
OR AL,AL ;Set minus if COMMON
PUSHF ;Save indicator
AND AL,LOW 177O ;Clear COMMON bit
MOV BYTE PTR [BX],AL ;Save back
INC BX
CALL IADAHL ;Skip over rest of var name
MOV CH,LOW 0 ;Skip VALTYP bytes
ADD BX,CX
POPF ;Get indicator whether to delete
POP CX ;Pointer to where var started
JNS SHORT ??L011
JMP CLPSLP
??L011:
PUSH CX ;This is where we will resume scanning vars later
CALL VARDLS ;Delete variable
MOV BX,ARYTAB ;Now correct ARYTAB by # of bytes deleted
ADD BX,DX ;Add negative difference between old and new
MOV ARYTAB,BX ;Save new ARYTAB
XCHG BX,DX ;To [D,E]
POP BX ;Get current place back in [H,L]
JMP SHORT CLPSLP
VARDLS: XCHG BX,DX ;Point to where var ends
VARDL1: MOV BX,STREND ;One beyond last byte to move
DLSVLP: CMP BX,DX ;Done?
MOV SI,DX
MOV AL,[SI] ;Grab byte
MOV DI,CX
STOSB ;Move down
LAHF
INC DX ;Increment pointers
SAHF
LAHF
INC CX
SAHF
JNZ SHORT DLSVLP
MOV AL,CL ;Get difference between old and new
SUB AL,BL ;Into [D,E] ([D,E]=[B,C]-[H,L])
MOV DL,AL
MOV AL,CH
SBB AL,BH
MOV DH,AL
DEC DX ;Correct # of bytes
DEC CX ;Moved one too far
MOV BX,CX ;Get new STREND [H,L]
MOV STREND,BX ;Store it
RET
DNCMDS: MOV DX,STREND ;Limit of array search
CLPAKP: CMP BX,DX ;Done?
JZ SHORT DNCMDA ;Yes
PUSH BX ;Save pointer to VALTYP
INC BX ;Move down to COMMON bit
INC BX
MOV AL,BYTE PTR [BX] ;Get it
OR AL,AL ;Set CC's
PUSHF ;Save COMMON indicator
AND AL,LOW 177O ;Clear COMMON bit
MOV BYTE PTR [BX],AL ;Save back
INC BX ;Point to length of array
CALL IADAHL ;Add length of var name
MOV CL,BYTE PTR [BX] ;Get length of array in [B,C]
INC BX
MOV CH,BYTE PTR [BX]
INC BX
ADD BX,CX ;[H,L] now points after array
POPF ;Get back COMMON indicator
POP CX ;Get pointer to start of array
JNS SHORT ??L012
JMP CLPAKP ;COMMON, dont delete!
??L012:
PUSH CX ;Save so we can resume
CALL VARDLS ;Delete the array
XCHG BX,DX ;Returns with STREND in HL, so put in DE
POP BX ;Get back pointer to the next array
JMP SHORT CLPAKP ;Check next array
; Step 4 - Copy literals into string space
; This code is very similar to the string garbage collect code
; If BIGSTR is on, we also have to fix up the string back pointers.
DNCMDA:
MOV BX,VARTAB ;Look at simple strings
CSVAR: MOV DX,ARYTAB ;Limit of search to [D,E]
CMP BX,DX ;Done?
JZ SHORT CAYVAR ;Yes
CALL SKPNAM ;Skip name, returns Z if was a string
JNZ SHORT CSKPVA ;Skip this var, not string
CALL CDVARS ;Copy this guy into string space if nesc
XOR AL,AL ;CDVARS has already incremented [H,L]
CSKPVA:
MOV DL,AL
MOV DH,LOW 0 ;Add length of VALTYP
ADD BX,DX
JMP SHORT CSVAR
CAYVA2: POP CX ;Adjust stack
CAYVAR: MOV DX,STREND ;New limit of search
CMP BX,DX ;Done?
JZ SHORT DNCCLS ;Yes
CALL SKPNAM ;Skip over name
PUSH AX ;Save VALTYP
MOV CL,BYTE PTR [BX] ;Get length of array
INC BX
MOV CH,BYTE PTR [BX] ;Into [B,C]
INC BX
POP AX ;Get back VALTYP
PUSH BX ;Save pointer to array element
ADD BX,CX ;Point after array
CMP AL,LOW 3 ;String array?
JNZ SHORT CAYVA2 ;No, look at next one
MOV TEMP3,BX ;Save pointer to end of array
POP BX ;Get back pointer to array start
MOV CL,BYTE PTR [BX] ;Pick up number of DIMs
MOV CH,LOW 0 ;Make double with high zero
ADD BX,CX ;Go past DIMS
ADD BX,CX
INC BX ;One more to account for # of DIMs
CAYSTR: MOV DX,TEMP3 ;Get end of array
CMP BX,DX ;See if at end of array
JZ SHORT CAYVAR ;Get next array
MOV CX,OFFSET CAYSTR ;Do next str in array
PUSH CX ;Save branch address on stack
CDVARS:
MOV AL,BYTE PTR [BX] ;Get length of array entry
INC BX ;Also pick up pointer into [D,E]
MOV DX,[BX] ;Get data pointer
INC BX
INC BX
OR AL,AL ;Set CC's on length
JNZ SHORT $+3
RET ;Ignore null strings
PUSH BX ;Save where we are
MOV BX,VARTAB ;Is string in program text or disk buffers?
CMP BX,DX ;Compare
POP BX ;Restore where we are
JNB SHORT $+3
RET ;No, must be in string space
PUSH BX ;save where we are again.
MOV BX,TXTTAB ;is it in buffers?
CMP BX,DX ;test
POP BX ;Restore where we are
JNAE SHORT $+3
RET ;in buffers, do nothing
PUSH BX ;Save where we are for nth time
DEC BX ;Point to start of descriptor
DEC BX
DEC BX
PUSH BX ;Save pointer to start
CALL STRCPY ;Copy string into DSCTMP
POP BX ;Destination in [H,L], source in [D,E]
MOV CH,LOW 3 ;# of bytes to move
CALL MOVE1 ;Move em
POP BX ;Where we are
RET
; Step 5 - Move stuff up into string space!
DNCCLS:
CALL GARBA2 ;Get rid of unused strings
MOV BX,STREND ;Load end of vars
MOV CX,BX ;Into [B,C]
MOV DX,VARTAB ;Start of simps into [D,E]
MOV BX,ARYTAB
SUB BX,DX ;Get length of simps in [H,L]
MOV TEMP9,BX ;Save here
MOV BX,FRETOP ;Destination of high byte
MOV SAVFRE,BX ;Save FRETOP to restore later
CALL BLTUC ;Move stuff up
MOV BX,CX ;Now adjust top of memory below saved vars
DEC BX ;One lower to be sure
MOV FRETOP,BX ;Update FRETOP to reflect new value
MOV AL,BYTE PTR MDLFLG ;MERGE w/ DELETE?
OR AL,AL ;Test
JZ SHORT NTMDLT ;No
MOV BX,CMSPTR ;Start of lines to delete
MOV CX,BX ;Into [B,C]
MOV BX,CMEPTR ;End of lines to delete
CALL DEL ;Delete the lines
MOV ARYTAB,BX ;***also set up ARYTAB and STREND
MOV STREND,BX ;in case we get error in CHAIN
;because of file lookup and then have to
;look at variables later (shouldnt be any)
;***PGA 7/7/81
CALL LINKER ;Re-link lines just in case
; Step 6 - load new program
NTMDLT: MOV AL,LOW 1 ;Set CHAIN flag
MOV BYTE PTR CHNFLG,AL
EXTRN CHNENT:NEAR,OKGETM:NEAR
MOV AL,BYTE PTR MRGFLG ;MERGEing?
OR AL,AL ;Set cc'S
JZ SHORT ??L013
JMP OKGETM ;Do MERGE
??L013:
JMP CHNENT ;Jump to LOAD code
; Step 7 - Move stuff back down
PUBLIC CHNRET
CHNRET:
MOV AL,BYTE PTR TOPTVL
MOV BYTE PTR OPTVAL,AL ;RESTORE IOTION BASE VALUE
MOV AL,BYTE PTR TOPTFG
MOV BYTE PTR OPTFLG,AL ;LRESTORE OPTION FLG
XOR AL,AL ;Clear CHAIN, MERGE flags
MOV BYTE PTR CHNFLG,AL
MOV BYTE PTR MRGFLG,AL
MOV BX,VARTAB ;Get current VARTAB
MOV CX,BX ;Into [B,C]
MOV BX,TEMP9 ;Get length of simps
ADD BX,CX ;Add to present VARTAB to get new ARYTAB
MOV ARYTAB,BX
MOV BX,FRETOP ;Where to start moving
INC BX ;One higher
XCHG BX,DX ;Into [D,E]
MOV BX,SAVFRE ;Last byte to move
MOV FRETOP,BX ;Restore FRETOP from this
MVBKVR: CMP BX,DX ;Done?
MOV SI,DX
MOV AL,[SI] ;Move byte down
MOV DI,CX
STOSB
LAHF
INC DX ;Increment pointers
SAHF
LAHF
INC CX
SAHF
JNZ SHORT MVBKVR
DEC CX ;Point to last var byte
MOV BX,CX ;[H,L]=last var byte
MOV STREND,BX ;This is new end
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN NLONLY:WORD
DSEG ENDS
XOR AL,AL ;
MOV BYTE PTR NLONLY,AL ;allow all files to be closed
EXTRN FINPRT:NEAR
CALL FINPRT ;close file zero and reset PTRFIL to 0
XOR AL,AL
CALL RESTORE ;Make sure DATA is valid by doing RESTORE
MOV DX,CHNLIN ;Get CHAIN line # in [D,E]
MOV BX,TXTTAB ;Get prog start in [H,L]
DEC BX ;Point at zero before program
OR DX,DX ;line number zero?
JNZ SHORT ??L014
JMP NEWSTT ;line #=0, go...
??L014:
CALL FNDLIN ;Try to find destination line
JNAE SHORT ??L015
JMP USERR ;Not there...
??L015:
DEC CX ;Point to zero on previous line
MOV BX,CX ;Make text pointer for NEWSTT
JMP NEWSTT ;Bye...
;
; Convenience routine to skip a variable's name pointed to by HL.
; Returns VALTYP in A with the zero flag set if it is a string.
;
PUBLIC SKPNAM
SKPNAM:
MOV AL,BYTE PTR [BX] ;Get VALTYP
INC BX ;Point to length of long var name
INC BX
INC BX
PUSH AX ;Save VALTYP
CALL IADAHL ;Move past long variable name
POP AX ;Get back VALTYP
CMP AL,LOW 3 ;String?
RET
;
;
COMMON:
JMP DATA
SUBTTL WRITE
EXTRN FINPRT:NEAR
EXTRN FOUT:NEAR,STRLIT:NEAR,STRPRT:NEAR,OUTDO:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN FACLO:WORD
DSEG ENDS
PUBLIC WRITE
WRITE:
EXTRN FILGET:NEAR
MOV CL,LOW OFFSET MD_SQO ;Setup output file
CALL FILGET
WRTCHR: DEC BX
CALL CHRGTR ;Get another character
JZ SHORT WRTFIN ;Done with WRITE
WRTMLP: CALL FRMEVL ;Evaluate formula
PUSH BX ;Save the text pointer
CALL GETYPR ;See if we have a string
JZ SHORT WRTSTR ;We do
CALL FOUT ;Convert to a string
CALL STRLIT ;Literalize string
MOV BX,FACLO ;Get pointer to string
INC BX ;Point to address field
MOV DX,[BX]
INC BX
MOV SI,DX
MOV AL,[SI] ;Is number positive?
CMP AL,LOW " " ;Test
JNZ SHORT WRTNEG ;No, must be negative
INC DX
MOV BYTE PTR [BX],DH
DEC BX
MOV BYTE PTR [BX],DL
DEC BX
DEC BYTE PTR [BX] ;Adjust length of string (length.LT.255 so OK)
WRTNEG: CALL STRPRT ;Print the number
NXTWRV: POP BX ;Get back text pointer
DEC BX ;Back up pointer
CALL CHRGTR ;Get next char
JZ SHORT WRTFIN ;end
CMP AL,LOW 59 ;Semicolon?
JZ SHORT WASEMI ;Was one
CALL SYNCHR
DB OFFSET 54O ;Only possib left is comma
DEC BX ;to compensate for later CHRGET
WASEMI: CALL CHRGTR ;Fetch next char
MOV AL,LOW 54O ;put out comma
CALL OUTDO
JMP SHORT WRTMLP ;Back for more
WRTSTR: MOV AL,LOW 34 ;put out double quote
CALL OUTDO ;Send it
CALL STRPRT ;print the string
MOV AL,LOW 34 ;Put out another double quote
CALL OUTDO ;Send it
JMP SHORT NXTWRV ;Get next value
WRTFIN:
EXTRN CMPFBC:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN PTRFIL:WORD
DSEG ENDS
PUSH BX ;Save text pointer
MOV BX,PTRFIL ;See if disk file
MOV AL,BH
OR AL,BL
JZ SHORT NTRNDW ;No
PUSH BX ;Save FDB pointer
MOV CX,OFFSET F_DEV
ADD BX,CX ;HL points to Device Entry in FDB
MOV AL,BYTE PTR [BX] ;[A]=device id
OR AL,AL ;if disk [A] will be 0..n
POP BX
JNS SHORT ??L016
JMP NTRNDW ;branch if special device ([A] is negative)
??L016:
PUSH BX
MOV CX,OFFSET F_MODE
ADD BX,CX ;HL points to File Mode Byte in FDB
MOV AL,BYTE PTR [BX] ;[A]=file mode
POP BX ;Restore FDB pointer
CMP AL,LOW OFFSET MD_RND ;Random?
JNZ SHORT NTRNDW ;NO
CALL CMPFBC ;See how many bytes left
MOV AL,BL ;do subtract
SUB AL,DL
MOV BL,AL
MOV AL,BH
SBB AL,DH
MOV BH,AL
CRLFSQ=2 ;Number of bytes in CR/LF sequence
MOV DX,OFFSET 0-CRLFSQ ;Subtract bytes in <cr>
LAHF
ADD BX,DX
RCR SI,1
SAHF
RCL SI,1
JAE SHORT NTRNDW ;Not enough, give error eventually
NXTWSP: MOV AL,LOW " " ;Put out spaces
CALL OUTDO ;Send space
DEC BX ;Count down
MOV AL,BH ;Count down
OR AL,BL
JNZ SHORT NXTWSP
NTRNDW: POP BX ;Restore [H,L]
CALL CRDO ;Do crlf
JMP FINPRT
CSEG ENDS
END