*   
 ORG 0C800H
 XEQ RUN
*   
 COPY NPTDEFS
*   
OREAD EQU 0  COMMAND CODES AND BUFFER STATUS CODES
OWRITE EQU 1
RBYT EQU 3
WBYT EQU 4
CLOSE EQU 5
EOF EQU -1
EOL EQU 2
LBUFF EQU 3
*   
*   
PTP2 JMP REDBYT  READ ONE BYTE FROM FILE
 JMP WRTBYT  WRITE ONE BYTE TO FILE
 JMP FCLOS  CLOSE A FILE
*   
* (RE)OPEN A FILE FOR READ OR WRITE
*   
 STA CMND  SAVE COMMAND
 PUSH H
 CALL GETFCB
*   
 INR L  TEST FOR NEW FILE
 POP D
 JNZ OFILE
*   
 LHLD NXTFCB  GET ADDRESS OF NEXT FCB
 SHLD CURFCB
 XCHG
 MOV M,E
*   
 LXI H,FCBLNTH  POINT TO NEXT FCB ADDR
 DAD D
 SHLD NXTFCB
*   
 LHLD NXTBUF  GET NEXT BUFFER ADDRESS
 SHLD SFCB
 LXI D,BUFLNTH
 DAD D
 SHLD NXTBUF
*   
 LDA LASTCHAR
 CPI 0DH
 JZ DEFAULT
 CPI ';'
 JZ DEFAULT
*   
 LDA CMND
 CPI OWRITE
 MVI A,PSCO
 JZ PTP1
 MVI A,PSOP
PTP1 LXI D,PSBUF  OPEN FILE, GET NAME FROM CI
 CALL PSCAN
 CC PERR
 STA LASTCHAR
 JZ DEFAULT
*   
PT0 MOV A,E  GET FILE NUMBER
 CPI -1
 CZ PERR
 STA SPFNUM
*   
PTP20 LDA CMND  SET OPEN MODE OF FCB
 STA SOPMOD
 SUB A  SET CHAR POINTER AND CHAR COUNT TO ZERO
 LXI H,SCCNT
 MOV M,A
 INX H
 MOV M,A
 INX H
 MOV M,A
 JMP PUTFCB
*   
DEFAULT MVI E,0
 LDA CMND
 CPI OREAD
 JZ PT0
 INR E
 JMP PT0
*   
OFILE LDA SOPMOD  REWIND FILE FOR RESET & REWRITE
 CPI OWRITE
 CZ FLUSH
 CALL REWIND
 JMP PTP20
*   
FCLOS CALL GETFCB  CLOSE A FILE
 LDA SOPMOD  MUST BE LAST CALL CONCERNING THIS FILE
 CPI OWRITE
 CZ FLUSH
 LDA SPFNUM
 CALL SYS
 DB CLOOP
 CALL ERROR
 MVI A,CLOSE  SET OPEN MODE OF FCB TO CLOSED
 STA SOPMOD
 JMP PUTFCB
*   
REDBYT CALL GETFCB
 LDA SBUFST
 CPI EOF
 RZ .
 LDA SPFNUM
 ORA A
 JNZ RDBT0
 CALL CONIN
 CPI 'C'-40H  EOF FROM KEYBORAD
 RNZ .
RDBT3 MVI A,EOF  IF NO CHARACTERS
 STA SBUFST
 JMP PUTFCB
*   
RDBT0 LXI H,SCCNT
 MOV A,M
 INX H
 CMP M  COMPARE SCPNTR
 JZ RDBT2
RDBT1 MOV A,M
 INR M
 CALL GBADDR
 MOV A,M
 JMP PUTFCB
*   
RDBT2 LDA SPFNUM  READ NEW BUFFER
 LXI B,BUFLNTH
 LHLD SFCB  ADDRESS TO READ DATA
 XCHG
 CALL SYS  GET A NEW BUFFER
 DB RBLOP
 CALL REDB1
 LXI H,SCPNTR  UPDATE CHARACTER POINTER
 MVI M,0
 MVI A,BUFLNTH  CALCULATE # BYTES READ
 SUB C
 DCX H
 MOV M,A
 INX H
 JNZ RDBT1
 JMP RDBT3
*   
WRTBYT PUSH PSW
 CALL GETFCB
 LDA SPFNUM
 DCR A
 JNZ WRTB0
 POP PSW
 CALL CONOUT
 RET
*   
WRTB0 LXI H,SCPNTR  CHECK FOR FULL BUFFER
 MOV A,M
 CPI BUFLNTH
 JZ WRTB2  IF BUFFER FULL
WRTB1 INR M
 CALL GBADDR
 POP PSW
 MOV M,A
 JMP PUTFCB
*   
WRTB2 LDA SPFNUM  GET PTDOS FILE #
 LXI B,BUFLNTH  THIS MANY BYTES
 LHLD SFCB  FROM HERE
 XCHG
 CALL SYS
 DB WBLOP
 CALL ERROR
*   
 LXI H,SCPNTR  RESET CHAR POINTER
 SUB A
 MOV M,A
 JMP WRTB1
*   
REDB1 CPI EREOF
 RZ 
ERROR POP H
 CALL SYS
 DB ABTOP
*   
GBADDR LHLD SFCB  GET ADDRESS OF CHAR IN BUFFER
 ADD L  ACC HAS OFFSET
 MOV L,A
 MVI A,0
 ADC H
 MOV H,A
 RET
*   
FLUSH LDA SCPNTR  FLUSH REMAINDER OF BUFFER (IF ANY)
 ORA A
 JZ FLSH0
 MOV C,A
 MVI B,0
 LHLD SFCB
 XCHG
 LDA SPFNUM
 CALL SYS  WRITE REMAINDER OF BUFFER
 DB WBLOP
 CALL ERROR
FLSH0 LDA SPFNUM  END FILE CURRENT FILE
 CALL SYS
 DB EOFOP
 CALL ERROR
 RET
*   
REWIND LDA SPFNUM
 MVI D,0
 CALL SYS  REWIND FILE TO BEGINING
 DB SPAOP
 CALL ERROR
 XRA A
 STA SCCNT  SET CHAR COUNT AND CHAR POINTER TO ZERO
 STA SCPNTR
 RET
*   
GETFCB MOV L,M  TRANSFER FCB TO STANDARD FCB
 MVI H,<FCBS
 SHLD CURFCB
 PUSH H
 LXI D,SFCB
 CALL MOVE
 POP H
 RET
*   
MOVE MVI C,FCBLNTH
MOVE1 MOV A,M
 STAX D
 INX H
 INX D
 DCR C
 JNZ MOVE1
 RET
*   
PUTFCB PUSH PSW  TRANSFER STANDARD FCB TO FCB
 LHLD CURFCB
 LXI D,SFCB
 XCHG
 CALL MOVE
 POP PSW
 RET
*   
PERR MOV A,E
 JMP ERROR
*   
FCBLNTH EQU 8
BUFLNTH EQU 120
*   
FCBS DS 4*FCBLNTH
*   
 DB 'P'+80H  FOR POSSIBLE CREATE
 DW 4C0H
 DB 0
*   
PSBUF DS 20  PARAMETER SCANNER BUFFER
*   
SFCB DW 0  ADDRESS OF BUFFER
SOPMOD DB 0  OPEN MODE OF FILE
SCCNT DB 0  CHARACTER COUNT
SCPNTR DB 0  POINTER TO CHAR
SBUFST DB 0  BUFFER STATUS
SPFNUM DB 0  PTDOS FILE #
SSPARE DB 0
*   
CURFCB DW 0
NXTFCB DW FCBS
NXTBUF DW BUFBASE
*   
CMND DB 0
CHAR DB 0
LASTCHAR DB 0
*   
BUFBASE EQU $
LOOKATTHIS EQU BUFLNTH*4+$
*   
HIINTERPRETER EQU 1  1 TO LOAD PCODE AT 0D000H, 0 --> 0100H
*   
 IF HIINTERPRETER
PCODEORG EQU 0D000H
INTERPRETER EQU 07A00H
INTSTART EQU 07A00H
 ENDF
*   
 IF HIINTERPRETER-1
PCODEORG EQU 00100H
INTERPRETER EQU 07A00H
INTSTART EQU 07A00H
 ENDF
*   
RUN LXI D,PSBUF  GET FIRST FILE NAME
 MVI A,PSOP  ..SHOULD BE PASCAL PROGRAM
 CALL PSCAN  ..TO RUN.
 JC ERR1
 JZ ERR1
 STA LASTCHAR
 MOV A,E
 CPI -1
 JZ ERR1
 STA FNUM
*   
 LXI D,PCODEORG+8  READ PASCAL PROGRAM TO HERE
 LXI B,-1
 CALL SYS
 DB RBLOP
 CALL RERROR
 LDA FNUM
 LXI B,8
 MVI D,128
 CALL SYS
 DB SPAOP
 CALL ERR1
 LXI D,PCODEORG
 CALL READFILE
*   
 LXI D,PSBUF  OPEN PASCAL INTERPRETER
 MVI A,PSOP+40H  GET FILE NAME FROM MEMORY
 LXI H,PINT  POINT TO NAME
 CALL PSCAN
 JC ERR1
 JZ ERR1
 MOV A,E
 CPI -1
 JZ ERR1
 STA FNUM
*   
 LXI D,INTERPRETER  LOAD INTERPRETER TO THIS ADDRESS
 CALL READFILE
*   
ALLDONE MVI A,'F'-040H
 CALL CONOUT
 MVI A,00DH
 CALL CONOUT
 CALL CONTST  CHECK FOR ABORT
 JZ INTSTART  STARTING ADDRESS FOR PASCAL INTERPRETER
 CALL CONIN
 ORA A
 JNZ INTSTART
 CALL SYS  IF ABORT
 DB RESOP
*   
READFILE LXI B,-1  65,535 BYTES SHOULD BE ENOUGH
 CALL SYS
 DB RBLOP
 CALL RERROR  CHECK IF EOF ERROR IF SO THEN OK
 LDA FNUM
 CALL SYS  CLOSE FILE AFTER READ
 DB CLOOP
 JMP ERR1
 RET
*   
RERROR CPI EREOF  CHECK IF ERROR FROM RBLOP
 RZ 
ERR1 CALL SYS
 DB ABTOP
*   
PINT ASC "PINT
 DB 0
*   
FNUM DB 0
*   
 END
