*
*********************
*
*
*            MOVE MEMORY ROUTINES
*
*    DE HAS SOU ADDRESS, HL HAS DEST ADDRESS
*       CALL MOVEF
*       MOVE COUNT
*       RETURN
*
*
MOVEF XTHL .  GET RETURN ADDRESS
 MOV C,M  IT POINTED TO THE COUNT
 INX H  MOVE UP RETURN
 XTHL .  PUT IT BACK
 XRA A
 MOV B,A  BC HAS COUNT
 JMP MOVEA
*
*********************
*
*
*    MOVE VARIABLE SIZE BLOCK
*
*  BC HAS COUNT, DE HAS SOURCE, HL HAS DESTINATION
*  CALL MOVEV
*  RETURN
*
MOVV1 LDAX D
 MOV M,A
 INX H  BUMP POINTERS
 INX D
 DCX B
MOVEV MOV A,B
MOVEA ORA C
 JNZ MOVV1
 RET
*
*********************
*
*
*
*                  PREPARE FCB
*
*  UA HAS FCB NUMBER
*  CALL PFCB
*  RETURN FCB   FRADD SET
*  ABORT IF ILLEGAL FCB NUMBER
*
*
PFCB LDA NFCB  GET NUMBER OF FCB'S
 MOV B,A
 LDA UA  GET FILE NUMBER DESIRED
 CMP B
 JNC PFC90  ERROR, TOO BIG
*
 LHLD FCBASE  BOTTOM OF FCB'S
 LXI D,LNFCB  LENGTH OF EACH ONE
 ORA A
 JZ PFC6  FILE "0" NO ADDING NEEDED
*
PFC5 DAD D  MOVE TO NEXT FCB
 DCR A
 JNZ PFC5
*
*
*   SPECIAL ENTRY POINT FOR CLOSE ALL OPERATION
*
*      ENTER WITH HL--> FCB
*
PFC6 SHLD FRADD  SAVE THE FCB ADDRESS
 XCHG
 LXI H,FCBORG  MAKE A COPY TO FCBORG
 CALL MOVEF  MOVE IT
 DB LNFCB
*
*  CHECK IF UNOCCUPIED
*
 LHLD FID
 MOV A,H
 ORA L
 RNZ .  NON ZERO ID, OK
*
PFC90 CALL ERRL1  ERROR
 DB PER1
*
*********************
*
*
*    IF BUFFER IS DYNAMIC RELEASE IT
*
*  CURRENT FCB IS SET
*  CALL RBUF
*  RETURN
*
RBUF LHLD FBUFA
 INX H
 MOV A,H
 ORA L
 RNZ .  FILE IS NOT UNBUFFERED
*
*  RELEASE BUFFER
*
 CALL WDBUF  WRITE DIRTY BUFFER
 LHLD FBLKS
 XCHG .  DE HAS SIZE
 LHLD TBUFA  HL HAS ADDRESS
 CALL DLBUF  DEALLOCATE
 LXI H,0
 SHLD TBUFA  ZERO BUFFER POINTER
 RET
*
*********************
*
*
*        NAMIN, PROCESS IN A NAME
*
*    HL POINTS TO NAME
*    CALL NAMIN
*
*    NAME IS ASSEMBLED INTO DEBUF
*    FUNIT IS SET
*
*  FIRST ZERO OUT NMLEN BYTES
*
NAMIN LXI D,DEBUF
 MVI B,NMLEN
 XRA A
*
NAM05 STAX D
 INX D
 DCR B
 JNZ NAM05
 LXI D,DEBUF  PUT IT HERE
 MVI B,NMLEN+1  MAXCOUNT+1
*
*
*  LOOP HERE WITH:  DE--> NEXT CHARACTER POSITION
*                   B =   NUMBER OF CHARACTERS REMAINING
*                   HL--> NEXT INPUT CHARACTER
*
NAM10 MOV A,M  PICKUP A CHAR
 CALL NAMTST
 JZ ICIN  ERROR!!
*
*  FALL THROUGH WITH LEGAL CHAR IN 'A'
*
NAM20 STAX D
 INX H
 INX D
 DCR B
 JNZ NAM10
*
*  ERROR--TOO MANY CHARACTERS
*
 CALL ERRL1
 DB ERNTL  NAME TOO LONG
*
*
*  ZERO BYTE FOUND (NAMTST COMES HERE)
*
NAM30 POP B  GET RID OF RET
 LDA DUNIT  USE DEFAULT UNIT
NAM31 STA FUNIT  AS FILE UNIT
 LDA DEBUF  CHECK FOR NULL NAME
 ORA A
 RNZ .  IF OK
*
ICIN CALL ERRL1
 DB ICE0  ILLEGAL NAME
*
*
*  FOUND UNIT, PICK IT UP
*
NAM40 POP B
 INX H
 MOV A,M  PICKUP CHAR
 ANI 127
 SBI '0'  SUBTRACT ZERO CHR
 JC ICIU  BAD CHAR
 LXI H,MAXUN  CHECK RANGE OF UNIT NUMBER
 CMP M
 JC NAM31  OK, SELECT IT
*
ICIU CALL ERRL1
 DB ICE1  UNIT ERROR
*
*********************
*
*
*   TEST A NAME CHARACTER IN "A"
*
*   RETURN IF NONSPECIAL LEGAL CHARACTER
*   ERROR  IF ILLEGAL CHARACTER
*
*   GO TO NAM30 OR NAM40 IF TERMINATOR FOUND
*   (RETURN DISPOSED OF)
*
NAMTST ANI 127  MASK DOWN
 JZ NAM30  END OF NAME
 CPI '/'  SLASH?
 JZ NAM40  SELECT UNIT
 CALL DLTST  CHECK FOR BAD CHARS
 RZ .  IF SO
*
 CPI '#'  THE OTHER ONES
 RZ .  BAD
 CPI ' '+1 SPACE
 JC ICIN  CONTROL CHAR OR SPACE
 CPI 127  NOT .EQ. OR .GT.
 RET .  LEGAL CHAR
*
 PAGE
*
*
*********************
*
*
*
*               SEARCH DIRECTORY
*
*
*   HL POINTS TO NAME, CURRENT DIREC SET
*
*      CALL SDIR
*      RETURN = NOT FOUND
*      RETURN = FOUND, DBUF POINTS TO ENTRY WITH ROOM OR
*               IS ZERO IF THE DIRECTORY IS FULL.
*
SDIR CALL NAMIN  PROCESS NAME
 XRA A
 STA DRID  SET ID TO ZERO
 STA DRID+1
*
*  ALTERNATE ENTRY FROM SDIRX
*  COME HERE WITH A=0,DRID EQU FILE ID
*
SDI02 STA DFC  INITIALIZE
 STA DFC+1  FREE POINTER
*
*  READ FIRST SECTOR
*
 LXI D,DDSC
 LXI H,TDAD
 CALL MOVEF  SET TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 LDA FUNIT
 STA TUNIT  DISK UNIT
*  READ
SDI07 CALL RDSK
*
*  SEE ABOUT FREE STUFF
*
 LHLD DFC
 MOV A,L
 ORA H
 JNZ SDI20  ALREADY FOUND ONE
 LDA DINE
 CPI DREMS
 JNC SDI20  SECTOR IS FULL
 LHLD TDAD
 SHLD DFC  SAVE AVAILABLE SECTOR
*
*  SET UP DIRECTORY SECTOR SEARCH
*
SDI20 LXI H,DRFDS  FIRST ENTRY ADDRESS
 SHLD DBUF  SAVE POINTER
 LDA DINE
 STA DCNT  SAVE COUNT
 ORA A
 JZ SDI70  SECTOR IS EMPTY, MOVE TO NEXT
*
*  LOOP AND TEST ENTRIES
*
SDI30 LHLD DRID
 MOV A,L
 ORA H
 JNZ SDI50  ITS A SEARCH BY ID
*
*  TEST NAME
*
 LXI D,DEBUF  USER NAME
 LHLD DBUF  NAME IN SECTOR
*
*  COMPARE STRINGS
*
 MVI B,NMLEN
SDI40 LDAX D
 CMP M
 JZ SDI44  MATHC ON THIS CHARACTER
*
*  TRY TO MATCH UPPER/LOWER CASE CHARACTERS
*
 CPI 97  ="a"
 JC SDI42  DEBUF CHARACTER NOT LOWER CASE
 SBI 32  DEBUF CHAR WAS LC, UPSHIFT AND TRY
 JMP SDI43  TO MATCH AGAIN
*
* DEBUF CHAR NOT LC,  TRY TO UPSHIFT DIREC CHAR
*
SDI42 MOV A,M
 CPI 97  ="a"
 JC SDI60  DIREC CHAR NOT LC, NO MATCH
 LDAX D  GET DEBUG CHAR
 ADI 32  DOWNSHIFT DEBUG CHAR TO TRY MATCH
*
* TRY ALTERNATE MATCH
*
SDI43 CMP M
 JNZ SDI60  NO, SECOND MATCH ATTEMPT FAILED
*
SDI44 INX D  MATCH
 INX H
 DCR B  MOVE TO NEXT CHARACTER
 JNZ SDI40
*
*  MATCH
*
SDI45 LHLD DBUF  MOVE ENTRY INTO
 XCHG
 LXI H,DEBUF  DEBUF
 CALL MOVEF
 DB DRESZ
 JMP RP2  RETURN TO CALL PLUS 2
*
*
*  MOVE TO NEXT ENTRY
*
SDI60 LDA DCNT
 DCR A  COUNT DOWN
 JZ SDI70  SECTOR EMPTY
 STA DCNT
 LHLD DBUF
 LXI D,DRESZ  MOVE POINTER
 DAD D
 SHLD DBUF
 JMP SDI30
*
*
*   MOVE TO NEXT SECTOR
*
SDI70 LHLD IHFOR  FORE POINTER
 MOV A,H
 ORA A
 RM .  EOF, FAIL
 SHLD TDAD  SET NEXT SECTOR
 JMP SDI07
*
*
*  CHECK FILE ID, NOT NAME
*
SDI50 LHLD DBUF
 LXI D,DEFID-DEBUF
 DAD D  HL POINT TO ID
 LDA DRID
 CMP M
 JNZ SDI60  NOT SAME
 INX H
 LDA DRID+1
 CMP M
 JNZ SDI60  NOPE
 JMP SDI45  YES, MATCH
*
*********************
*
*
*             SEARCH DIRECTORY BY ID
*
*    SAME AS SDIR BUT HL HAVE ID
*    ENTER AT SDIRY WITH A = UNIT#, ALSO
*
*   THE FILE MUST EXIST.  THE DIRECTORY ON WHICH THE
*   FILE EXISTS IS SEARCHED.
*
SDIRY STA FUNIT  SPECIAL ENTRY FOR "OPEN?"
SDIRX SHLD DRID  SAVE ID
 XRA A  SET A TO ZERO
 CALL SDI02  GO SEARCH
 CALL CI98  FILE MUST EXIST, OR ELSE!
 RET
*
*********************
*
*
*    DIRECTORY FILE DESCRIPTOR
*
DDSC DB DIRDS  SECTOR
 DB DIRDT  TRACK
DDSC2 DW SECTSZ  BYTE COUNT
 DW IDDIR  FILE ID
 DW DIBUF  BUFFER
*
*********************
*
*
*     MAKE ENTRY IN DIRECTORY
*
*  DEBUF HAS ENTRY, DFC IS SET
*
EDIR LHLD DFC
 MOV A,L
 ORA H
 CZ CI98  BETTER NOT BE FULL!
*
*  READ SECTOR WITH FREE ENTRY
*
EDI10 SHLD TDAD  SAVE DISK ADDRESS
 LXI D,DDSC2
 LXI H,TBCNT
 CALL MOVEF  MOVE IN DIRECTORY DESCRIPTOR
 DB TBUF-TBCNT+2
 LDA FUNIT
 STA TUNIT  UNIT
 CALL RDSK  READ SECTOR
*
*  MOVE IN ENTRY
*
 LXI D,DIBUF
 XRA A
 MOV H,A
 LDA DIND
 MOV L,A  HL = NEXT DISPLACEMENT
 DAD D  HL = DESTINATION
 LXI D,DEBUF  DE = ENTRY BUFFER
 CALL MOVEF
 DB DRESZ
*
*  UPDATE HEADER
*
 LDA DINE
 INR A
 STA DINE  NUMBER OF ENTRIES
 LDA DIND
 ADI DRESZ
 STA DIND  NEXT ENTRY DISPLACEMENT
 CALL WDSK  RE WRITE THE ENTRY
 RET .  THATS ALL
*
*********************
*
*
*      REMOVE DIRECTORY ENTRY
*
*  DIBUF HAS SECTOR
*  DBUF  POINTS TO ENTRY
*  ALWAYS NORMAL RETURN
*
RDIR LDA DINE
 DCR A  UPDATE COUNT
 STA DINE
 JZ RDI60  IT IS NOW ZERO, NOTHING TO MOVE
*
*    CALCULATE NUMBER OF WORDS TO MOVE
*
*  HERE I ASSUME (DBUF MOD 256)-(DIBUF MOD 256)
*  = (DBUF-DIBUF) MOD 256 WHICH IS BEING PROVEN.
*
 LXI D,DIBUF
 LHLD DBUF
 MOV A,L
 SUB E  = WORDS BEFORE ENTRY
 MOV B,A
 LDA DIND  DISPLACEMENT TO NEXT
 SUB B  = WORDS AFTER ENTRY + WORDS IN ENTRY
 SUI DRESZ  = WORDS AFTER ENTRY
 JZ RDI60  ZERO, NO MOVING INVOLVED
 MOV C,A
 XRA A  = O
 MOV B,A  BC HAS COUNT
 LHLD DBUF
 LXI D,DRESZ
 PUSH H  SAVE DBUF FOR DESTINATION
 DAD D  = SOURCE ADDRESS (DBUF+DRESZ)
 XCHG .  PUT IN DE
 POP H  = DESTINATION ADDRESS (DBUF)
 CALL MOVEV  RECALL THAT BC HAS COUNT
*
RDI60 LDA DIND
 SUI DRESZ  UPDATE NEXT ENTRY DISPLACEMENT
 STA DIND
 CALL WDSK  TDAD STILL IS SET, REWRITE
 RET
*
*********************
*
*
*        GET FILE ID
*
*  CURRENT LOGICAL UNIT DESCRIPTOR IS SET UP
*  CALL GFID
*  RET WITH ID IN DE
*  ABORT IF NO IDS ARE AVAILABLE
*
*  SET UP READ
*
GFID LXI D,NIDD
 LXI H,TDAD
 CALL MOVEF  SET TRANSFER DESCRIPTOR
 DB TBUF-TDAD+2
 LDA FUNIT
 STA TUNIT  UNIT.
 CALL RDSK  READ IT
*
 LHLD IDBUF
 PUSH H  SAVE ID
 INX H  INCREMENT
 MOV A,H
 ORA L
 JZ NOIDS  NO IDS LEFT, SERIOUS
 SHLD IDBUF  OK, REWRITE
 CALL WDSK
 POP D  PUT ID INTO DE
 RET
*
*
NOIDS POP D  GET RID OF IT
 CALL ERRL0
 DB IER0  NO IDS LEFT
*
*********************
*
*
*    FSM DESCRIPTOR
*
NIDD DB DANIS  SECTOR
 DB DANIT  TRACK
 DW NIDBC  BYTE COUNT
 DW IDNID  FILE ID
 DW IDBUF  BUFFER
*
*********************
*
*
*    WRITE BUFFER TO DEVICE IF DIRTY
*
WDBUF LDA FFLAG
 ORA A  TEST DIRTY FLAG
 RZ .  NOT DIRTY
*
 LHLD FBDL  THE LAST BYTE IN THE BUFFER
 XCHG
 LHLD TBUFA  SET HL=START ADDRESS, DE=LAST ADDRESS
 CALL DVBR  WRITE BLOCK
 DB DTWB
 JMP SEOF  EOF, ERROR
 JMP WDB50
*
*********************
*
*
*          READ NEXT BUFFER LOAD FROM DEVICE
*
* CLEAN BUFFERS, READ BLOCK, THEN SET NBD=0,
* AND BDL=INCOMING BLOCK SIZE
* COME WITH HL=BUFFER SIZE
*
RDNB PUSH H
 CALL WDBUF  CLEAN IF DIRTY
 POP D
 LHLD TBUFA
 CALL DVBR  READ NEXT
 DB DTRNB
 RET .  EOF ENCOUNTERED
 NOP
 NOP
 SHLD FBDL  SET BDL
 LXI H,0
 SHLD FNBD  NBD=0
 JMP RP2  RETURN CALL +2
*
*********************
*
*
*     WRITE CURRENT BUFFER AND LOAD NEXT
*
*  CALL WITH SIZE IN HL
*  SET NBD=0, BDL FROM DRIVER, FFLAG=0
*
WDBR XCHG
 LHLD TBUFA
 CALL DVBR  WRITE
 DB DTWBR
 JMP SEOF  EOF, ERROR
*
WDB45 SHLD FBDL  SET BDL
 LXI H,0
 SHLD FNBD  NBD=0
*
WDB50 XRA A
 STA FFLAG  FFLAG=0
 RET .  RETURN
*
*********************
*
*
*              DEVICE DRIVER BRANCH
*
*  CALL WITH CALL+1=OPERATION
*  PASS DE, HL, AND A TO THE DRIVER
*
DVBR XTHL
 MOV C,M  PICKUP DISPLACEMENT
 INX H  MOVE PAST IT
 MVI B,0  BC=DISPLACEMENT
 XTHL .  SAVE UPDATED RETURN
 PUSH H
 LHLD FDRIV
 DAD B  HL->DISPATCH ADDRESS
 MOV B,A
 MOV A,M  PICKUP FIRST PART
 INX H
 MOV H,M  THEN SECOND
 MOV L,A  HL=DISPATCH ADDRESS
 ORA H
 JZ IDAC  NO ZERO OPERATION.. ERROR
 MOV A,B
 XTHL .  RESTORE HL,
 RET .  THEN GO INTO DRIVER.
*
*********************
*
*
*            DISK DRIVER READ LAST BLOCK
*
DDRLB LHLD FBACK  GET BACK POINTER
 MOV A,H  TEST FOR BOF
 ORA A
 RM .  YES, WE'RE ALL THE WAY BACK
 SHLD FCURSC  SET AS CURRENT SECTOR AND FALL THROUGH
*
*
*
*          DISK DRIVER READ BLOCK
*
DDRBL CALL RBLK
RX2 XTHL .  RETURN CALL+2, BUT
 INX H  LEAVE
 INX H  HL
 INX H  ALONE.
 XTHL
 RET
*
*