PAGE
*
*
*******************************************
*
*
*
*
*          FILE INFORMATION REQUEST OPERATION
*
*
*    UDE POINTS TO NAME
*    UHL HAS DATA BLOCK ADDRESS
*
*    ERRORS:
*       FILE DOES NOT EXIST
*       FILE IS PROTECTED
*
*
FINFO LHLD UDE
 CALL SDIR  SEE IF NAME EXISTS
 JMP FIN90  WE RETURN HERE IF NOT
*
*    IT EXISTS.....CHECK FOR OVERWRITE INTO SYSTEM
*
 LXI D,DRESZ+3  SIZE
 LHLD UHL  USER SPECIFIED ADDRESS
 CALL MEMCHK
*
*  OK, COPY DIREC ENTRY
*
 LXI D,DEFID  -> FILE ID
 LHLD UHL  HL POINTS TO USER AREA
 CALL MOVEF  MOVE
 DB DESPR-DEFID+1  THIS MANY WORDS
*
 LXI D,DETYP  -> FILE TYPE
 LHLD UHL
 LXI B,DESPR-DEFID+1+2
 DAD B
 CALL MOVEF  MOVE CREATE PARM PART
 DB DEPRO-DETYP+1
*
 LHLD DBUF  -> NAME
 XCHG
 LHLD UHL
 LXI B,DESPR-DEFID+1+2+DEPRO-DETYP+1
 DAD B
 CALL MOVEF  MOVE NAME
 DB NMLEN
*
*  SEE IF FILE IS OPEN
*
 LHLD DBUF
 LXI D,DEFID-DEBUF
 DAD D  HL POINTS TO FILE ID
 MOV E,M
 INX H
 MOV D,M
 XCHG .  HL HAS FILE ID
 CALL SFCBS  SEARCH....TRIPLE LEVEL RETURN
 JMP FIN20  YES
 JMP FIN20  YES
 XRA A  NO
 JMP FIN21
*
*
*  "A" HAS NUMBER OF FCBS
*
FIN20 MVI A,1  YES
FIN21 LHLD UHL  STORE A 1 PAST DIREC ENTRY
 LXI D,DESPR-DEFID+1
 DAD D
 MOV M,A
 XRA A  =0
 LXI D,NMLEN+DEPRO-DETYP+1+1+1
 DAD D
 MOV M,A  PUT ZERO BYTE AFTER NAME
 JMP NRET  ALL DONE
*
*
FIN90 CALL ERRL2
 DB FINE0  NONEXISTENT
*
 PAGE
*
*
*******************************************
*
*
*
*
*                 ALTER FILE CHARACTERISTICS OPERATIONS
*
*
*  USER DE ALWAYS POINTS TO NAME
*
*
*
*     CHANGE FILE TYPE OPERATION
*
*  ON CALL  USER H HAS NEW TYPE
*
*  ERRORS:
*       FILE DOES NOT EXIST
*       FILE IS PROTECTED
*
CHTYP CALL FFILE  CHECK FOR PROTECTION (NAME AND TYPE)
 DB PNAT
 LDA UH
 STA DETYP  CHANGE TYPE
 JMP UWFIL  FINISH UP
*
*********************
*
*
*    CHANGE ATTRIBUTES OPERATION
*
*  USER H HAS NEW ONES
*
CHATR CALL FFILE
 DB PATR
 LDA UH
 STA DEPRO  SET NEW PROTECTION
 JMP UWFIL
*
*********************
*
*
*    CHANGE NAME OPERATION
*
*  USER HL POINTS TO NEW NAME
*
CHNAM LHLD UHL
 CALL SDIR  SEE IF NEW NAME EXISTS
 JMP CHN20  NO
 CALL ERRL1  YES
 DB CER0  FILE ALREADY EXISTS
*
*
CHN20 LDA FUNIT  GET DEFAULT UNIT
 PUSH PSW
 CALL FFILE  SET UP
 DB PNAT
*
*  MOVE IN NEW NAME
*
 POP H  H=UNIT
 LDA FUNIT
 CMP H  SAME?
 JNZ CHER1  NO, UNIT CONFLICT
 LHLD UHL
 CALL NAMIN  READ IN NAME
*
*  UPDATE DIRECTORY ENTRY FROM DEBUF, THEN
*  REWRITE DIRECTORY SECTOR AND RETURN.
*
UWFIL LXI D,DEBUF
 LHLD DBUF
 CALL MOVEF  MOVE ENTRY BACK
 DB DRESZ
 CALL WDSK  WRITE IT OUT
 JMP NRET  THEN GO.
*
*
*    SEARCH FOR FILE AND SET UP
*
FFILE LHLD UDE  HL POINT TO NAME
 CALL SDIR
 JMP KIL90  NONEXISTENT
 POP H
 LDA DEPRO
 ANA M
 INX H
 JNZ CHER0  ERROR...PROTECTED
 PCHL .  OK, RETURN CALL+1
*
*
CHER0 CALL ERRL1  ERROR
 DB CHER
*
CHER1 CALL ERRL1  UNIT CONFLICT
 DB CHR2
*
 PAGE
*
*
*******************************************
*
*
*
*
*                     SEEK OPERATION
*
*
*   USER A   HAS FILE NUMBER
*   USER B = 0 => HL = BYTE#
*         <> 0 => HL = BLOCK#
*   USER HL  HAS REQUESTED BYTE NUMBER
*
*   ERRORS:
*           DEVICE FILE
*           FILE NOT RANDOM
*           TOO FAR IN FILE
*           EOF
*
*
SEEK CALL PFCB
 CALL PBUF  PREPARE BUFFER
 LHLD UHL
 PUSH H  SAVE SEEK ADDRESS
 LHLD FBLKS
 XCHG
 LHLD TBUFA
 LDA UB  GET BLOCK OPTIONS
 CALL DVBR
 DB DTSEK  GO SEEK
 JMP SEKE1  OUT OF RANGE
*  CALL TO DVBR RETURNS HERE IF OK
 SHLD FBDL  SET BDL
 XCHG
 SHLD FNBD  AND NBD
 CALL RBUF  DONE
 JMP NRET
*
*********************
*
*
*     DISK INTERFACE FOR SEEK
*
*  CHECK IF RANDOM INDEX EXISTS
*  THEN READ IT INTO DIRECTORY BUFFER IF NOT ALREADY IN
*  MEMORY
*
DDSEK LHLD FAIND  SEE IF INDEX IN MEMORY
 SHLD RINAD  ASSUME LOADED
 INX H  (ITS -1 IF NOT)
 MOV A,H
 ORA L
 CZ RINDX  LOAD AND SET RINAD IF NOT
*
*    COMPUTE QUOTIENT AND REMAINDER OF UHL/FBLKS
*
 LHLD FBLKS
 MOV B,H
 MOV C,L  BC IS BLOCK SIZE
 POP H  =RETURN ADDRESS
 XTHL .  HL=SEEK POINT, STACK= RETURN ADDRESS
 LXI D,0  DE HAS QUOTIENT..IT WILL,IT WILL
*
*    CHECK FOR SEEK BLOCK
*
 LDA UB  GET OPTION...BLOCK OR BYTE
 ORA A
 JZ SEK10  NO BYTE
 XCHG .  DE = BLOCK#
 LXI B,0
 LXI H,0  SET SO NBD = 0 EVENTUALLY
 JMP SEK20
*
*
*   GO TO INDIVIDUAL BYTE
*
SEK10 CALL RWPS  HL = HL - BC
 INX D
 JNC SEK10
 DCX D
*
*  GOT IT
*
SEK20 MOV A,D
 ORA A
 RNZ .  ERROR, REQUESTED BLOCK .GT. 256
 MOV A,E
 ORA A
 RM .  ERROR, ITS GE 128
 DAD B  HL IS REMAINDER
 PUSH H  SAVE IT AS FUTURE NBD
*
*  NOW FETCH INDEX ENTRY
*
 LHLD RINAD  -> INDEX BLOCK
 DAD D
 DAD D  HL POINTS TO APPROPRITE ONE
*
*  PICK IT UP
*
 MOV E,M
 INX H
 MOV D,M
 PUSH D  SECTOR/TRACK OF DISK ADDRESS
 PUSH H  INDEX BLOCK ADDRESS
 LHLD FCURSC  GET CURRENT SECTOR/TRACK
 CALL COMP  COMPARE
 PUSH PSW  SAVE FLAGS FOR LATER
 CNZ WDBUF  WRITE OUT DIRTY BUFFER IF NOT SAME ADDRESS
 POP PSW
 POP D  INDEX ADDRESS
 POP H  DISK ADDRESS
 PUSH PSW
*
*  IS DISK ADDRESS IN EXISTENCE YET
*
 MOV A,H
 ORA L
 JZ SEX  NO, PAST EOF ERROR, PROBABLY
*
*  HL HAS ADDRESS OF NEW CURRENT BLOCK, NBD ON TOP OF STACK
*
 SHLD FCURSC  SAVE AS CURRNT ADDRESS
 POP PSW
 LHLD FBDL  IN CASE WE DON'T READ IN THE BLOCK
 CNZ RBLK  READ NEW BLOCK
 POP D
*
* DE=NBD, HL=BDL; CHECK NBD .LE. BDL
*
 CALL COMP
 JZ RX2  OK, WE'RE AT THE EOF
 JC RX2  OK, WE'RE NOT AT THE EOF, BUT IN THE FILE
 RET .  EOF ERROR, WE'VE GONE TOO FAR
*
*********************
*
*
*  THERE ARE SOME NASTY SPECIAL CASES ABOUT SEEKING
*  TO THE END OF FILE.  IT IS OK TO SEEK TO LAST BYTE +1,
*  BUT, UNFOUTUNATELY, A SPECIAL TEST MUST BE MADE TO
*  FORCE THE CURSOR INTO THE LAST LEGAL BLOCK INSTEAD
*  OF THE NEXT, NOT-YET-EXISTENT BLOCK.
*
*  ADDRESS DIDN'T EXIST, SEE IF ALTERNATE ADDRESS AT
*  END OF LAST BLOCK APPLIES.
*
* FIRST, SETUP FOR PREVIOUS SECTOR
*
SEX XCHG .  HL -> 1 BEYOND CURRENT
 DCX H
 DCX H
 POP PSW
 MOV A,M  FOR H LATER
 DCX H
 MOV L,M
 MOV H,A
 ORA L  TEST FOR EXISTENCE
 POP D  KEEP STACK CLEAN
 RZ .  NO, WE'RE DEFINITLY BEYOND EOF
 SHLD FCURSC  WELL, MAYBE OK, LAST BLOCK EXISTS
*
* SEE IF NBD WAS ZERO, IF SO, COULD ALSO USE BDL OF LAST BL
*
 MOV A,D
 ORA E
 RNZ .  NOT ZERO, OUT OF RANGE
*
* OK, LOAD LAST BLOCK, SET NBD=BDL, BUT ERR IF NOT FULL
*
 CALL RBLK
 XCHG
 LHLD FBLKS  BDL MUST = BLOCK SIZE, ELSE OUT OF RANGE
 CALL COMP
 JZ RX2  OK
 RET .  NO, GO BACK WITH ERROR
*
*
SEKE0 CALL ERRL1  FILE NOT RANDOM
 DB SERR0
*
SEKE1 CALL ERRL1  SEEK ADDRESS OUT OF RANGE
 DB SERR2
*
*********************
*
*
*           READ FILE INDEX
*
*  ENTER AT RINDX TO READ INTO DIBUF
*  ENTER AT RINDY WITH HL -> WHERE TO LOAD
*  LOAD INDEX AND SET RINAD TO -> INDEX IN EITHER CASE
*
RINDX LXI H,DIBUF
RINDY SHLD RINAD  SET LOAD ADDRESS
 LHLD FINDX  INDEX ADDRESS
 MOV A,H
 ORA L
 JZ SEKE0  ITS ZERO, ERROR
*
 CALL STDAD  SET XFER DESC....
 LHLD FINDX
 SHLD TDAD
 LXI H,SECTSZ  BLOCKSIZE IS 256 OR ELSE
 SHLD TBCNT
 LHLD RINAD
 SHLD TBUF  READ INTO SPECIFIED ADDRESS
 JMP RDSK  READ INDEX AND RETURN
*
 PAGE
*
*
*******************************************
*
*
*
*              MAKE FILE RANDOM OPERATION
*
*
*  CREATE IF NECESSARY AND UPDATE INDEX BLOCK
*
*
*  USER A HAS THE FILE NUMBER
*
*    ERRORS:
*            DEVICE FILE
*
*
RNDOM CALL PFCB  PREPARE FCB
 LDA FTYPE  CHECK FOR DEVICE FILE
 INR A
 JZ RNER0  YES...ERROR
 CALL PBUF  PREPARE BUFFER
 CALL WDBUF  CLEAN IT UP
*
*  READ FIRST BLOCK
*
 LHLD FFBA
 SHLD FCURSC
 CALL RBLK
*
*  ZERO THE DIRECTORY BUFFER..DIBUF
*
 XRA A
 MOV B,A  B=256=COUNT=SECTSZ
 LXI H,DIBUF
 SHLD RNPTR  RNPTR IS ''DIBUF''
*
RND10 MOV M,A  ZERO A WORD
 INX H
 DCR B  COUNT DOWN
 JNZ RND10
*
*  CHECK IF FILE ALREADY HAS AN INDEX
*
 LHLD FINDX
 MOV A,H
 ORA L
 JNZ RND20  YES...
*
*  ALLOCATE AN INDEX BLOCK FOR THE FILE
*
 LHLD FBLKS
 PUSH H  SAVE BLOCK SIZE
 LXI H,SECTSZ
 SHLD FBLKS
 CALL AFBLK  ALLOCATE INDEX BLOCK
 SHLD FINDX  SAVE ITS ADDRESS
 POP H
 SHLD FBLKS  RESTORE BLOCK SIZE
*
*  NOW READ THROUGH THE FILE AND NOTE THE ADDRESS
*  OF EACH BLOCK IN THE INDEX
*
RND20 MVI A,128
 STA RNCNT  128 MAX
*
*  DO NEXT BLOCK
*
RND30 LHLD FCURSC
 XCHG
 LHLD RNPTR
 MOV M,E  STORE CURENT SECTOR ADDRESS
 INX H
 MOV M,D  INTO MAP
 INX H
 SHLD RNPTR  UPDATE MAP POINTER
 LDA RNCNT
 DCR A  DECREMENT COUNT
 STA RNCNT
 JZ RND35  DONE 128, MOVE TO EOF
*
*  MOVE TO NEXT BLOCK
*
 CALL DDRNB
 JMP RND40  EOF, DONE
 JMP RND30
*
*
*  SPACE UNTIL EOF
*
RND35 CALL DDRNB
 JMP RND40  EOF
 JMP RND35  MOVE TO NEXT BLOCK
*
*  NOW WRITE OUT MAP...ID IS SET IN TFID.,SO IS UNIT
*
RND40 SHLD FBDL
 SHLD FNBD  SET AT EOF
 LHLD FINDX
 SHLD TDAD
 LXI H,DIBUF
 SHLD TBUF
 LXI H,SECTSZ  GET STANDARD SECTOR SIZE
 SHLD TBCNT
 CALL WDSK
*
* UPDATE INDEX SAVED IN MEMORY, IF ANY
*
 CALL UPIM
*
*  UPDATE DIRECTORY INDEX POINTER
*
 LHLD FID
 CALL SDIRX  SEARCH FOR FILE
 LHLD DBUF  POINTS TO ENTRY FOR FILE
 LXI D,DEINX-DEBUF
 DAD D
 XCHG
 LHLD FINDX  PUT IN INDEX ADDRESS
 MOV A,L
 STAX D
 INX D  LOW
 MOV A,H
 STAX D  HIGH
 CALL WDSK  REWRITE DIRCTORY
*
*  THATS IT
*
 CALL RBUF  RELEASE BUFFER
 JMP NRET
*
*
RNER0 CALL ERRL1  DEVICE FILE RANDOM OPERATION
 DB RERR0
*
*********************
*
*
*  UPDATE INDEX POINTED TO BY FAIND, IF ANY
*  MAKE A COPY OF DIBUF INTO IT
*
UPIM LHLD FAIND
 INX H  FAIND = -1 IF NONE
 MOV A,H
 ORA L
 RZ .  NONE TO DO
 DCX H  -> MEMORY COPY OF INDEX
 LXI D,DIBUF  -> MASTER COPY
 LXI B,SECTSZ
 CALL MOVEV  MOVE IT
 RET .  SIMPLE, NO?
*
 PAGE
*
*
*******************************************
*
*
*
*                  ABORT OPERATION
*
*
*  TYPE ERR FOLLOWED BY THE CONTENTS OF USER A,
*           USER B, AND USER HL.
*
*  RETURN TO THE SYSTEM THROUGH SRESET.
*
*
ABURP CALL OUST  TYPE CR LF ERR
 DB CR
 DB LF
 ASC 'ERR: '
 DB 0
 LDA UA
 CALL OUT8B  TYPE A
 LDA UB
 CALL OUT8B  TYPE B
 CALL O16N  TYPE HL
 DW UHL
 JMP SRESET  RETURN THRU SRESET
*
*********************
*
*
* PRINT THE 16 BIT NUMBER POINTER TO BY CALL+1,
*  PRECEEDED BY A BLANK.
*  RETURN PAST THE POINTER
*
O16N MVI A,BLNK
 CALL CONOUT
 POP H  -> POINTER
 MOV E,M
 INX H
 MOV D,M  DE = POINTER
 INX H
 PUSH H  UPDATE RETURN
 XCHG
 MOV E,M
 INX H
 MOV D,M
 XCHG .  = NUMBER
*  FALL INTO OUT16
*
*   OUTPUT THE 16 BIT NUMBER IN HL
*
OUT16 MOV A,H
 CALL OUT8
 MOV A,L
*
*  OUTPUT 8 BIT NUMBER
*
OUT8 MOV C,A
 RAR
 RAR .  OVER IT GOES
 RAR
 RAR
 CALL OUT8A
 MOV A,C
*
*
OUT8A ANI 15
 ADI 48
 CPI 58
 JC CONOUT  IT WAS A NUMBER, OUTPUT IT AND RETURN
 ADI 7
 JMP CONOUT
*
*
*   OUTPUT A 8 BIT NUMBER FOLLOWED BY A BLANK
*
OUT8B CALL OUT8
 MVI A,BLNK  NOW THE SPACE
 JMP CONOUT  OUTPUT IT AND RETURN
*
*
*   OUTPUT ASCII MESSAGE FOLLOWING CALL TO ZERO BYTE
*
OUST POP H
OUST5 MOV A,M  FETCH CHAR
 INX H
 ORA A
 JZ OUST9  ZERO BYTE, RETURN
 CALL CONOUT  TYPE CHAR
 JMP OUST5
*
OUST9 PCHL
*
 PAGE
*
*
*******************************************
*
*
*
*                  SET UNIT OPERATION
*
*  UA HAS THE DESIRED UNIT NUMBER
*
*    ERRORS:
*       ILLEGAL UNIT NUMBER
*
*
SUNH LDA UA
 LXI H,MAXUN  POINT TO MAXIMUM UNIT NUMBER
 CMP M
 JNC SUNER  YES, IT IS ILLEGAL
 STA DUNIT  NO, SET UNIT,DEFAULT
 JMP NRET
*
*
SUNER CALL ERRL1
 DB UNER0  ILLEGAL UNIT
*
 PAGE
*
*
*******************************************
*
*
*
*
*            FILE CONTROL STATUS CHECK
*
*   UA HAS THE FILE NUMBER
*
FCTRL CALL PFCB  PREPARE
 LHLD UDE  LOAD A, DE, HL
 XCHG
 LHLD UHL
 LDA UB
 CALL DVBR  CALL DRIVER
 DB DTCTL
*
 SHLD UHL  SAVE REGISTERS
 XCHG .  FOR
 SHLD UDE  RETURN
 STA UA
 JMP NRET
*
*********************
*
*
*                    ALLOCATE BUFFER
*
*        DE HAS DESIRED SIZE
*        CALL ALBUF
*        RETURN HL HAS THE BUFFER
*
*  MINAD-DE IS USED, MINAD IS UPDATED
*  ABORT EXIT IF NO SPACE
*
ALBUF LHLD MINAD  GET LOWEST ADDRESS IN USE
 CALL ARITH  HL=HL-DE
 XCHG
 SHLD WBUFSZ  SAVE SIZE FOR ERROR DEALLOCATION
 LHLD LOWAD  GET LOWEST ALLOWED ADDRESS
 CALL COMP  PASSING MIN ADDR?
 JC ALB9  NEW MIN LT LOWAD, MEM OVERFLOW
 XCHG
 SHLD MINAD
 SHLD WBUFAD  SAVE FOR ERROR DEALLOCATION
 RET
*
*
*  ABORT, NO SPACE IS AVAILABLE
*
ALB9 LXI H,0
 SHLD WBUFSZ  CLEAR TO AVOID SCREW-UPS
 CALL ERRL1
 DB MER0
*
*********************
*
*
*       COMPARE DE AND HL
*
*  DE,HL ARE UNCHANGED
*
*  CARRY IF HL > DE  UNSIGNED
*  ZERO  IF HL = DE
*
COMP MOV A,D
 SUB H
 RC
 RNZ
 MOV A,E
 SUB L
 RET .  SIGN AND ZERO SET
*
*********************
*
*
*             PROTECTION TEST (PROTEST)
*
*  CURRENT FCB IS SET
*      CALL PROTST
*      BIT(S) TO TEST
*      RETURN, NO (NONZERO RESULT)
*      RETURN, OK (ZERO RESULT)
*
*
PROTST POP H  GET RETURN ADDRESS, POINTER TO PROTECTION
 LDA FPROT  GET FILE ATTRIBUTES
 ANA M  MASK AND TEST
 INX H  MOVE PAST TEST WORD
 JZ RP3  OK...RETURN PAST IT
 PCHL .  RETURN, PROTECTION SET
*
*