; [ 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 DSKCOM - - COMMON ROUTINES FOR DISK BASICS

ALPCPM=0

MELCO=0

MODEL3=0

DSEG SEGMENT PUBLIC 'DATASG' ; Data Segment

ASSUME DS:DSEG

EXTRN CURLIN:WORD,DSCTMP:WORD,PTRFIL:WORD,FRETOP:WORD

EXTRN SAVSTK:WORD,TXTTAB:WORD,VALTYP:WORD,VARTAB:WORD

EXTRN BUF:WORD

EXTRN DIRTMP:WORD

DSEG ENDS ;End of data segment externals

; Code Segment ( terminated by END at bottom of file )

EXTRN CLSFIL:NEAR,CONINT:NEAR,DERBFN:NEAR,DERRPE:NEAR,ERROR:NEAR

EXTRN FILOU3:NEAR,CHRGTR:NEAR

EXTRN INDSKC:NEAR,PRGFIL:NEAR,SCRTCH:NEAR,SNERR:NEAR

EXTRN STRLT3:NEAR,DERFOV:NEAR,DERBFM:NEAR,DOCNVF:NEAR,FCERR:NEAR

EXTRN FINBCK:NEAR,FINPRT:NEAR,FRCSTR:NEAR,FRESTR:NEAR

EXTRN FRMEVL:NEAR,GETBYT:NEAR,GETSPA:NEAR,GTBYTC:NEAR,GTMPRT:NEAR

EXTRN INCHRI:NEAR

EXTRN LINKER:NEAR,LIST:NEAR,MAIN:NEAR,NEWSTT:NEAR,OMERR:NEAR

EXTRN PTRGET:NEAR,PUTNEW:NEAR,READY:NEAR,RUNC:NEAR

EXTRN VMOVFM:NEAR,VMOVMF:NEAR,STRINI:NEAR

EXTRN FRMEQL:NEAR

EXTRN ENDCON:NEAR,GONE:NEAR

EXTRN DOASIG:NEAR,ERRFDR:NEAR,FIN:NEAR

EXTRN SCCPTR:NEAR

EXTRN GETYPR:NEAR,SYNCHR:NEAR,DCOMPR:NEAR

PUBLIC FIELD,PRGFLI

PUBLIC FILIND

PUBLIC MKI$,MKS$,MKD$,CVI,CVS,CVD

PUBLIC DLINE,PRGFL2,LRUN,LOAD,PRGFIN,MERGE,SAVE

PUBLIC OKGETM

PUBLIC RSET,LSET

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN PROFLG:WORD

DSEG ENDS

INCLUDE GIO86U

CPM86=0

INCLUDE MSDOSU

NMLOFS=F_BREM

.RADIX 10

COMMENT % REVISION HISTORY

4/23/78 PGA ALLOW # ON CLOSE

8/6/79 PGA IF ^C ON MBASIC FOO, DONT RETURN TO SYSTEM. SEE 'NOTINI'

6/27/80 PGA FIX INPUT#1,D# SO IT USES FINDBL INSTEAD OF FIN

AND THUS AVOIDS LOSING SIGNIFICANCE.

%

SUBTTL FILINP AND FILGET -- SCAN A FILE NUMBER AND SETUP PTRFIL

EXTRN FILINP:NEAR,FILSCN:NEAR,FILSET:NEAR

SUBTTL FILSCN, FILFRM, AND FILIDX

SUBTTL Conversion Routines

MKI$: MOV AL,LOW 2 ;VALUE TYPE FOR INTEGER AND NUMBER

;OF CHARACTERS RESULT WILL NEED

DB 271O ; SKIP ;SKIP NEXT TWO BYTES WITH "LXI B,"

MKS$: MOV AL,LOW 4 ;VALUE TYPE OF SINGLE PRECISION

DB 271O ; SKIP ;SKIP NEXT TWO BYTES

MKD$: MOV AL,LOW 8 ;VALUE TYPE OF DOUBLE-PRECISION

PUSH AX ;SAVE THE NUMBER OF BYTES OF

;STRING SPACE WE NEED

CALL DOCNVF ;CONVERT FAC TO PROPER TYPE

POP AX ;GET THE NUMBER OF BYTES NEEDED

CALL STRINI ;GET A PLACE FOR THE STRING DATA

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN DSCPTR:WORD

DSEG ENDS

MOV BX,DSCPTR ;POINT TO THE PLACE TO STORE THE DATA

CALL VMOVMF ;MOVE THE FAC VALUE INTO THE STRING CREATION

JMP FINBCK

CVI: MOV AL,LOW 1 ;SET [A] TO BE VALTYP-1

DB 271O ; SKIP ;SKIP THE NEXT TWO BYTES WITH "LXI B,"

CVS: MOV AL,LOW 3 ;ALSO SET [A] TO NUMBER OF CHARACTERS REQUIRED -1

DB 271O ; SKIP ;SKIP THE NEXT TWO BYTES

CVD: MOV AL,LOW 7 ;DOUBLE PRECISION VALUE TYPE -1

PUSH AX ;SAVE THE VALTYP

CALL FRESTR ;MAKE SURE THE ARGUMENT IS A STRING

;AND GET A POINTER TO THE DESCRIPTOR

POP AX ;GET BACK NUMBER OF CHARACTERS REQUIRED-1

CMP AL,BYTE PTR [BX] ;MAKE SURE THE STRING IS LONGER THAN THAT

JNAE SHORT ??L000

JMP FCERR ;IF NOT, "ILLEGAL FUNCTION CALL"

??L000:

INC AL ;[A]=TRUE VALUE TYPE

MOV BYTE PTR VALTYP,AL ;SETUP VALUE TYPE FOR MOVE

INC BX

MOV BX,[BX] ;[H,L]=POINTER AT STRING DATA

;AND FOR IDENTIFICATION

JMP VMOVFM

SUBTTL Read Items From A Sequential File

FILIND:

CALL GETYPR ;SEE IF INPUT IS STRING OR NUMBER

MOV CX,OFFSET DOASIG ;RETURN ADDRESS TO SETUP [FAC]

CON1=0 (44*256) 32

MOV DX,OFFSET CON1 ;SETUP TERMINATORS SPACE AND COMMA

JNZ SHORT INPDOR ;IF NUMERIC, GO READ THE FILE

MOV DL,DH ;MAKE BOTH TERMINATORS COMMA

JMP SHORT INPDOR ;GO READ THE FILE

;

; Entry for line input and read code for item fetching from

; sequential input files

;

DLINE:

CALL FILINP ;GET FILE NUMBER SET UP

CALL PTRGET ;READ STRING TO STORE INTO

CALL FRCSTR ;MAKE SURE IT WAS A STRING

MOV CX,OFFSET FINPRT ;RESET TO CONSOLE WHEN DONE READING

PUSH CX ;SAVE ON STACK

PUSH DX ;SAVE POINTER AT VARIABLE

EXTRN LETCON:NEAR

MOV CX,OFFSET LETCON ;GOOD RETURN ADDRESS FOR ASSIGNMENT

XOR AL,AL ;SET A=0 FOR STRING VALUE TYPE

MOV DH,AL ;ZERO OUT BOTH TERMINATORS

MOV DL,AL

INPDOR: PUSH AX ;SAVE VALUE TYPE

PUSH CX ;SAVE RETURN ADDRESS

PUSH BX ;SAVE POINTER AT DATA COMING IN

;A DUMMY POINTER AT BUFMIN

NOTNWT:

EXTRN INCHR:NEAR

CALL INCHR ;Read a character from file PTRFIL

CMP AL,LOW " " ;SKIP LEADING SPACES

JNZ SHORT NOTSPC ;EXCEPT FOR LINE INPUT

INC DH ;CHECK FOR LINEINPUT

DEC DH

JNZ SHORT NOTNWT ;SKIP ANY NUMBER

NOTSPC: CMP AL,LOW 34 ;QUOTED STRING COMING IN?

JNZ SHORT NOTQTE

MOV AL,DL ;MUST BE INPUT OF A STRING

CMP AL,LOW 44D ;WHICH HAS [E]=44 (",")

MOV AL,LOW 42O ;QUOTE BACK INTO [A]

JNZ SHORT NOTQTE

MOV DH,AL ;TERMINATORS ARE QUOTES ONLY

MOV DL,AL

CALL INDSKC ;READ PAST QUOTATION

JB SHORT QUITSI ;IF EOF, ALL DONE

NOTQTE:

MOV BX,OFFSET BUF ;BUFFER FOR DATA

MOV CH,LOW 255 ;MAXIMUM NUMBER OF CHARACTERS (255)

LOPCRS: MOV CL,AL ;SAVE CHARACTER IN [C]

MOV AL,DH ;CHECK FOR QUOTED STRING

CMP AL,LOW 42O

MOV AL,CL ;RESTORE CHARACTER

JZ SHORT NOTQTL ;DON'T IGNORE CR OR STOP ON LF

CMP AL,LOW 13 ;CR?

PUSH BX ;SAVE DEST PTR. ON STACK

JZ SHORT ICASLF ;EAT LINE FEED IF ONE

POP BX ;RESTORE DEST. PTR.

CMP AL,LOW 10 ;LF?

JNZ SHORT NOTQTL ;NO, TEST OTHER TERMINATORS

LPISLF: ;** 5/14/82 BUG FIX(MULTIPLE LF FOR UNQUOTED STRING)

MOV CL,AL ;SAVE CURRENT CHAR

MOV AL,DL ;GET TERMINATOR 2

CMP AL,LOW 54O ;CHECK FOR COMMA (UNQUOTED STRING)

MOV AL,CL ;RESTORE CHARACTER

JZ SHORT ??L001

CALL STRCHR ;IF NOT, STORE LF (?)

??L001:

CALL INDSKC ;GET NEXT CHAR

JB SHORT QUITSI ;IF EOF, ALL DONE.

CMP AL,LOW 10 ;** 5/14/82 BUG FIX(MULTIPLE LF FOR UNQUOTED STRING)

JZ SHORT LPISLF ;** 5/14/82 BUG FIX(MULTIPLE LF FOR UNQUOTED STRING)

CMP AL,LOW 13 ;IS IT A CR?

JNZ SHORT NOTQTL ;IF NOT SEE IF STORE NORMALLY

MOV AL,DL ;GET TERMINATOR

CMP AL,LOW " " ;IS IT NUMERIC INPUT?

JZ SHORT LPCRGT ;IF SO, IGNORE CR, DONT PUT IN BUFFER

CMP AL,LOW 44 ;IS IT NON-QUOTED STRING (TERM=,)

MOV AL,LOW 13 ;GET BACK CR.

JZ SHORT LPCRGT ;IF SO, IGNORE CR.

NOTQTL: OR AL,AL ;IS CHAR ZERO

JZ SHORT LPCRGT ;ALWAYS IGNORE, AS IT IS TERMINATOR

;FOR STRLIT (SEE QUIT2B)

CMP AL,DH ;TERMINATOR ONE?

JZ SHORT QUITSI ;STOP THEN

CMP AL,DL ;TERMINATOR TWO?

JZ SHORT QUITSI

CALL STRCHR ;SAVE THE CHAR

LPCRGT: CALL INDSKC ;READ ANOTHER CHARACTER

JAE SHORT LOPCRS ;IF NOT, CHECK AS TERMINATOR

QUITSI: PUSH BX ;SAVE PLACE TO STUFF ZERO

CMP AL,LOW 34 ;STOPPED ON QUOTE?

JZ SHORT MORSPC ;DON'T SKIP SPACES THEN

;BUT DO SKIP FOLLOWING COMMA OR

;CRLF THOUGH

CMP AL,LOW " " ;STOPPED ON SPACE?

JNZ SHORT NOSKCR ;NO, DON'T SKIP SPACES

;OR ANY FOLLOWING COMMAS OR CRLFS EITHER

MORSPC: CALL INDSKC ;READ SPACES

JB SHORT NOSKCR ;EOF, ALL DONE.

CMP AL,LOW " "

JZ SHORT MORSPC

CMP AL,LOW 44 ;COMMA?

JNZ SHORT ??L002

JMP NOSKCR ;OK, SKIP IT

??L002:

CMP AL,LOW 13 ;CARRIAGE RETURN?

JNZ SHORT BAKUPT ;BACK UP PAST THIS CHARACTER

ICASLF:

CALL INDSKC ;READ ANOTHER

JB SHORT NOSKCR ;EOF, ALL DONE.

CMP AL,LOW 10 ;LINE FEED?

JZ SHORT NOSKCR ;OK, SKIP IT TOO

BAKUPT:

EXTRN BAKCHR:NEAR

CALL BAKCHR ;backup file PTRFIL

NOSKCR: POP BX ;GET BACK PLACE TO STORE TERMINATOR

QUIT2B: MOV BYTE PTR [BX],LOW 0 ;STORE THE TERMINATOR

MOV BX,OFFSET BUF-1 ;ITEM IS NOW STORED AT THIS POINT 1

MOV AL,DL ;WAS IT A NUMERIC INPUT?

SUB AL,LOW " " ;IF SO, [E]=" "

JZ SHORT NUMIMK ;USE FIN TO SCAN IT

EXTRN STRLT2:NEAR

MOV CH,DH ;SET [B]=44 IF SCANNING UNQUOTED STRING

MOV DH,LOW 0

CALL STRLT2

POP BX ;GET BACK [H,L]

RET ;DO ASSIGNMENT

NUMIMK:

CALL GETYPR ;GET TYPE OF NUMERIC VARIABLE BEING READ

LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;SAVE IT

CALL CHRGTR ;READ FIRST CHARACTER

POP AX ; POP PSW

XCHG AL,AH

SAHF ;RESTORE TYPE OF VARIABLE

LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;SAVE BACK

JNB SHORT ??L003

CALL FIN ;SINGLE PRECISION INPUT

??L003:

POP AX ; POP PSW

XCHG AL,AH

SAHF ;GET BACK TYPE OF VAR

EXTRN FINDBL:NEAR

JNAE SHORT ??L004

CALL FINDBL

??L004: ;DOUBLE PRECISION INPUT

POP BX ;GET [H,L]

RET ;DO THE ASSIGNMENT

STRCHR: OR AL,AL ;TRYING TO STORE NULL BYTE

JNZ SHORT $ 3

RET ;RETURN, DONT STORE IT

MOV BYTE PTR [BX],AL ;STORE THE CHARACTER

INC BX

DEC CH ;128 YET?

JZ SHORT $ 3

RET ;MORE SPACE IN BUFFER, RETURN

POP CX ;GET RID OF SUPERFLUOUS STACK ENTRY

JMP SHORT QUIT2B ;SPECIAL QUIT

SUBTTL LOAD and RUN routines

PRGFLI: MOV DH,LOW OFFSET MD_SQI ;SEQUENTIAL INPUT MODE

PRGFL2: XOR AL,AL ;INTERNAL FILE NUMBER IS ALWAYS ZERO

JMP PRGFIL ;SCAN FILE NAME AND DISK NUMMER

;AND DO THE RIGHT THING USING MD.KIL

;AS A FLAG

LRUN:

LRUN2: MOV AL,LOW 1

JMP LRUN3 ;1 INDICATES, CLOSE FILES, RUN

LOAD: XOR AL,AL ;FLAG ZERO FOR "LOAD"

LRUN3: ;A=1 INDICATES CLOSE FILES, RUN

;A=0 INDICATES CLOSE FILES, NO RUN

LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;SAVE "RUN"/"LOAD" FLAG

CALL PRGFLI ;FIND THAT FILE AND SETUP FOR

;USING INDSKC SUBROUTINE

DEC BX ;SEE IF NO RUN OPTION

CALL CHRGTR

JZ SHORT NOTRNL ;NO, JUST LOAD

CALL SYNCHR

DB OFFSET 44 ;GOTTA HAVE A COMMA

CALL SYNCHR

DB OFFSET "R" ;ONLY OPTION IS RUN

JZ SHORT ??L005

JMP SNERR ;AND THAT BETTER BE THE END

??L005:

POP AX ; POP PSW

XCHG AL,AH

SAHF ;GET RID OF "RUN"/"LOAD" FLAG

; RUN fn closes all files, loads program, and executes program

; RUN fn,R loads program, and executes program

; LOAD fn closes all files, loads program

; LOAD fn,R loads program, and executes program

; MERGE fn merges an ASCII program

; CHAIN fn loads/merges a program, and executes program (leaving files opened)

;

PUBLIC CHNENT

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN RUNFLG:WORD

DSEG ENDS

CHNENT:

MOV AL,LOW 201O ;A=LEAVE FILES OPEN, RUN

JMP SHORT NOTRN1

NOTRNL: POP AX ; POP PSW

XCHG AL,AH

SAHF ;restore [A]=1 for RUN, 0 for LOAD

NOTRN1:

;Variable ",R" CHAIN LOAD RUN

MOV BYTE PTR RUNFLG,AL ;RUNFLG= ^O201 ^O201 0 1

OR AL,LOW 1 ;

MOV BYTE PTR NLONLY,AL ;NLONLY= ^O201 ^O201 1 1

;If NLONLY and 200 <> 0, don't close any files

;If NLONLY and 001 <> 0, don't close file 0

CALL SCRTCH ;Clear variables, close files

; BELOW IS FIX (TO LABEL NOTINI) SO THAT IF ^C DURING MBASIC FOO, WONT EXIT TO SYSTEM

MOV BX,CURLIN ;GET LINE NUMBER

LAHF

INC BX ;SEE IF IN INITIALIZATION

SAHF

MOV AL,BH

AND AL,BL

INC AL

JNZ SHORT NOTINI ;NO

MOV CURLIN,BX ;SAVE DIRECT LINE NUMBER

NOTINI:

CALL INDSKC ;READ THE FIRST CHARACTER

JAE SHORT ??L006

JMP MAIN ;ALL DONE IF NOTHING IN FILE

??L006:

CMP AL,LOW 254 ;IS THIS A PROTECTED FILE?

JNZ SHORT NTPROL ;NO

MOV BYTE PTR PROFLG,AL ;SET PROTECTED FILE

JMP SHORT BINLOD ;DO BINARY LOAD

NTPROL:

INC AL ;IS IT A BINARY FILE?

JZ SHORT ??L007

JMP MAINGO ;NO, SINCE PTRFIL IS NON-ZERO

??L007:

;INCHR WILL USE INDSKC INSTEAD OF POLLING

;THE TERMINAL

;WHEN EOF IS HIT PTRFIL WILL BE RESTORED

;AND LSTFRE WILL BE USED AS A FLAG

;TO INDICATE WHETHER TO RUN THE

;LOADED PROGRAM

;

; TIME FOR A BINARY LOAD.

; AFTER THE LOAD, THE FILE IS LINKED TOGETHER

; LSTFRE IS USED AS A FLAG WHETHER TO RUN OR NOT

;

BINLOD: MOV BX,TXTTAB ;GET PLACE TO START STORING INTO

EXTRN FSTLOD:NEAR

CALL FSTLOD ;USE FAST LOAD CODE IN DCPM.MAC

EXTRN PROLOD:NEAR

MOV VARTAB,BX ;SAVE END TEMP FOR DECODING

MOV AL,BYTE PTR PROFLG ;IS THIS A PROTECTED FILE?

OR AL,AL ;SET CC'S

JZ SHORT ??L008

CALL PROLOD

??L008: ;TRANSLATE TO GOOD STUFF

CALL LINKER ;FIX THE LINKS

INC BX ;WHEN LINKER RETURNS, [H,L]

INC BX ;POINTS TO DOUBLE ZERO

MOV VARTAB,BX ;UPDATE [VARTAB]

CALL RUNC ;SETUP ARYTAB, STREND

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN CHNFLG:WORD

DSEG ENDS

EXTRN CHNRET:NEAR

MOV AL,BYTE PTR CHNFLG ;CHAIN IN PROGRESS

OR AL,AL ;TEST

JZ SHORT ??L009

JMP CHNRET ;YES, GO BACK TO CHAIN CODE

??L009:

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN NLONLY:WORD

DSEG ENDS

XOR AL,AL ;

MOV BYTE PTR NLONLY,AL ;allow all files to be closed

CALL FINPRT ;reset PTRFIL to 0 and close file 0

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN RUNFLG:WORD

DSEG ENDS

MOV AL,BYTE PTR RUNFLG ;RUN OR NOT?

OR AL,AL

JNZ SHORT ??L010

JMP READY

??L010:

JMP NEWSTT

PRGFIN: CALL FINPRT ;ZERO PTRFIL

CALL CLSFIL ;CLOSE FILE ZERO

JMP GTMPRT ;REFETCH TEXT POINTER

PUBLIC OUTLOD

OUTLOD: CALL SCRTCH

JMP OMERR

;MERGE filespec Statement

; (OKGETM is called by CHAIN MERGE ... in FIVEO)

;

MERGE: POP CX ;ELIMINATE NEWSTT RETURN

CALL PRGFLI ;READ THE NAME AND DISK

DEC BX ;MUST END THERE

CALL CHRGTR

JZ SHORT OKGETM ;READ THE FILE

CALL PRGFIN ;CLOSE OUT TIME

JMP SNERR ;AND "SYNTAX ERROR"

OKGETM: XOR AL,AL ;NO RUN OPTION WITH "MERGE"

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN RUNFLG:WORD

DSEG ENDS

MOV BYTE PTR RUNFLG,AL ;SET UP THE RUN FLAG

INC AL

MOV BYTE PTR NLONLY,AL ;NLONLY=1, don't close file 0

PUBLIC OKGET2

OKGET2:

CALL INDSKC ;READ FROM [PTRFIL] FILE

JAE SHORT ??L011

JMP MAIN ;GO BACK IF EOF

??L011:

INC AL ;IS IT A BINARY FILE??

JNZ SHORT ??L012

JMP DERBFM ;BINARY IS WRONG FILE MODE

??L012:

INC AL ;OR PROTECTED BINARY FILE??

JNZ SHORT ??L013

JMP DERBFM ;ALSO GIVE BAD FILE MODE

??L013:

DEC AL ;adjust [A] for 1st INR A above

;so we can put it back (backup input file)

MAINGO:

DEC AL ;[A]=character which was just read from file

CALL BAKCHR ;backup file PTRFIL

EXTRN SCDASC:NEAR

CALL SCDASC ;set File Code to ASCII overridding user setting)

JMP MAIN

SUBTTL DISPATCH FOR DIRECT STATEMENT

;

; MAKE SURE WE'RE NOT READING A FILE IN

;

SUBTTL SAVE COMMAND -- ASCII OR BINARY

SAVE:

PUSH BX ;save text pointer for rescan of filename

CALL FRMEVL ;skip filename

PUSH BX

CALL FRESTR ;release string temporary

POP BX

DEC BX

CALL CHRGTR

JNZ SHORT ??L014

JMP ENDOFS ;branch if end-of-statement

??L014:

CALL SYNCHR

DB OFFSET 54O ;eat comma

CMP AL,LOW "A"

JNZ SHORT ??L015

JMP GOODSV ;branch if got "A"

??L015:

CMP AL,LOW "P"

JZ SHORT ??L016

JMP SNERR ;branch if not "A" or "P"

??L016:

GOODSV: PUSH BX ;save text pointer

PUSH AX ;save "A" or "P"

CALL CHRGTR ;check for end-of-statement

JZ SHORT ??L017

JMP SNERR ;error if not end-of-statement

??L017:

POP AX

POP BX ;leave text pointer pointing at "A" or "P"

ENDOFS: POP SI ;XTHL

XCHG SI,BX

PUSH SI ;save End-Of-Statement text pointer

;HL = text pointer to filename

PUSH AX ;save "A", "P" or null option

MOV DH,LOW OFFSET MD_SQO ;ELIMINATE EARLIER VERSION OF FILE

;AND CREATE EMPTY FILE

CALL PRGFL2 ;parse file name and open it

POP AX ;[A]="A", "P" or null option

POP BX ;restore End-Of-Statement text pointer

EXTRN PROSAV:NEAR

CMP AL,LOW "P" ;PROTECTED SAVE?

JNZ SHORT ??L018

JMP PROSAV ;DO IT

??L018:

CMP AL,LOW "A" ;Ascii save?

JZ SHORT ??L019

JMP BINSAV ;if not, must be Binary Save

??L019:

CALL CHRGTR ;skip "A"

CALL SCDASC ;set File Code to ASCII (overridding user setting)

JMP LIST ;USE THE LIST CODE TO DO THE OUTPUT

;CONTROL-CS ARE NOT ALLOWED

;AND AT THE END PTRFIL IS ZEROED

EXTRN BINSAV:NEAR

SUBTTL DRIVER CODE FOR CLOSE

SUBTTL "FIELD" STATEMENT FOR SETTING UP I/O STRINGS

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN TEMPA:WORD,TEMPB:WORD

DSEG ENDS

FIELD:

CALL FILSCN ;GET DATA BLOCK POINTER IN [B,C]

EXTRN DERFNO:NEAR

JNZ SHORT ??L020

JMP DERFNO ;error if File Not Opened

??L020:

SUB AL,LOW OFFSET MD_RND ;MAKE SURE ITS A RANDOM FILE

JZ SHORT ??L021

JMP DERBFM ;IF NOT, "BAD FILE MODE"

??L021:

XCHG BX,DX ;SAVE TEXT POINTER

MOV BX,OFFSET FD_SIZ ;POINT TO RECORD SIZE

ADD BX,CX

MOV BX,[BX] ;GET IT

MOV TEMPA,BX ;STORE MAX ALLOWED

MOV BX,0 ;ZERO MAX # OF CHARS

MOV TEMPB,BX

MOV AL,BH ;MAKE [A]=0

XCHG BX,DX ;GET BACK TEXT POINTER

MOV DX,OFFSET FD_DAT ;POINT TO 5.0 FIELD BUFFER

LOPFLD: XCHG BX,DX ;SAVE TEXT POINTER IN [D,E]

ADD BX,CX ;ADD ON DATA POINTER SO [H,L] NOW POINTS

;AT THE START OF THE DATA

MOV CH,AL ;SETUP COUNT OF CHARACTERS PAST BY

;IN DATA AREA, SO TOTAL IS NEVER GREATER THAN 128

XCHG BX,DX ;TEXT POINTER BACK INTO [H,L]

;[D,E]=POINTER INTO DATA AREA

MOV AL,BYTE PTR [BX] ;MORE "AS"S TO SCAN?

CMP AL,LOW 44 ;COMMA STARTS THE CLAUSE

JZ SHORT $ 3

RET ;BACK TO NEWSTT IF NOT

PUSH DX ;SAVE THE POINTER INTO THE DATA BLOCK

PUSH CX ;SAVE [B]=NUMBER OF CHARACTERS ALLOCATED

CALL GTBYTC ;READ NUMBER INTO [A] FROM TEXT

PUSH AX ;SAVE THIS NUMBER

CALL SYNCHR

DB OFFSET "A" ;SCAN THE "AS"

CALL SYNCHR

DB OFFSET "S"

CALL PTRGET ;GET A POINTER AT THE STRING DESCRIPTOR

CALL FRCSTR ;INTO [D,E]

POP AX ;GET THE NUMBER OF CHARACTERS

POP CX ;GET THE NUMBER ALREADY USED

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;SAVE THE TEXT POINTER AND

;[H,L]=POINTER INTO DATA BLOCK

MOV CL,AL ;SAVE # OF CHARACTERS IN [C]

PUSH DX ;SAVE [D,E]

PUSH BX ;SAVE [H,L]

MOV BX,TEMPB ;GET TOTAL SO FAR

MOV CH,LOW 0 ;ACCUMULATE COUNT

ADD BX,CX ;Add in current field size

MOV TEMPB,BX ;SAVE TOTAL AGAIN

XCHG BX,DX ;TOTAL TO [D,E]

MOV BX,TEMPA ;GET MAX ALLOWED

CMP BX,DX ;IN RANGE?

JAE SHORT ??L022

JMP DERFOV ;NO, GIVE ERROR

??L022:

POP BX ;RESTORE [H,L]

POP DX ;RESTORE [D,E]

XCHG BX,DX ;[H,L] POINT AT STRING DESCRIPTOR

MOV BYTE PTR [BX],CL ;STORE THE LENGTH

INC BX

MOV [BX],DX ;STORE THE POINTER INTO THE DATA BLOCK

POP BX ;GET BACK THE TEXT POINTER

JMP SHORT LOPFLD ;CONTINUE SCANNING "AS" CLAUSES IF MORE

SUBTTL Random Non-I/O -- LSET/RSET/FIELD

;LSET/RSET stringvar = stringexp

;

; If stringvar points to an I/O buffer, use the string size to

;justify string. If stringvar is a literal, make new var with length

;of literal. If stringvar points to string space, use it. If the

;length of the variable is zero, return the null string. If a copy

;must be created, and stringexp is a temporary, use this space over

;unless length stringvar greater than stringexp.

RSET: OR AL,LOW 0 ;clear carry

JMP SHORT LSETA

LSET: STC ;Set carry if lset

LSETA:

PUSHF ;Save LSET/RSET flag

CALL PTRGET ;Get pointer to stringvar

CALL FRCSTR ;Must be a string variable

PUSH DX ;Save pointer to descriptor

CALL FRMEQL ;EAT "=" AND EVALUATE STRINGEXP

POP CX ; [B,C] = ptr to descr.

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;Text ptr on bottom of stack

PUSH BX ;LSET/RSET flag next

PUSH CX ;Put descr. ptr back on

CALL FRESTR ;Error if not string, free temp.

MOV CH,BYTE PTR [BX] ;Get length of stringexp

POP SI ;XTHL

XCHG SI,BX

PUSH SI ; [H,L] = descr. of var,save othr

MOV AL,BYTE PTR [BX] ;Get length of stringvar

MOV CL,AL ;Save in [C]

PUSH CX ;Save lengths of both

PUSH BX ;Save descriptor pointer

PUSHF ;PSW zero if was temp.

INC BX

MOV DX,[BX] ;get point to stringvar text

OR AL,AL ;stringvar null?

JZ SHORT RETCUR ;Yes, don't change

MOV BX,TXTTAB

CMP BX,DX ;Stringvar in disk buffer?

JAE SHORT OLDSTR ;Yes, use it

MOV BX,VARTAB

CMP BX,DX ;stringvar in program(literal)?

JB SHORT OLDSTR ;No, in string space so use it

;Need to make new string for result since stringvar points to a literal.

;If stringexp was a temporary, it has been freed. If the length of

;stringexp is greater than or equal to the length of stringvar, GETSPA

;can be called and no garbage collection can occur so temp. can be reused.

;If stringvar is greater, must get a temp. to point to stringexp if it

;was a temp. , then call GETSPA which in this case can garbage collect.

MOV DL,CL

MOV DH,LOW 0 ;# BYTES TO ALLOCATE FOR RESULT

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN STREND:WORD

DSEG ENDS

MOV BX,STREND

ADD BX,DX

XCHG BX,DX

MOV BX,FRETOP

CMP BX,DX ;will GETSPA garbage collect?

JB SHORT MAKDSC ;Yes, better have stringexp temp.

POPF ;get rid of temp indicator

MADESC: MOV AL,CL ;Get length of stringvar

CALL GETSPA ;Get space for result

POP BX ;Get stringvar descr.

POP CX ;Get lengths off stack

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;Get what we wanted, stringexp descr.

PUSH DX

PUSH CX

CALL FRESTR ;Free temp if any

POP CX

POP DX

POP SI ;XTHL

XCHG SI,BX

PUSH SI

PUSH CX ;Restore stack to previous state

PUSH BX

INC BX

PUSHF

MOV [BX],DX ;set pointer to stringvar copy

OLDSTR: POPF

POP BX ;Get stringvar descr.

INC BX

MOV DX,[BX] ;Get pointer to text area

POP CX ;Get lengths off stack

POP BX ;Get pointer to stringexp descr.

INC BX ;point to address part

MOV BX,[BX] ;Get ptr to stringexp text

MOV AL,CL ;Get length of field(stringvar)

CMP AL,CH

JAE SHORT FILDOK ;Jump if field large enough for result

MOV CH,AL ;Save # of bytes to copy

FILDOK: SUB AL,CH

MOV CL,AL ;[C] = # blanks to fill

POPF ;Get LSET/RSET flag

JNAE SHORT ??L023

CALL BLKFIL ;Fill leading if RSET

??L023:

INC CH ;In case zero

COPLOP: DEC CH ;Decr. # to copy

JZ SHORT LRSTDN ;Done when all copied

MOV AL,BYTE PTR [BX] ;Get byte from stringexp

MOV DI,DX

STOSB ;Copy to stringvar

INC BX

INC DX

JMP SHORT COPLOP

RETCUR: POP CX

POP CX

POP CX

POP CX

POP CX ;Get garb off stack

LRSTDN: JNB SHORT ??L024

CALL BLKFIL ;Fill trailing if LSET

??L024:

POP BX ;Restore text pointer

RET

BLKFIL: MOV AL,LOW " " ;Fill with spaces

INC CL ;In case zero

BLKFL1: DEC CL ;Decr. # to fill

JNZ SHORT $ 3

RET ;Return when done

MOV DI,DX

STOSB ;Store space

INC DX

JMP SHORT BLKFL1

; If stringexp was a temporary, create a new temporary to point to

; stringexp since old one was freed. This must be done since GETSPA

; will be called and garbage collection might occur. If stringexp is

; not a temporary, return.

MAKDSC: POPF ;Get temp flag

POP BX

POP CX

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;Dig down to stringexp descr.

XCHG BX,DX ;FRETMS wants [D,E]

JNZ SHORT MAKDS1 ;Not a temp, don't reallocate

PUSH CX

MOV AL,CH

CALL STRINI ;Make a temp point to stringexp

CALL PUTNEW ;Get a temp to point to it

POP CX

MAKDS1: POP SI ;XTHL

XCHG SI,BX

PUSH SI

PUSH CX

PUSH BX ;Restore stack to previous state

JMP MADESC

SUBTTL Program I/O -- Fixed Length INPUT

; Format:

; stringvar = INPUT$(#bytes[,[#] file#])

;If no file # is given, characters will be read from the user's

; terminal. No echoing will be done and no editing will be allowed

; (i.e. rubout,@,_,^U are just input as characters).

PUBLIC FIXINP

FIXINP: CALL CHRGTR

CALL SYNCHR

DB OFFSET "$" ;STRING FUNCTION

CALL SYNCHR

DB OFFSET "("

PUSH BX ;Preserve PTRFIL across INPUT$ so

MOV BX,PTRFIL ;cases like PRINT #2,INPUT$(3,#1)

MOV DX,0 ;will work properly.

MOV PTRFIL,DX ;(Clear PTRFIL in case no file number

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;is specified.)

CALL GETBYT ;Get # of bytes to read

PUSH DX ;Save # of bytes to read

MOV AL,BYTE PTR [BX]

CMP AL,LOW 54O ;Read from disk file?

JNZ SHORT REDTTY ;No, from user's terminal

CALL CHRGTR

CALL FILSCN ;Set up file #

EXTRN DERFNO:NEAR

JNZ SHORT ??L025

JMP DERFNO ;error if File Not Open

??L025:

CMP AL,LOW OFFSET MD_SQO ;SEQUENTIAL OUTPUT FILE?

JNZ SHORT ??L026

JMP DERBFM

??L026: ;THEN BAD FILE MODE

CALL FILSET ;SET UP PTRFIL

XOR AL,AL ;SET ZERO FOR FLAG

REDTTY: LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;NON ZERO SET IF TERMINAL I/O

CALL SYNCHR

DB OFFSET ")" ;Must have paren

POP AX ; POP PSW

XCHG AL,AH

SAHF ;Get flag off stack

POP SI ;XTHL

XCHG SI,BX

PUSH SI ;Save text ptr, [L]=# to read

LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;Save flag

MOV AL,BL

OR AL,AL ;Read no characters?

JNZ SHORT ??L027

JMP FCERR ;Yes, error

??L027:

PUSH BX ;Save #

CALL STRINI ;Get space for string

XCHG BX,DX

POP CX ;[C] = # to read

FIXLOP: POP AX ; POP PSW

XCHG AL,AH

SAHF

LAHF ; PUSH PSW

XCHG AL,AH

PUSH AX

XCHG AL,AH ;NON-ZERO set if should read from TTY

JZ SHORT DSKCHR ;Read from disk file

CALL INCHRI ;Read a char from terminal

CHARCW:

;Note : will check flag on interrupt ^c

PUTCHR: MOV BYTE PTR [BX],AL ;Put char into string

INC BX

DEC CL ;Read enough yet?

JNZ SHORT FIXLOP ;No, read more

DSEG SEGMENT PUBLIC 'DATASG'

EXTRN SAVKEY:WORD ;Second half of two-byte key

DSEG ENDS

XOR AL,AL

MOV BYTE PTR SAVKEY,AL ;Clear saved second byte

POP AX ; POP PSW

XCHG AL,AH

SAHF ;Get flag off stack

POP CX ;B:=text pointer.

POP BX ;Restore PTRFIL.

MOV PTRFIL,BX

PUSH CX ;Restack the text pointer.

JMP PUTNEW ;Return string as result

DSKCHR: CALL INDSKC ;Get char from file

JAE SHORT ??L028

JMP DERRPE ;If carry, read past EOF

??L028:

JMP SHORT PUTCHR ;Put char in string

CSEG ENDS

END