; [ 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