* * FILE STATEMENT * FILE #;,[,] * * SFILE CALL DIRT CALL OPEFCB GET USER'S FILE ID # LDA CUFID PUSH PSW CZ FLCLZ ALREADY OPEN, CLOSE IT (CLOBBERS CUFID) JC FDERR NO MORE ROOM, ABORT POP PSW STA CUFID * MVI B,';' SYNTAX CALL EATC * CALL GFNX GET FILE NAME EXPRESSION * LXI H,0 PUSH H THIS MEANS THERE IS NO ACC REC VAR (YET) SHLD CRZ SHLD CREC SHLD CSSD * MVI A,3 DEFAULT ACCESS STA CACRE SAVE TEMP * LXI H,DBLKS SET DEFAULT BLOCK SIZE SHLD CBLKS * XRA A STA CRT THERE IS NO TYPE REQUIREMENT (YET) STA CATTR NO ATTRIBUTES MVI A,BTSER STA CFT IF A FILE IS CREATED, MAKE IT SER TYP (SO FAR) * CALL SCOMA JC SFIX CALL GC CPI ',' JZ SFI6 * CALL PFIXE GET ACCESS REQUEST MOV A,D TOO BIG? ORA A JNZ OBERR YES MOV A,E STA CACRE * SFI6 CALL SCOMA JC SFIX CALL GC CPI ',' JZ SFI7 * CALL VAR PROCESS ACCESS RECEIVED RETURN VARIABLE JZ TYERR CAN'T BE A STRING XTHL . SAVE ON STACK * SFI7 CALL SCOMA JC SFIX CALL GC CPI ',' JZ SFI8 * CALL PFIXE GET RECORD SIZE MOV A,D ORA A JNZ SFI4 ORA E CPI 2+1 JC OBERR MUST BE > 2 SFI4 XCHG SHLD CREC INX H INX H IT'S ACTUALY 2 MORE THAN THEY SAY !!! (OVERHEAD BYTES) SHLD CRZ MVI A,BTRND THE FILE MUST BE TYPE - RANDOM STA CRT THE REQUIRED TYPE AND... STA CFT THE CREATE TYPE * SFI8 CALL SCOMA JC SFIX * CALL PFIXE XCHG MOV A,H ORA L JZ OBERR SHLD CBLKS LXI D,-0FFFH-1 DAD D JC OBERR * SFIX CALL FLOPEN OPEN FILE CALL CLOFCB THIS IS DONE SO IF AN ERROR OCCURES THE FILE WILL LDA CFT ......BE CLOSED CPI BTRND RANDOM? JNZ SFI5 * LHLD CRZ GET REQUESTED REC SIZE (LOG) IF RANFIX XCHG LHLD XA GET ACTUAL REC SIZE RETURNED BY FLOPEN MOV A,D ORA E JZ SFI41 ZERO MEANS DON'T CHECK, JUST SET IT CALL HDCMP Z=1 IFF EQU JNZ RCERR REC SIZE CONFLICT !!! SFI41 SHLD CRZ SET RECSIZE (LOG) DCX H DCX H LESS TWO FOR THAT WHICH IS AVAILABLE TO THE USER SHLD CREC CALL CLOFCB WE CHANGED CRZ SO IT MUST BE COPIED OUT AGAIN! ENDF IF 1-RANFIX MOV A,H ORA L JZ ACERR RANDOM ACCESS FILES MUST HAVE A RECORD SIZE ENDF * SFI5 POP H GET VAR ADDR (MAY BE ZERO IF NO VAR) MOV A,H ORA L RZ . RETURN IF NO ACC REC VAR PUSH H SAVE VAR ADDR LDA CACRE MOV L,A INTO HL MVI H,0 CALL FLOAT POP D VAR ADDR CALL POPA1 RET . RETURN * * * * CLOSE STASTEMENT * CLOSE #[,#]... * * SFCLOSE CALL DIRT XFCLOSE CALL OPEFCB GET CSFID JNZ FDERR FILE NOT DECLARED CALL FLCLZ CLOSE FILE CALL CLOFCB CLOSE FCB TO MAKE A HOLE IN THE TABLE CALL SCOMA SYNTAX RC . NO COMMA, DONE JMP XFCLOSE * * * * REWIND STATEMENT * REWIND #[,#]... * * SFREWIND CALL DIRT XFREWIND CALL OPEFCB OPEN FCB JNZ FDERR NOT DEFINED CALL FLREW REWIND FILE CALL CLOFCB CLOSE FCB CALL SCOMA SYNTAX RC . NO COMMA, DONE JMP XFREWIND * * * * FILE READ STATEMENT * READ #;[,]... * * SFREAD CALL DIRT CALL OPEFCB JNZ FDERR NOT DEFINED * CALL PRS PROCESS RANDOM/SERIAL SEEK/SPACE * MVI B,';' SYNTAX CALL EATC * SFR0 LXI D,IBUF CALL FLR1I READ 1 ITEM JZ SFR8 EOF, CLOSE FCB AND EXIT TO NEXT STATEMENT ON LINE JC SFRR EOR, CLOSE FCB AND EXIT TO NEXT LINE * CALL VAR WHERE DOES THE VALUE GO? PUSH H WHERE HL POINTS * LHLD TXA SAVE TXA AND POINT TO THE INPUT BUFFER XTHL PUSH H LXI H,IBUF SHLD TXA * JZ SFRST DISPATCH ON Z SET BY VAR (Z=1 FOR STRING) * CALL CONST NUMERIC, CONVERT POP D DE POINT TO THE VAR CNC POPA1 POP TO VAR IF NO TYPE ERROR * SFR1 POP H GET SAVED TXA SHLD TXA JC TYERR C SET BY 'CONST' ABOVE OR 'FSRST' BELOW CALL SCOMA SYNTAX JNC SFR0 MORE ITEMS * SFRR CALL CLOFCB NO COMMA, CLOSE FCB JMP REM RETURN AFTER SKIP * SFR8 CALL CLOFCB JMP DATA1 SKIP REST OF READ STATEMENT * SFRST MVI A,CR STRING ASSIGN TO A CR POP H POINTER TO VAR CALL STASS XRA A CLEAR CARRY JMP SFR1 * * * * FILE PRINT STATEMENT * PRINT #;[,]... * * SFPRINT CALL DIRT CALL OPEFCB OPEN THE FCB JNZ FDERR NO FCB, FILE NOT DECLARED * CALL PRS PROCESS RANDOM/SERIAL SEEK/SPACE * MVI B,';' SYNTAX CALL EATC * SFP0 CALL GC CPI '%' JZ SFP2 PROCESS NUMERIC FORAMT ELEMENT * CALL STEST STRING OR NUMERIC? JZ SFPST STRING * CALL EXPRB EVALUATE EXPRESSION CALL POPFP POP TO FPSINK LHLD TSTKA POINT TO RESULT CALL FPOUT CONVERT TO ASCII * MOV E,B B HAS COUNT FROM FPOUT MVI D,0 * SFP1 CALL FLW1I WRITE 1 ITEM CALL CLOFCB CLOSE FCB SFP3 CALL SCOMA SYNTAX JNC SFP0 A COMMA, NEXT ITEM RET . * * SFP2 CALL FORMAT JMP SFP3 * * ITEM IS A STRING EXPRESSION * SFPST LHLD TSTKA POP STRING PUSH H CALL SEXPG GET STRING EXPRESSION POP D XCHG . DE HAS COUNT, HL HAS BASE ADDR SHLD TSTKA * * POP STRING TO IBUF * PUSH D SAVE LENGTH PUSH H PLACE BASE ADDRESS AT TOS LXI H,IBUF PLACE TO PUT STRING XTHL . IBUF TO STACK, STR BASE TO HL LXI B,LINMAX-1 * SFP50 MOV A,D SOURCE EXAUSTED? ORA E JZ SFP51 END OF STRING * MOV A,B DEST EXAUSTED? ORA C JZ LLERR TOO LONG * MOV A,M DCX H DCX D XTHL . IBUF TO HL, STR TO STK MOV M,A INX H DCX B XTHL . STR TO HL, IBUF TO STK JMP SFP50 * SFP51 POP H GARBAGE LXI H,IBUF ADDR OF STRING POP D IT'S LENGTH JMP SFP1 WRITE IT * * * FILE KILL STATEMENT * PURGE [,] * SPURG CALL DIRT CALL GFNX GET NAME CALL FLKIL MVI D,0 MOV E,A ERROR TO E CALL SCOMA WON'T HURT DE! RC . NO RETURN VAR, EXIT PUSH D SAVE ERROR CALL VAR JZ TYERR NUMERIC IS A MUST XTHL . VAR ADDR TO STACK, ERROR CODE TO HL CALL FLOAT TURN HL INTO BCD ONTO STACK POP D GET VAR ADDR JMP POPA1 POP TO VAR AND RETURN * * * * OPEN FCB * THE USER'S FILE ID NUMBER IS GOTTEN FROM THE * PROGRAM TEXT. THE OPEN FILE TABLE (OFT) IS SEARCHED FOR * THE CORRISPONDING FCB. * IF FOUND: * THE ENTRY IS COPIED TO A STATIC * MEMORY AREA FOR EASY ADDRESSING. * IF NOT FOUND: * A NULL ENTRY IS PREPARED FOR 'SFILE' * ON RETURN: Z=1, C=0 FCB FOUND * Z=0, C=1 OFT IS FULL * Z=0, C=0 A NULL ENTRY WAS FOUND * Z=1, C=1 NOT USED * 'OFCB' POINTS TO THE OPENED ENTRY IN THE 'OFT' * * OPEFCB MVI B,'#' SYNTAX CALL EATC * XRA A STA RF CLEAR RANDOM AND SERIAL ACCESS FLAGS STA SF * CALL PFIXE GET USER'S FILE ID INTO DE OPEEOF MOV A,D ORA A TOO BIG? JNZ OBERR YES ORA E TOO SMALL? (NOTE: MOVE E TO A AND TEST) JZ OBERR TOO SMALL CPI 0FFH JZ OBERR TOO BIG * AHHHH JUST RIGHT * STA CUFID IN CASE OF NON-MATCH, PLACE UFID IN COFCB * LXI H,OFTE INIT OFCB TO OFTE TO SHOW NO NULL ENTRIES FOUND SHLD OFCB LXI H,OFT+OFTEZ ADDR OF 2ND ENTRY (FIRST IS USED BY FILE CMDS) LXI B,OFTEZ SIZE OF AN ENTRY * OPE0 MOV A,M TAKE A TRIP THRU THE TABLE CMP E JZ OPE3 MATCH FOUND CPI 0FFH EOT? JZ OPE2 END OF TABLE ORA A HOLE? JNZ OPE1 NO SHLD OFCB IN CASE A MATCH IS NOT FOUND, POINT TO A NULL ENT OPE1 DAD B POINT TO NEXT ENTRY JMP OPE0 * * NO MATCH * OPE2 LHLD OFCB WAS A HOLE FOUND? MOV A,M ORA A STC RNZ . TABLE FULL C=1, Z=0 DCR A MAKE Z=0 CMC RET . THERE IS A HOLE AND HERE IT IS! C=0, Z=0 * * MATCH FOUND * NOTE: ENTRY SIZE IS IN C * OPE3 SHLD OFCB SAVE POINTER TO MATCH LXI D,COFCB ADDR OF CURRENT FCB (STATIC BLOCK) JMP COPY FOUND MATCH C=0, Z=1 * * * CLOSE FCB * WRITE THE CURRENT FCB WHERE OFCB OPINTS * (I.E. UPDATE DYNAMIC TABLE FROM STATIC BLOCK) * CLOFCB LDA SF SET 'CEOF' TO REFLECT THE TYPE OF ACCESS LAST DID ORA A MVI C,0 JZ CLOF0 MVI C,16 CLOF0 LDA RF ORA A JZ CLOF1 MVI C,32 CLOF1 LDA CEOF ORA C STA CEOF * MVI C,OFTEZ C GETS ENTRY SIZE LHLD OFCB XCHG . DE GETS ENTRY IN TABLE ADDRESS LXI H,COFCB HL GETS ADDR OF CURRENT OPEN FCB JMP COPY CLOSE; COPY SETS Z! * * * * GET FILE NAME EXPRESSION * SETS CFN IN THE CURRENT OPEN FCB * SETS CSFID TO THE SPECIFIED SYSTEM LEVEL * FILE # (DEFAULT = 1 FOR CASSETT STUFF) * * GFNX LDA DIRF ORA A JNZ GFN3 KEYBOARD MODE * LHLD TSTKA GET FILE NAME STRING EXPRESSION PUSH H SAVE BASE ADDR OF STRING CALL SEXPG POP D XCHG SHLD TSTKA POP STRING OFF * MOV A,D TEST LENGTH ORA A JNZ FNERR TOO LONG FOR SURE ORA E JZ FNERR TOO SHORT * MVI D,FNSIZ+1 FOR LENGTH TEST LXI B,CFN POINTER TO FILE NAME IN CURRENT FCB * GFN0 MOV A,M DCX H DCR D LENGTH TEST JZ FNERR TOO LONG, SORRY STAX B INX B DCR E END OF STRING? JNZ GFN0 NO, CONTINUE * GFN05 MOV A,D CPI FNSIZ+1 JZ FNERR EMPTY FILE NAME!! XRA A =0 GFN1 STAX B ZERO OUT REMAINDER INX B DCR D JNZ GFN1 RET . DONE, EXIT * * * CODE FOR FILE NAMES IN COMMANDS * GFN3 LHLD TXA MVI D,FNSIZ+1 LXI B,CFN * GFN4 CALL GF1 CALL Get Filter 1 SHLD TXA INCASE THERE'S A COMMA OR CR INX H INCASE THERE'S NEITHER (POINT TO NEXT CHAR) * CPI ',' JZ GFN05 CPI CR JZ GFN05 * DCR D JZ FNERR TOO MANY * STAX B INX B JMP GFN4 * * * * FILE EOF PRIMITIVE * * FLEOF LDA CSFID FILE# CALL SYS DB EOFOP JMP DKERR RET . THAT'S SURE EASY! * * * * FILE EOR PRIMITIVE * * FLEOR LDA CEOF ANI 16-1 ANY KIND OF WRITE CPI 3 IFF LAST WAS WRITE RNZ . NOT WRITE, NOTHING TO DO * WEOR LHLD CREC ADJUST INX H FOR FULL INX H RECORD SIZE SHLD CREC * LHLD STA XCHG LHLD TSTKA DCX H DCX H CALL DSUB FIND SOME SPACE JC SOERR NO SPACE TO FIND SHLD XA SOME SPACE XCHG LHLD STA THE ADDRESS OF IT MVI B,07FH WHAT TO PUT THERE CALL SETM SET MEMORY TO 7FH * FLE9 LHLD XA SPACE XCHG LHLD CREC CALL DSUB CREC-SPACE JNC FLE0 CREC>SPACE, DO IT IN PARTS LHLD CREC IT CAN ALL BE DONE AT ONCE LXI D,0 XCHG . AMMOUNT TO DE, 0 TO HL * FLE0 SHLD CREC SAVE REMAINDER LHLD STA ADDR OF THE 7F'S DCX H MAKE ROOM FOR THE CR DAD D MAKE HL POINT TO WHERE THE CR SHALL GO MVI M,CR * * WRITE THE IRG SECTION (MAY BE MORE THAN ONE SECTION) LHLD STA XCHG . ADDR TO DE LDA CSFID MVI L,CR LXI B,7FFFH CALL SYS DB DWROP JMP DKERR * LHLD CREC MORE TO DO? MOV A,H ORA L JNZ FLE9 YES, DOITDOITDOIT * * DONE RESET CREC AND RETURN LHLD CRZ RECORD SIZE DCX H SET TO DCX H USEABLE SIZE (2 BYTES, ROOM FOR IRG) SHLD CREC RET . THAT'S SURE HARD! * * * * FILE SPACE PRIMITIVE * * FLSPA LDA SF ORA A RZ . NOT SPACE ACCESS * LHLD CSSD MOV A,H ORA L RZ . NOTHING TO DO * LDA CFT WE CAN'T SPACE ON A RANDOM FILE CPI BTRND JZ ACERR * LHLD CSSD DCX H SO 1 WILL READ/WRITE THE NEXT ELEMENT MVI D,1 SPACE FORWARD OR BACKWARD? LDA CSSC SER SPA CTRL ORA A JZ FLSP2 Z=1 ==> FORWARD INX H SO -1 WILL READ/WRITE THE LAST ELEMENT MVI D,128 Z=0 ==> BACKWARD FLSP1 JP FLSP2 IF NEG THEN SPACE TO EOF MVI D,-1 HOPEFULY CSSD IS ONE (1) FLSP2 SHLD CSSD MOV A,H ORA L RZ PUSH D SAVE DIRECTION MVI A,128 CMP D JNZ FLSP8 NOT BACKWARD, SPACE LXI B,2 BACK UP PAST LAST CR LDA CSFID CALL SYS DB SPAOP JMP FLSPE POP D PUSH D FLSP8 LXI B,7FFFH LDA CSFID MVI L,CR CALL SYS DB DSPOP JMP FLSPE MAY BE EOF/BOF FLSP9 LHLD CSSD DCX H POP D GET DIRECTION JMP FLSP2 RET * * TEST FOR E-O-F OK AT THIS POINT * FLSPE CPI EREOF JNZ DKERR POP D CLEAN STACK LXI H,0 SHLD CSSD TURN OFF SPACEING FLAG LDA CEOF E-O-F ALREADY SEEN? ANI 7 KNOCK OFF THE MODE BISTS TO GET THE FLAG BITS CPI 6 JZ ACERR ATTEMPT TO READ PAST E-O-F MVI A,6 STA CEOF LAST WAS READ EOF RET * * * * FILE SEEK PRIMITIVE * * FLSEK LDA RF ORA A RZ . NOT SEEK ACCESS * LDA CFT CPI BTRND JNZ ACERR CAN SEEK ONLY ON A RANDOM FILE * LHLD CRSA MOV A,H ORA L RZ . NOTHING TO DO * CALL FLEOR CLEAN UP THIS RECORD (IF LAST WAS WRITE) * LHLD CRZ THE RECORD SIZE MOV B,H MOV C,L * DCX H DCX H SHLD CREC WE ARE IN A NEW RECORD NOW * LHLD CRSA DCX H WE COUNT FROM ZERO XCHG . SEEK ADDRESS TO DE * CALL DIMUL FIND BYTE ADDRESS (DE.HL=BC*DE) IF RANFIX LXI B,2 OFFSET FOR REC SIZE AT TOP OF FILE DAD B JNC FLSE6 INX D QUAD PRECISION DE.HL ENDF FLSE6 MOV A,D ORA A JNZ OBERR REC EXP TOO LARGE * MOV A,E ORA A JZ FLSE0 SHORT SEEK IF A = 0 * XCHG . LONG SEEK IF NOT LHLD CBLKS BLK SIZ CALL DIDIV DE.HL=A.DE/HL PUSH H SAVE REMAINDER XCHG . INTEGER PART (BLOCK NUMBER) TO HL * * SEEK TO THE PROPER BLOCK * MVI B,0FFH BLOCK MODE SEEK LDA CSFID CALL SYS DB SEKOP JMP DKERR * * SPACE TO THE PROPER BYTE * LDA CSFID POP B GET REMAINDER MVI D,1 SPACE FORWARD CALL SYS DB SPAOP JMP DKERR JMP FLSE1 * * DO A SHORT SEEK TO THE BYTE ADDR IN HL * FLSE0 MVI B,0 BYTE MODE SEEK LDA CSFID CALL SYS DB SEKOP JMP DKERR * FLSE1 LXI H,0 SHLD CRSA ALL DONE RET * * * * FILE REWIND PRIMITIVE * * FLREW LDA CFT CPI BTRND CZ FLEOR CLEAN UP RECORD IF LAST WAS WRITE * LXI H,CEOF TEST FOR LAST OPERATION = WRITE MVI A,3 CMP M CZ FLEOF DO END-FILE * LDA CSFID REWIND THE FILE MVI D,0 THIS MEANS TO REWIND CALL SYS DB SPAOP JMP DKERR * IF RANFIX LDA CFT CHECK FOR RANDOM ACCESS FILE CPI BTRND JNZ FLRW0 * (THIS IS SLOPPY!) LDA CSFID SPACE PAST THE RECORD SIZE LXI B,2 MVI D,1 FORWARD CALL SYS DB SPAOP JMP DKERR * ENDF FLRW0 LXI H,CEOF SET EOF TO SHOW THE REWIND MVI M,4 LAST WAS REWIND RET * * * FILE KILL PRIMITIVE * FLKIL LXI D,CFN CALL SYS DB KILOP RET . ERROR CODE IN ACCA NOP NOP XRA A NO ERROR, ACCA = 0 RET * * * TAPE ON ROUTINE * TTON LDA CSFID RRC . MOVE IT TO RRC . ...THE TAPE RELAY CONTROL BITS (7 AND 6) XRI 0C0H COMPLEMENT THE BITS OUT TAPPT OUT TO TAPE CTRL PORT RET * *