* 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, 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