home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
SIMTEL
/
CPMUG
/
CPMUG051.ARK
/
DISKIO2.SRC
< prev
next >
Wrap
Text File
|
1984-04-29
|
17KB
|
918 lines
DREV EQU 24H ; 06/13/79 R. CURTISS "," FOR DELIMITER ALSO
;DREV EQU 23H ; 06/10/79 R. CURTISS DCLOSE XRA A, NOT IF READ
;DREV EQU 22H ; 08/19/78 R. CURTISS DEF. DMA = 80 AFTER
; READS AND WRITES
;DREV EQU 21H ; 08/19/78 R. CURTISS GCLOSE ADDITIONS
;
;DREV EQU 20H ; 08/17/78 R. CURTISS INITIAL CODING
;
;DREV EQU 15H ; 07/26/78 R. CURTISS BWRITE - MVI A,0 JNZ
;
;DREV EQU 14H ; 07/25/78 R. CURTISS OPEN- NR=0
;
;DREV EQU 13H ; 07/25/78 R. CURTISS FIX ERROR IN READ
; AND OTHER CHANGES
;
;DREV EQU 12H ; 07/01/78 R. CURTISS FIX ERRORS
;
;DREV EQU 11H ; 07/01/78 R. CURTISS INITIAL CODING
;
; CP/M DISK I/O PACKAGE
; 1. INITIAL IMPLEMENTATION
; OPEN, CLOSE, READ BYTE, WRITE BYTE
;
; 2. NEXT STAGE OF DEVELOPMENT
; READ LINE, WRITE LINE, GENERAL CLOSE
;
; 3. ALLOW THE FOLLOWING FOR FILE NAMES:
; CON: - CONSOLE IN/OUT
; RDR: - READER IN
; PUN: - PUNCH OUT
; LST: - LISTING OUT
;
;
; TO OPEN DISK FILE
; ERROR IF FILE ALREADY OPEN
; ERROR IF BAD FILE NAME
; SELECT ( ACCESS )
; ( 1 = READ ) CONTINUE
; ( 3 = WRITE )
; ACCESS = 2
; DELETE FILE IF PRESENT
; CREATE FILE
; ERROR IF NO DIRECTORY SPACE
; FIN
; ( 2 = WRITE )
; ERROR IF FILE IS PRESENT
; CREATE FILE
; ERROR IF NO DIRECTORY SPACE
; FIN
; ( OTHER ) ERROR ILLEGAL ACCESS CODE
; FIN
; OPEN FILE
; ERROR IF NOT PRESENT
; STATUS = 0 NORMAL
; POINTER = 0 BUFFER EMPTY
; FIN
;
; INPUTS:
; (HL) POINTS TO FILE TABLE ORIGIN
; (DE) POINTS TO FILE NAME STRING
; (BC) POINTS TO ACCESS CODE
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
;
FCBOFF EQU 4 ; FCB OFFSET IN FILE TABLE
BUFF EQU 37 ; BUFFER OFFSET IN FILE TABLE
BDOS EQU 0005H ; ENTRY POINT TO OPERATING SYSTEM
DB DREV ; PUT REVISION NUMBER IN CODE
DOPEN: SHLD FTABLE ; SAVE FILE TABLE POINTER
MOV A,M ; GET ACCESS CODE FROM FILE TABLE
CPI 0
JNZ ERR ; JUMP IF FILE ALREADY OPEN
LDAX B ; GET OPEN ACCESS CODE
STA ACCESS
LHLD FTABLE ; RECALL FILE TABLE POINTER
LXI B,FCBOFF ; FCB OFFSET IN FILE TABLE
DAD B
CALL GETNAM ; GET FILE NAME
JNZ ERR ; JUMP IF NAME ERROR
LDA ACCESS
DCR A
JZ OPEN6 ; JUMP IF READ ACCESS DESIRED
CPI 2
JNZ OPEN2 ; JUMP IF NOT WRITE WITH DELETE
STA ACCESS ; ACCESS = 2
MVI C,19
CALL BDOS1 ; DELETE FILE IF PRESENT
JMP OPEN4
OPEN2: CPI 1
JNZ ERR ; JUMP IF INVALID ACCESS CODE
MVI C,17
CALL BDOS1 ; CHECK TO SEE IF FILE IS PRESENT
CPI 255
JNZ ERR ; JUMP IF FILE IS PRESENT
OPEN4: MVI C,22
CALL BDOS1 ; CREATE FILE
CPI 255
JZ ERR ; JUMP IF NO DIRECTORY SPACE
OPEN6: MVI C,15
CALL BDOS1 ; OPEN FILE
CPI 255
JZ ERR ; JUMP IF NOT PRESENT
LHLD FTABLE ; RECALL FILE TABLE POINTER
LXI D,FCBOFF+32
DAD D
MVI M,0 ; NEXT RECORD NUMBER IN FCB
CALL GCLADD ; ADD FILE TABLE TO OPEN LIST
LHLD FTABLE ; RECALL FILE TABLE POINTER
LDA ACCESS
MOV M,A ; SET ACCESS CODE IN FILE TABLE
INX H
XRA A
MOV M,A ; SET STATUS TO ZERO (NORMAL)
INX H
MOV M,A ; SET BUFFER POINTER TO ZERO
JMP RETURN
;
;
; TO CLOSE FILE
; OUTPUT LAST BUFFER IF OPEN FOR WRITE
; ERROR IF ACCESS < 1 OR > 2
; CLOSE FILE IF OPEN FOR WRITE
; ERROR IF NOT PRESENT
; ACCESS = 0
; BUFFER POINTER = 0
; FIN
;
; INPUT:
; (HL) POINTS TO FILE TABLE ORIGIN
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
DCLOSE: SHLD FTABLE ; SAVE FILE TABLE POINTER
MOV A,M ; GET ACCESS CODE FROM FILE TABLE
CPI 2
JNZ CLOSE1 ; JUMP IF NOT OPEN FOR WRITE
CALL CLOSE4 ; OUTPUT LAST BUFFER IF NOT EMPTY
JZ CLOSE2 ; JUMP IF NO WRITE ERROR
PUSH PSW ; SAVE ERROR CONDITION
CALL CLOSE2 ; CLOSE THE FILE
POP PSW
JMP ERR
CLOSE1: ORA A
JZ RETURN ; JUMP IF ALREADY CLOSED
CPI 1
JNZ ERR ; JUMP IF INVALID ACCESS CODE
CLOSE2: CALL GCLREM ; REMOVE FILE TABLE FROM OPEN LIST
LHLD FTABLE ; RECALL FILE TABLE POINTER
XRA A
MOV C,M ; GET ACCESS CODE
MOV M,A ; ACCESS = 0 - FILE NOT OPEN
INX H
MOV M,A ; STATUS = 0 - NORMAL
INX H
MOV M,A ; BUFFER POINTER = 0
DCR C
JZ RETURN ; JUMP IF OPEN FOR READ
MVI C,16
CALL BDOS1 ; CLOSE FILE
CPI 255
JZ ERR ; JUMP IF FILE NOT PRESENT
XRA A ; NO ERROR
JMP RETURN
CLOSE4: INX H
INX H
MOV A,M ; GET BUFFER POINTER
ANI 7FH ; MSB SHOULD BE 0 BUT BE SAFE
RZ ; RETURN IF BUFFER IS EMPTY (Z)=1
LXI D,BUFF+127-2 ; -2 FOR 2 (INX HL) ABOVE
DAD D ; (HL) POINTS TO LAST BUFFER BYTE
CMA
ADI 128+1 ; PAD COUNT = 128 - POINTER
CLOSE6: MVI M,1AH ; PAD BUFFER WITH CONTROL Z
DCX H
DCR A
JNZ CLOSE6
CALL WRITE2 ; OUTPUT LAST BUFFER
RET ; (Z)=1 IF WRITE IS OK
;
;
; TO CLOSE ALL OPEN FILES
; FOR EACH OPEN FILE
; CLOSE FILE
; FIN
; FIN
;
; INPUTS:
; NONE
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
GCLOSE: LDA LSIZE ; RECALL OPEN FILE COUNT
ORA A
RZ ; RETURN IF LIST IS EMPTY
LXI H,FLIST ; GET FIRST FILLE TABLE POINTER
MOV E,M
INX H
MOV D,M
XCHG
CALL DCLOSE ; CLOSE AND DELETE FILE FROM LIST
JMP GCLOSE
;
;
; ADD FILE TABLE TO OPEN FILE LIST
;
GCLADD: LDA LSIZE ; GET OPEN FILE COUNT
CPI LMAX ; FILE LIST MAX SIZE
JNC GCLA9 ; JUMP IF LIST IS FULL
INR A
STA LSIZE ; LSIZE = LSIZE + 1
DCR A
ADD A ; A = A*2
MOV E,A
MVI D,0
LXI H,FLIST
DAD D ; (HL) POINTS TO NEXT LIST ENTRY POS.
XCHG
LHLD FTABLE ; RECALL FILE TABLE POINTER
XCHG
MOV M,E
INX H
MOV M,D ; LIST(LSIZE) = FILE TABLE POINTER
RET
GCLA9: ; ****************** NEED EROR MESSAGE
RET
;
;
; REMOVE FILE TABLE POINTER FROM OPEN FILE LIST
;
GCLREM: LHLD FTABLE ; RECALL FILE TABLE POINTER
XCHG
LXI H,FLIST ; ORIGIN OF OPEN FILE LIST
LDA LSIZE ; RECALL OPEN FILE COUNT
MOV C,A
INR C
GCLR1: DCR C
JZ GCLR9 ; JUMP IF END OF OPEN FILE LIST
MOV A,M
INX H
XRA E
MOV B,A
MOV A,M
INX H
XRA D
ORA B
JNZ GCLR1 ; JUMP IF NO MATCH
MOV D,H
MOV E,L
DCX D
DCX D
GCLR2: DCR C
JZ GCLR8 ; JUMP IF END OF LIST
MOV A,M
STAX D
INX H
INX D
MOV A,M
STAX D ; LIST(M-1) = LIST(M)
INX H
INX D ; M = M + 1
JMP GCLR2
GCLR8: LDA LSIZE
DCR A
STA LSIZE
RET
GCLR9: ; ****************** NEED ERROR MESSAGE
RET
;
;
; TO READ A LINE
; ERROR IF ACCESS <> "READ"
; ERROR IF STATUS <> "NORMAL"
; I = 1
; GET-NEXT-BYTE
; UNTIL ( EOL,EOF,ERR )
; IF ( I <= MAX-CHARACTER-COUNT )
; LINE(I) = BYTE
; I = I + 1
; FIN
; GET-NEXT-BYTE
; FIN
; RETURN-ACTUAL-CHARACTER-COUNT
; FIN
;
; INPUTS:
; (HL) POINTS TO FILE TABLE
; (DE) POINTS TO LINE BUFFER ORIGIN
; (BC) POINTS TO PARAMETER LIST
; 3RD POINTS TO MAX CHARACTER COUNT (255 MAX)
; 4TH POINTS TO ACTUAL CHARACTER COUNT (255 MAX)
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
LREAD: SHLD FTABLE ; SAVE FILE TABLE POINTER
XCHG
SHLD LPOINT ; SAVE LINE POINTER
LXI H,DBYTE
SHLD DATA ; DATA RETURN POINTER
MOV H,B
MOV L,C
MOV E,M
INX H
MOV D,M ; (DE) POINTS TO 3RD ARG
XCHG
MOV C,M ; (C) HOLDS MAX LINE LENGTH
MOV A,C
STA CMAX ; SAVE MAX LINE LENGTH
XCHG
INX H
MOV E,M
INX H
MOV D,M ; (DE) POINTS TO 4TH ARG
XCHG
SHLD ACTP ; SAVE POINTER FOR ACTUAL LENGTH
LHLD FTABLE ; RECALL FILE TABLE POINTER
MOV A,M ; GET ACCESS CODE
CPI 1
JNZ ERR ; JUMP IF NOT OPEN FOR READ
INX H
MOV A,M ; GET STATUS CODE
ORA A
JNZ ERR ; JUMP IF NOT NORMAL
INX H ; (HL) POINTS TO BUFFER POINTER
SHLD BPOINT ; SAVE IT
LREAD1: CALL LREAD5 ; GET NEXT BYTE FROM DISK
JNZ LREAD2 ; JUMP IF EOL,EOF,ERR
CALL LREAD8 ; STORE BYTE INTO LINE
JMP LREAD1
LREAD2: PUSH PSW ; SAVE READ STATUS
LDA CMAX ; RECALL MAX CHARACTER COUNT
SUB C
LHLD ACTP
MOV M,A ; RETURN ACTUAL CHARACTER COUNT
POP PSW
CPI 0DH ; CARRIAGE RETURN
JNZ RETURN ; RETURN IF EOF OR ERR
XRA A
JMP RETURN ; NORMAL RETURN
;
; GET NEXT BYTE
;
LREAD5: LHLD BPOINT ; RECALL BUFFER POINTER POINTER
PUSH B ; SAVE LINE SPACE COUNT
CALL BRXXX ; GET NEXT BYTE FROM DISK
POP B
RNZ ; RETURN IF EOF,ERR
LDA DBYTE ; GET BYTE JUST READ
ANI 7FH
JZ LREAD5 ; IGNORE NULL
CPI 0AH
JZ LREAD5 ; IGNORE LINE FEED
CPI 7FH
JZ LREAD5 ; IGNORE RUBBOUT
CPI 1AH ; CONTROL Z
JZ LREAD6 ; JUMP IF END OF FILE
CPI 0DH
JZ LREAD7 ; JUMP IF CARRIAGE RETURN
CMP A ; (Z)=1
RET ; NORMAL RETURN
LREAD6: MVI A,255 ; END OF FILE
LREAD7: ORA A ; END OF LINE
RET
;
; STORE NEXT BYTE IN LINE
;
LREAD8: INR C
DCR C
RZ ; RETURN IF LINE BUFFER FULL
LHLD LPOINT ; RECALL LINE BUFFER POINTER
MOV M,A
INX H
SHLD LPOINT
DCR C
RET
;
;
; TO READ BYTE
; ERROR IF ACCESS <> "READ"
; ERROR IF STATUS <> "ZERO"
; IF ( BUFFER EMPTY )
; GET NEXT BUFFER LOAD
; POINT = 0
; RETURN IF "EOF"
; FIN
; GET NEXT BYTE FROM BUFFER
; POINT = POINT + 1
; FIN
;
; INPUTS:
; (HL) POINTS TO FILE TABLE ORIGIN
; (DE) POINTS TO DATA BYTE STORAGE
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
; ((DE)) = DATA BYTE RETURNED
;
BREAD: SHLD FTABLE ; SAVE FILE TABLE POINTER
XCHG
SHLD DATA ; SAVE DATABYTE POINTER
MVI M,1AH ; TENTATIVELY RETURN CONTROL Z
XCHG
MOV A,M ; GET ACCESS CODE
CPI 1
JNZ ERR ; JUMP IF NOT READ ACCESS
INX H
MOV A,M ; GET STATUS CODE
CPI 0
JNZ ERR ; JUMP IF NOT NORMAL
INX H
BRXXX: MOV A,M ; GET BUFFER POINTER
MOV E,A ; SAVE CURRENT POINTER
INR A
ANI 7FH
MOV M,A ; POINTER = (POINTER + 1) MOD 128
MOV A,E ; GET CURRENT POINTER
ORA A
JNZ READ2 ; JUMP IF BUFFER NOT EMPTY
CALL READ4 ; GET NEXT BUFFER LOAD
JNZ ERR ; JUMP IF READ ERROR
ORA A
JNZ RETURN ; JUMP IF END OF FILE
MVI E,0 ; CURRENT POINTER
READ2: LHLD FTABLE ; RECALL FILE TABLE POINTER
MVI D,0 ; (E) IS BUFFER POINTER
DAD D
LXI D,BUFF ; BUFFER OFFSET IN FILE TABLE
DAD D ; (HL) POINTS TO NEXT BYTE IN BUFFER
MOV A,M ; GET NEXT DATA BYTE
LHLD DATA ; RECALL DATA RETURN POINTER
MOV M,A ; RETURN DATA BYTE TO CALLER
XRA A ; (A)=0 (Z)=1
JMP RETURN ; NORMAL RETURN
READ4: MVI C,26
CALL BDOS2 ; SET DMA ADDRESS
MVI C,20
CALL BDOS1 ; READ NEXT DISK RECORD
PUSH PSW
MVI C,26
LXI D,80H
CALL BDOS ; RESTORE DMA ADDR TO DEFAULT
POP PSW
ORA A
RZ ; RETURN IF OK (Z)=1
CPI 1 ; EOF
RNZ ; RETURN IF ERROR (A)>1 (Z)=0
LHLD FTABLE ; RECALL FILE TABLE POINTER
INX H
MVI A,255
MOV M,A ; SET STATUS TO "EOF"
CPI 255 ; EOF (A)=255 (Z)=1
RET ; END OF FILE DETECTED
;
;
; TO WRITE A LINE
; ERROR IF ACCESS <> "WRITE"
; ERROR IF STATUS <> "ZERO" "NORMAL"
; FOR I = 1 TO LENGTH OF LINE
; WRITE BYTE LINE(I)
; FIN
; FIN
;
; INPUTS:
; (HL) POINTS TO FILE TABLE
; (DE) POINTS TO LINE BUFFER ORIGIN
; (BC) POINTS TO LINE LENGTH IN BYTES (255 MAX)
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
LWRITE: SHLD FTABLE ; SAVE FILE TABLE POINTER
MOV A,M ; GET ACCESS CODE
CPI 2
JNZ ERR ; JUMP IF NOT OPEN FOR WRITE
INX H
MOV A,M ; GET STATUS CODE
ORA A
JNZ ERR ; JUMP IF NOT NORMAL
INX H ; POINTS TO BUFFER POINTER
LDAX B ; CHARACTER COUNT
MOV C,A
INR C
LWRIT1: DCR C
JZ LWRIT2 ; JUMP IF END OF LINE
PUSH H
PUSH D
PUSH B
LDAX D ; GET NEXT DATA BYTE
MOV B,A
CALL BWXXX ; WRITE BYTE TO DISK
POP B
POP D
POP H
RNZ ; RETURN IF WRITE ERROR
INX D
JMP LWRIT1
LWRIT2: MVI B,0DH
PUSH H
CALL BWXXX ; WRITE CARRIAGE RETURN TO DISK
POP H
RNZ ; RETURN IF WRITE ERROR
MVI B,0AH
CALL BWXXX ; WRITE LINE FEED TO DISK
RET
;
;
; TO WRITE BYTE
; ERROR IF ACCESS <> "WRITE"
; ERROR IF STATUS <> "ZERO"
; PUT BYTE INTO BUFFER
; POINT = POINT + 1
; IF ( BUFFER FULL )
; WRITE NEXT BUFFER LOAD
; POINT = 0
; FIN
; FIN
;
; INPUTS:
; (HL) POINTS TO FILE TABLE ORIGIN
; (DE) POINTS TO DATA BYTE STORAGE
;
; OUTPUTS:
; (A)=(HL)= OPERATION STATUS
; (Z) = CONDITION OF (A)
;
BWRITE: SHLD FTABLE ; SAVE FILE TABLE POINTER
LDAX D ; GET DATA BYTE
MOV B,A ; SAVE IN B
MOV A,M ; GET ACCESS CODE
CPI 2
JNZ ERR ; JUMP IF NOT WRITE ACCESS
INX H
MOV A,M ; GET STATUS CODE
CPI 0
JNZ ERR ; JUMP IF NOT NORMAL
INX H
;
; (HL) POINTS TO BUFFER POINTER
; (B) DATA BYTE FOR OUTPUT
;
BWXXX: MOV A,M ; GET BUFFER POINTER
MOV E,A ; SAVE CURRENT POINTER
INR A
ANI 7FH
MOV M,A ; POINTER = (POINTER+1) MOD 128
MVI D,0
DAD D
LXI D,BUFF-2 ; -2 FOR 2 (INX HL) ABOVE
DAD D ; (HL) = FTABLE+BUFF+POINT
MOV M,B ; STORE DATA BYTE INTO BUFFER
CPI 0
MVI A,0 ; NO ERROR
JNZ RETURN ; JUMP IF BUFFER NOT FULL
CALL WRITE2 ; WRITE BUFFER TO DISK
JNZ ERR ; JUMP IF WRITE ERROR
JMP RETURN
WRITE2: MVI C,26
CALL BDOS2 ; SET DMA ADDRESS
MVI C,21
CALL BDOS1 ; WRITE NEXT DISK RECORD
PUSH PSW
MVI C,26
LXI D,80H
CALL BDOS ; RESTORE DMA ADDR. TO DEFAULT
POP PSW
ORA A
RZ ; RETURN IF WRITE OK (A)=0 (Z)=1
CPI 2 ; END OF DISK
RNZ ; RETURN IF ERROR (A)=1,>2 (Z)=0
LHLD FTABLE ; RECALL FILE TABLE POINTER
INX H
MVI A,255 ; END OF MEDIUM
MOV M,A ; SET STATUS
CPI 255 ; SET ZERO FLAG FOR NO ERROR
RET ; (A)=255 (Z)=1
;
;
; SCAN FILE NAME
; INPUTS:
; (HL) POINTS TO FCB
; (DE) POINTS TO FILE NAME - LEADING SPACES OK
;
; OUTPUTS:
; (A) = COUNT OF "?" IN NAME
; (Z) = CONDITION OF (A)
; (DE)= POINTER TO END OF NAME DELIMITER
;
GETNAM: ; GET FILE REFERENCE
PUSH H
CALL LL35 ; IGNOR LEADING BLANKS
ORA A ; NULL INDICATES END OF BUFFER
JZ LLA6A ; JUMP IF NULL
SBI '@' ; CHECK IF DRIVE SPECIFIED
MOV B,A
INX D
LDAX D
CPI ':'
JZ LL76
DCX D
MVI M,0 ; ZERO FOR CURRENT DRIVE
JMP LL7C
LL76:
MOV M,B ; SPECIFIED DRIVE
INX D
LL7C: ; GET FILENAME
MVI B,8
CALL LL7E ; SCAN FILE NAME
MVI B,3
CPI '.' ; FILE TYPE DELIMITER
JNZ LLCF ; JUMP IF NO FILE TYPE
INX D
CALL LL7E ; SCAN FILE TYPE
JMP LLD6
LLCF: ; FILL REST OF FILE TYPE WITH SPACES
INX H
MVI M,' '
DCR B
JNZ LLCF
LLD6: ; PUT THREE ZEROS IN FILE CONTROL BLOCK
MVI B,3
LLD8:
INX H
MVI M,0
DCR B
JNZ LLD8
POP H
LXI B,000BH
LLE7: ; CHECK FOR AMBIGUOUS FILE REFERENCE
INX H
MOV A,M
CPI '?'
JNZ LLEF
INR B
LLEF:
DCR C
JNZ LLE7
MOV A,B
ORA A ; (A) IS COUNT OF '?' IN NAME
RET ; (Z)=1 IF UNAMBIGUOUS NAME
;
;
; ---------------------
;
; (B)= MAX CHARACTER COUNT
;
LL7E: ; SCAN FNAME OR FTYPE
CALL LL16
JZ LL9F ; JUMP IF DELIMITER FOUND
INX H
CPI '*' ; IF '*', FILL REST OF FILENAME WITH '?'
JNZ LL8F
MVI M,'?'
JMP LL91
LL8F:
MOV M,A ; STORE IN FCB
INX D
LL91:
DCR B ; CHARACTER COUNT
JNZ LL7E
LL95: ; IGNORE EXTRA CHARACTERS
CALL LL16
JZ LLA6
INX D
JMP LL95
LL9F: ; FILL REST OF FILENAME WITH SPACES
INX H
MVI M,' '
DCR B
JNZ LL9F
LLA6:
RET
;
; ----------------------
;
LLA6A:
POP H
ORI 255 ; NO FILE NAME FOUND
RET ; (Z)=0
;
; --------------------------
;
LL16: ; CHECK FOR DELIMITERS
LDAX D
ORA A ; NULL
RZ
CPI ' ' ; SPACE
JNC LL16A ; JUMP IF NOT CONTROL CHARACTER
MVI A,'?' ; REPLACE CONTROL CHAR
RET ; (Z)=0
LL16A:
RZ
CPI '='
RZ
CPI 5FH ; BACK ARROW
RZ
CPI '.'
RZ
CPI ','
RZ
CPI ':'
RZ
CPI ';'
RZ
CPI '<'
RZ
CPI '>'
RET
;
; ----------------
;
LL35: ; ADVANCE TO FIRST NON-BLANK OR END
LDAX D
ORA A
RZ
CPI ' '
RNZ
INX D
JMP LL35
;
;
;
; BDOS FUNCTIONS USING FILE CONTROL BLOCK POINTER
;
BDOS1: LHLD FTABLE ; RECALL FILE TABLE POINTER
LXI D,FCBOFF
DAD D
XCHG ; (DE) POINTS TO FILE CONTROL BLOCK
CALL BDOS
RET
;
;
; BDOS FUNCTIONS USING BUFFER POINTER
;
BDOS2: LHLD FTABLE ; RECALL FILE TABLE POINTER
LXI D,BUFF ; BUFFER OFFSET
DAD D
XCHG ; (DE) POINTS TO BUFFER ORIGIN
CALL BDOS
RET
;
;
; ALL ERROR CONDITIONS EXIT HERE
;
ERR: LHLD FTABLE ; RECALL FILE TABLE POINTER
; .... ..... ADD ERROR MESSAGE SOMETIME
INX H
MVI A,255
MOV M,A ; SET STATUS TO EOF
DCR A ; (A) = 254 (UNSPECIFIED ERROR)
;
;
RETURN: MVI H,0
MOV L,A ; FORTRAN INTEGER FUNCTION RESULT
ORA A ; DETERMINE ZERO FLAG
RET
;
;
; LOCAL TEMPORARY STORAGE
;
FTABLE: DS 2 ; FILE TABLE POINTER
ACCESS: DS 1 ; ACCESS CODE
DATA: DS 2 ; DATA BYTE POINTER
;
;
; STORAGE FOR OPEN FILE LIST
;
LSIZE: DB 0 ; COUNT OF FLIST SIZE
LMAX EQU 10 ; MAX SIZE OF OPEN FILE TABLE
FLIST: DS LMAX*2 ; LIST OF FILE TABLE POINTERS
;
;
; STORAGE FOR LREAD
;
LPOINT: DS 2
BPOINT: DS 2
ACTP: DS 2
DBYTE: DS 1
CMAX: DS 1
;
;