ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/SIMTEL/CPMUG/CPMUG024.ARK/TAPELIB.MAC

Text File | 1984-04-29 | 38KB | 1,538 lines

;            -- TAPELIB --
;
;                    BY:  S. J. SINGER
;                        [phone]
;
;    THIS PROGRAM IS A GENERAL CASSETTE TAPE LIBRARY MANAGER FOR CP/M.
;IT ACCEPTS A FUNCTION FOLLOWED BY A FILE NAME FROM THE CONSOLE AND
;PERFORMS A DISK TO TAPE OR TAPE TO DISK COPY. ANY CP/M FILE MAY BE COPIED.
;THE TAPE FORMAT IS TARBELL COMPATABLE, HOWEVER THE TAPES PRODUCED BY
;TAPELIB ARE NOT EASILY LOADED BY OTHER TARBELL INPUT ROUTINES.
;TAPE FILES ARE NAMED AND SPACE IS PROVIDED FOR EXTENSIVE COMMENTS.
;
;            -- COMMAND FORMATS --
;
;        DISK TO TAPE
;    TAPELIB TAPE:=FILENAME.TYP  'OPTIONAL DESCRIPTION OR COMMENTS'
;    TAPELIB TAPE:=A:FILENAME.TYP    BLOCK
;    TAPELIB TAPE:=B:FILENAME.TYP       NODISPLAY
;
;        TAPE TO DISK
;    TAPELIB DISK:=FILENAME.TYP
;    TAPELIB A:=FILENAME.TYP
;    TAPELIB B:=FILENAME.TYP
;
;
;        EXECUTE FILE
;    TAPELIB RUN:=FILENAME.COM
;
;        WRITE SYNC
;    TAPELIB TAPE:=SYNC
;
;
;    TAPELIB MAY ALSO BE LOADED LIKE PIP, BY SIMPLY TYPING TAPELIB.
;THE PROGRAM WILL LOAD, PRINT A TITLE THEN A * PROMPT. THE COMMANDS
;GIVEN ABOVE MAY THEN BE ENTERED WITHOUT THE WORD TAPELIB.
;
;   FILES MAY BE RENAMED OR SIMPLY VERIFIED (NO ACTUAL TRANSFER) DURING
;ALL TAPE TO DISK OPERATIONS. A COM FILE MAY ALSO BE RUN FROM TAPE
;WITHOUT FIRST LOADING IT TO DISK. THE SYNC OPTION WRITES 65K OF SYNC
;BYTES ON THE TAPE.
;
;    TAPELIB DISK:=FILENAME.TYP   RENAME NEW.NAM
;    TAPELIB DISK:=FILENAME.TYP    VERIFY
;    TAPELIB DISK:=FILENAME.COM      RUN   NODISPLAY

;  (RENAME,VERIFY,RUN AND THE FILE NAME ARE FREE FORMAT AND MAY BE
;ANYWHERE IN THE COMMENT FIELD). A FILE MUST BE TYPE COM TO BE RUN.
;NODISPLAY IN THE COMMENT FIELD TURNS OFF THE DISPLAY OF THE FILE ON
;THE TERMINAL DURING TRANSFER OPERATIONS.
;
;    A TOTAL OF 128 BYTES ARE AVAILABLE FOR THE COMMAND AND COMMENTS.
;WHEN COPYING TAPE TO DISK COMMENTS ARE OMITTED. DURING ALL TAPE TRANSFER
;OPERATIONS THE CONTENTS OF THE FILE ARE DISPLAYED ON THE CONSOLE. NON
;DISPLAYABLE CHARACTERS DISPLAY AS PERIODS. THE NAMES AND COMMENTS OF
;THE FILES SKIPPED OVER ARE DISPLAYED DURING THE SEARCH. NORMALLY
;FILES ARE NOT BLOCKED ON TAPE BUT READ INTO MEMORY IN THEIR ENTIRETY.
;IF A FILE WILL NOT FIT IN MEMORY IT WILL BE WRITTEN OUT IN 1K BLOCKS.
;
;    FILES ARE DISPLAYED ON THE CONSOLE FOR VERIFICATION DURING
;ALL TRANSFER OPERATIONS. NON DISPLAYABLE CHARACTERS DISPLAY AS PERIODS.
;THE CONSOLE DEVICE MUST BE CAPABLE OF OPERATING AT A MINIMUM OF
;4800 BAUD OR ERRORS WILL OCCUR. THE DISPLAY FEATURE MUST BE DISABLED
;IF SLOW TERMINALS ARE USED.
;
;            -- TAPE FORMAT--
;
;    1. START BYTES        03CH  (600)
;    2. SYNC BYTE        06EH
;    3. DECODE BYTE        0FFH  CONTROLS DISPLAY
;    4. TYPE BYTE        0 1 OR 2
;    5. LENGTH BYTE        THE NUMBER OF 256 BYTE RECORDS
;    6. NAME            CP/M NAME 11 BYTES  (NAME....TYP)
;    7. COMMENT        110 BYTES PROVIDED, BLANK (20H) IF NOT ENTERED
;    8. DATA            MULTIPLES OF 256 BYTE RECORDS
;    9. CHECKSUM        ONE BYTE TARBELL CHECKSUM
;
;    A STRING OF 600 START BYTES PROVIDES AT LEAST 3 SEC OF 'LEADER'
;BETWEEN RECORDS ON THE TAPE. ALL THE MEMORY BETWEEN THE END OF THE
;PROGRAM AND THE OPERATING SYSTEM, IS USED AS A FILE BUFFER. IF A
;FILE IS TOO LARGE TO FIT IN THE AVAILABLE MEMORY, IT WILL BE
;WRITTEN ON TAPE IN 1K BLOCKS DURING DISK TO TAPE TRANSFERS.
;READING AND WRITING BLOCKED TAPES TAKES ABOUT TWICE AS LONG AS READING
;OR WRITING UNBLOCKED TAPES. PROGRAMS MAY NOT BE RUN DIRECTLY FROM
;BLOCKED TAPES. ENTERING THE WORD 'BLOCK' IN THE DESCRIPTION FIELD
;OF A DISK TO TAPE COMMAND WILL FORCE BLOCKING OF ALL FILES THAT
;WILL NOT FIT IN A 16K CP/M SYSTEM.
;
;
;    THE PROGRAM WAS ASSEMBLED USING A Z-80 MACRO ASSEMBLY PROGRAM,
;HOWEVER ONLY 8080 INSTRUCTIONS WERE USED SO THE PROGRAM WILL
;RUN ON EITHER AN 8080 OR Z-80 BASED PROCESSOR.
;
    .XLIST
;
    ;    --------  MACROS   -------
;
;
;   1.   FILL - FILL A BLOCK OF MEMORY WITH A CONSTANT MAX 64K
;
    .DEFINE FILL [START,END,CONST(0)] = [
    LXI    H,START        ;;SET START ADDR
    .IFB    [END],[
    XRA    A
    MOV    M,A]        ;;STORE ONE BYTE IF NO END
    .IFNB    [END],[
    LXI    D,END-START+1    ;;SET LENGTH
    MVI    A,CONST        ;;LOAD CONSTANT IN A
    MOV    M,A        ;;STORE THE CONST
    INX    H        ;;INCR H
    DCX    D        ;;DECR LENGTH
    MOV    A,D
    ORA    E        ;;TEST LENGTH = ZERO
    JNZ    .-7]]        ;;REPEAT IF DE AND HL NOT EQUAL
;
;   1.5  FILLI - FILL INDIRECT A BLOCK OF MEMORY WITH A CONSTANT
;
    .DEFINE FILLI [START,END,CONST(0),%FI] = [
    LHLD    START        ;;START 
ADDR
    LXI    D,END+1        ;;END ADDR
%FI:    MVI    A,CONST        ;;CONSTANT TO A
    MOV    M,A        ;;STORE CONST IN MEMORY
    INX    H        ;;INCR POINTER
    CPHL            ;;COMPARE HL AND DE
    JNZ    %FI]        ;;REPEAT TILL ZERO
;
;  2.   CPHL - COMPARE DE AND HL AND SET FLAGS
;
    .DEFINE CPHL = [
    MOV    A,H
    CMP    D        ;;COMPARE HIGH BYTES
    JNZ    .+5
    MOV    A,L
    CMP    E]        ;;COMPARE LOW BYTES
;
;
;   3.  MOVE - MOVE A BLOCK OF LENGTH LEN FROM SOURCE TO DEST
;
    .DEFINE MOVE [SOURCE,DEST,LEN] = [
    LXI    D,SOURCE    ;SOURCE
    LXI    H,DEST        ;DEST
    LXI    B,LEN    ;LENGTH
    LDAX    D    ;GET A BYTE
    MOV    M,A    ;STORE IT
    INX    H
    INX    D    ;BUMP POINTERS
    DCX    B    ;DECR LENGTH COUNT
    MOV    A,B
    ORA    C
    JNZ    .-7]    ;TEST DONE?
;
;
;   4. MOVEI - MOVE INDIRECT BLOCK OF LENGTH LEN FROM SOURCE TO DEST
;
    .DEFINE    MOVEI [SOURCE,DEST,LEN] = [
    .IFDIF [DE] [SOURCE],[
    LHLD    SOURCE        ;SOURCE
    XCHG]
    .IFDIF [HL] [DEST],[
    LHLD    DEST]        ;DESTINATION
    .IFDIF [BC] [LEN],[
    LXI    B,LEN]        ;LENGTH
    LDAX    D        ;GET A BYTE
    MOV    M,A        ;STORE IT
    INX    H
    INX    D        ;BUMP POINTERS
    DCX    B        ;DECR LENGTH COUNT
    MOV    A,B
    ORA    C
    JNZ    .-7]        ;TEST DONE
;
;   5.  READTB - READ CHAR STRING INTO INPUT TEXT BUFFER
;
    .DEFINE READTB [TEXT,MAX(127)] = [
    MVI    C,10
    LXI    D,TEXT
    MVI    A,MAX
    STAX    D    ;SET MAXIMUM BUFFER LENGTH
    CALL    5]
;
;   6.  PRINTL - PRINT A LITERAL CHARACTER STRING ENCLOSED IN ' '
;
    .DEFINE    PRINTL [A$,%OUT] = [
    MVI    C,9
    LXI    D,.+9
    CALL    5
    JMP    %OUT
    .ASCII    'A$'
%OUT:]
;
;   7.  PRINT - PRINT TEXT FROM MEMORY TO CONSOLE
;
    .DEFINE PRINT [B$] = [
    MVI    C,9
    LXI    D,B$
    CALL    5]
;
;
;   7.5 DELMAK - DELETE AND MAKE A DISK FILE
;
    .DEFINE DELMAK [FCB] = [
    MVI    C,19        ;;DELETE CODE
    LXI    D,FCB
    CALL    5
    MVI    C,22        ;;MAKE CODE
    LXI    D,FCB
    CALL    5
    CPI    0FFH        ;;TEST FOR ERROR
    CMC]            ;;COMPLIMENT CARRY
;   8.  OPEN - OPEN DISK FILE
;
    .DEFINE OPEN [NAME] = [
    MVI    C,15
    LXI    D,NAME
    CALL    5
    CPI    0FFH    ;TEST FOR ERROR
    CMC        ;COMPLIMENT CARRY
    JNZ    .+4
    STC]
;
;
;   8.5 CLOSE - CLOSE A DISK FILE
;
    .DEFINE CLOSE [FCB] = [
    MVI    C,16        ;;CLOSE CODE
    LXI    D,FCB
    CALL    5
    CPI    0FFH        ;;TEST FOR ERROR
    CMC            ;;COMPLIMENT CARRY
    JNZ    .+4
    STC]
;
;
;   9.  READ - READ NEXT DISK FILE
;
    .DEFINE READ [FCB] = [
    MVI    C,20
    LXI    D,FCB
    CALL    5
    ORA    A
    JZ    .+4
    STC]            ;;SET CARRY ON EOF OR ERROR
;
;
;
;   9.5 WRITE - WRITE NEXT RECORD TO DISK
;
    .DEFINE WRITE [FCB] = [
    MVI    C,21        ;;WRITE CODE
    LXI    D,FCB
    CALL    5
    ORA    A        ;;SET FLAGS
    JZ    .+4
    STC]            ;;SET CARRY ON ERROR
;
;
;    SEARCH - SEARCH DIRECTORY FOR FIRST FCB THAT MATCHES NAME
;
    .DEFINE SEARCH [FCB] = [
    MVI    C,17        ;;SEARCH CODE
    LXI    D,FCB
    CALL    5
    CPI    0FFH        ;;FFH = NO MATCH
    CMC            ;;SET CARRY IF NO MATCH
]
;
;    SERNXT - SEARCH DIRECTORY FOR NEXT FCB MATCHING NAME
;
    .DEFINE SERNXT [FCB] = [
    LXI    D,FCB        ;;NAME OF FILE TO SEARCH FOR
    MVI    C,18        ;;SEARCH NEXT CODE
    CALL    5
    CPI    0FFH        ;;0FFH = NO MATCH
    CMC            ;;SET CARRY IF NO MATCH
]

;   66.  DELETE - DELETE A DISK FILE
;
    .DEFINE DELETE [FCB] = [
    MVI    C,19
    LXI    D,FCB
    CALL    5]
;

;
;  10.  CONIN [$S] - CONSOLE INPUT TO A
;
    .DEFINE CONIN [$S] = [
    .IFIDN [$S] [SR], [
        PUSH    H
        PUSH    D
        PUSH    B]
    MVI    C,1
    CALL    5
    .IFIDN [$S] [SR],[
        POP    B
        POP    D
        POP    H]
    ]        ;END MACRO
;
;
;  11.  CONOUT - CONSOLE OUTPUT FROM A
;
    .DEFINE CONOUT [$S] = [
    .IFIDN [$S] [SR],[
    PUSH    H
    PUSH    D
    PUSH    B]
    MOV    E,A
    MVI    C,2
    CALL    5
    .IFIDN [$S] [SR],[
    POP    B
    POP    D
    POP    H]
]        ;END MACRO
;
;  12.  INDEX - INDEX AN ADDRESS POINTER BY A CONSTANT
;
    .DEFINE INDEX [POINTER,INDX] = [
    LHLD    POINTER
    LXI    D,INDX
    DAD    D
    SHLD    POINTER]
;  13.  FILFCB - FILL IN ID FIELDS OF FCB (FILE NAME ENDED BY ZERO BYTE)
;        ON EXIT - CARRY SET IF NAME TOO LONG
;            - HL POINTS TO NEXT BYTE AFTER NAME

;
    .DEFINE FILFCB [FCB,IDSTR,%ERROR,%DONE] = [
    LHLD    IDSTR        ;;POINTER TO NAME STRING
    XCHG
    LXI    H,FCB        ;;ADDR OF FILE CONTROL BLOCK
    .IFN $FCBSW,[
    CALL    FFCB]
    .IFE $FCBSW,[
    CALL    FFCB
$FCBSW    =    1        ;;SET CONDITIONAL ASSEMBLY SWITCH
    JMP    ENDFCB
FFCB:    MVI    M,0        ;CLEAR FIRST BYTE OF FCB
    INX    H
    PUSH    H        ;;SAVE FCB NAME ADDR
    MVI    C,11        ;;SIZE OF NAME
    MVI    A,' '        ;;SPACE TO A
    MOV    M,A        ;;SET NAME FIELD TO SPACES
    INX    H
    DCR    C
    JNZ    .-3
    POP    H        ;;RECOVER NAME ADDR
    MVI    C,8        ;;MAXIMUM SIZE OF NAME+1
    LDAX    D        ;;GET ID BYTE
    CPI    ' '        ;;LEADING SPACES ?
    JNZ    .+7        ;;CONTINUE IF NOT
    INX    D        ;;SKIP LEADING SPACES
    JMP    .-7
    LDAX    D        ;;GET ID BYTE
    CPI    0        ;;IS IT A ZERO BYTE
    JZ    %DONE        ;;YES DONE
    CPI    ' '        ;;IMBEDDED SPACE?
    JZ    %DONE        ;;YES DONE
    CPI    '.'        ;;NAME.TYP SEPARATOR?
    JZ    .+13        ;;YES, PROCESS TYPE
    MOV    M,A        ;;STORE NAME BYTE
    INX    D
    INX    H        ;BUMP POINTERS
    DCR    C        ;DECREMENT MAX COUNT
    JP    .-20        ;LOOP
    JMP    %ERROR        ;ERROR, NAME TOO BIG
    INX    D        ;SKIP OVER '.'
    MOV    A,C
    ORA    A
    JZ    .+8
    INX    H        ;;SKIP TO TYPE FIELD
    DCR    C
    JNZ    .-2
    MVI    C,3        ;;SIZE OF TYPE FIELD
    LDAX    D        ;;GET ID BYTE
    CPI    0        ;;ZERO BYTE?
    JZ    %DONE        ;;YES, DONE
    CPI    ' '        ;;SPACE?
    JZ    %DONE        ;;YES, DONE
    MOV    M,A        ;;STORE TYPE BYTE
    INX    D        ;;BUMP POINTERS
    INX    H
    DCR    C        ;;DECREMENT MAX COUNT
    JNZ    .-15        ;;LOOP
    JMP    %DONE        ;;DONE


%ERROR:    STC            ;;SET CARRY
%DONE:    XCHG            ;;POINTER TO END OF NAME
    RET
ENDFCB:]]            ;;END MACRO

;
;  14.  $INSTR - IN STRING FUNCTION SEARCHES STRING OF LEN LSRT FOR SUBSTRING
;        RETURNS WITH CARRY SET IF MATCH AND HL POINTING TO END SUBSTR
;
    .DEFINE $INSTR [STRING,LSTR,SUBSTRING,%STR,%OVER] = [
    LHLD    STRING        ;;GET STRING ADDR
    MVI    B,LSTR        ;;STRING LENGTH
    .IFN    $STRSW,[
    LXI    D,%STR
    MVI    C,%OVER-%STR
    CALL    FSTR
    JMP    %OVER
%STR:    .ASCII    'SUBSTRING'
%OVER:]
    .IFE    $STRSW,[
    LXI    D,%STR
    MVI    C,%OVER-%STR
    CALL    FSTR
    JMP    %END
%STR:    .ASCII    'SUBSTRING'
%OVER:
    $STRSW = 1
FSTR:    MOV    A,B        ;;STRING LEN
    SUB    C        ;;SUBSTR LEN
    CMC
    JM    .+21        ;;SUBSTR LONGER THAN STRING
    MOV    B,A        ;;STRING LENGTH-SUBSTRING LENGTH
INSTR1:    PUSH    H
    PUSH    D
    PUSH    B
    DCR    C        ;;DECR LENGTH COUNT
    JM    .+17        ;;EXIT MATCH FOUND
    LDAX    D        ;;GET A BYTE FROM FIRST STRING
    CMP    M        ;;CONPARE WITH SECOND STRING
    JNZ    .+8        ;;EXIT NO MATCH
    INX    H
    INX    D        ;;INCR ADDR POINTERS
    JMP    .-11        ;;TRY AGAIN
    XRA    A        ;;CLEAR CARRY
    JMP    .+4        ;;EXIT
    STC            ;;SET CARRY
    POP    B
    POP    D
    POP    H
    JC    SSX        ;;MATCH FOUND SET POINTER AND RET
    DCR    B        ;;DECR STRING LEN
    RM            ;;RETURN IF MINUS - NO MATCH
    INX    H        ;;INCR STRING POINTER
    JMP    INSTR1        ;;GO TRY SOME MORE
    RET
SSX:    LXI    D,0
    MOV    E,C
    DAD    D        ;;ADD LENGTH TO POINTER
    STC            ;;SET CARRY
    RET
%END:]]
;
;
;  15.  $MATCH - COMPARE STRING WITH LITERAL AND SET CARRY IF EQUAL
;
    .DEFINE $MATCH [STR1,STR2,%STR,%OVER] = [
    LXI    H,STR1
    .IFN    $MATSW,[
    LXI    D,%STR
    MVI    C,%OVER-%STR
    CALL    SMATCH
    JMP    %OVER
%STR:    .ASCII    'STR2'
%OVER:]
    .IFE    $MATSW,[
    LXI    D,%STR
    MVI    C,%OVER-%STR
    CALL    SMATCH
    JMP    MATEND
%STR:    .ASCII    'STR2'
%OVER:
$MATSW    =    1        ;;CONDITIONAL ASSEMBLY SWITCH
SMATCH:    DCR    C        ;;DECR LENGTH COUNT
    JM    SM3        ;;EXIT MATCH FOUND
    LDAX    D        ;;GET A BYTE FROM FIRST STRING
    CMP    M        ;;COMPARE WITH SECOND STRING
    JNZ    SM2        ;;EXIT, NO MATCH
    INX    H
    INX    D        ;;INCR ADDR POINTERS
    JMP    SMATCH        ;;TRY AGAIN
SM2:    XRA    A        ;;CLEAR CARRY
    JMP    .+4        ;;EXIT
SM3:    STC            ;;SET CARRY
    RET
MATEND:]]
;
;
;   17.  IMATCH - COMPARE INDIRECT STRINGS OF EQUAL LENGTH SET CARRY IF =
;
    .DEFINE IMATCH [STR1,STR2,LEN] = [
    LXI    D,STR1        ;;ONE STRING
    .IFDIF    [STR2][HL],[
    LXI    H,STR2]        ;;THE OTHER
    MVI    C,LEN        ;;LENGTH
    DCR    C        ;;DECR LENGTH COUNT
    JM    .+17        ;;MATCH FOUND EXIT
    LDAX    D        ;;BYTE FROM ONE STRING
    CMP    M        ;;COMPARE WITH OTHER STRING
    JNZ    .+8        ;;NO MATCH EXIT
    INX    H
    INX    D        ;;INCR POINTERS
    JMP    .-11        ;;TRY AGAIN
    XRA    A        ;;CLEAR CARRY
    JMP    .+4        ;;EXIT
    STC]            ;;SET CARRY ON MATCH
;
;

;   18. GETDRV - INTERROGATE AND SAVE CURRENTLY LOGGED DISK NO
;
    .DEFINE GETDRV [SAVE] = [
    MVI    C,25
    CALL    5
    STA    SAVE]
;
;
;
;   19. SETDRV - SET DISK DRIVE NUMBER
;
    .DEFINE SETDRV [X] = [
    MVI    C,14
    LXI    D,X
    CALL    5]
;
;
;   20. RESDRV - RESTORE SAVED DISK DRIVE NUMBER
;
    .DEFINE RESDRV [SAVE] = [
    MVI    C,14
    LDA    SAVE
    MOV    E,A
    CALL    5]
;
;
    .LIST
    .PABS
    .SALL
    .XSYM
    .LOC    100H        ;SET ORIGIN AT 100
;
;SET CONDITIONAL ASSEMBLY SWITCHES
;
$FCBSW    =    0
$MATSW    =    0
$STRSW    =    0
    LXI    SP,NEWSTK    ;SET UP NEW STACK
    LHLD    6        ;TOP OF MEMORY
    LXI    D,-128
    DAD    D        ;SUBTRACT 128 FOR LAST BLOCK
    LXI    D,5000H        ;MEMORY LIMIT
    CPHL            ;COMPARE DE - HL
    JC    STEND
    XCHG
STEND:    SHLD    MEMEND        ;SET END OF MEMORY
    GETDRV    DRVNO        ;SAVE CURRENTLY LOGGED DISK DRIVE NO
    STA    NEWDRV        ;SAVE IT IN NEWDRV TOO
    LDA    80H        ;BUFFER ALREADY FILLED?
    ORA    A
    JNZ    START
    PRINT    CRLF
    PRINTL    'TAPELIB UTILITY VERS 1.1$'
    PRINT    CRLF
    PRINTL    'COPYRIGHT 1977 BY S. J. SINGER$'
NEWIN:    PRINT    CRLF2
    PRINTL    '*$'
    MVI    A,0FFH        ;SET SWITCH TO RETURN HERE AGAIN
    STA    INFLAG
    FILL    80H,0FFH    ;ZERO INPUT BUFFER
    READTB    80H        ;READ TEXT INTO BUFFER
    LDA    81H        ;POINTS TO END OF INPUT
    INR    A
    STA    80H        ;MOVE IT TO 80H
    XRA    A
    STA    DISFLG        ;TURN OFF DISPLAY
    STA    DFLAG1
    STA    VERFLG        ;RESET VERIFY FLAG
    STA    AMBIG        ;RESET AMBIGUOUS FILE NAME FLAG
    STA    FAMBIG        ;RESET FIRST AMBIGUOUS FILE FLAG
    MVI    A,65
    STA    BCOUNT        ;RESET DISPLAY CHAR PER LINE
    MVI    A,88H
    STA    SLOC1        ;RESET FILE NAME POINTER
START:    FILL    FCB,FCB+32    ;ZERO ALL FIELDS OF FCB
    $INSTR    IPOINT,120,'BLOCK'    ;BLOCK TAPE ?
    JNC    NODIS
    LXI    H,3000H
    SHLD    MEMEND        ;SET MEMORY LIMIT
NODIS:    $INSTR    IPOINT,120,'NODISPLAY'    ;TURN OFF DISPLAY ?
    JNC    MAT1
    MVI    A,0FFH
    STA    DFLAG1        ;TURN OFF DISPLAY FOR SLOW TERMINALS
MAT1:    $MATCH    82H,'TAPE:='
    JC    DT1
    $MATCH    82H,'DISK:='
    JC    TDISK
    $MATCH    82H,'A:='
    JC    ADISK
    $MATCH    82H,'B:='
    JC    BDISK
    $MATCH    82H,'RUN:='
    JC    RUNFIL        ;GO TO EXEC FILE IF TYPE COM
INERR:    PRINT    CRLF
    PRINTL    'ERROR - NO SUCH DESTINATION$'
    JMP    MOREIN    ;ERROR IN INPUT COMMAND STRING EXIT
;
;    SELECT DISK DRIVE
;
DT1:    $MATCH    88H,'SYNC'    ;TEST FOR WRITE SYNC STREAM
    JC    SYNC
    $MATCH    88H,'A:'    ;DRIVE A
    JNC    DT2
    XRA    A        ;0 - DRIVE A
    STA    NEWDRV
    JMP    DOWN
DT2:    $MATCH    88H,'B:'    ;DRIVE B
    JNC    DTAPE
    MVI    A,1        ;1 - DRIVE B
    STA    NEWDRV
DOWN:    MOVE    84H,82H,120    ;SHIFT BUFFER DOWN TWO BYTES
    LXI    H,80H        ;POINTS TO LENGTH OF COMMENT
    DCR    M
    DCR    M        ;DECR LENGTH BY 2
;
;  DTAPE - START OF DISK TO TAPE ROUTINE
;
DTAPE:    FILFCB    FCB,SLOC1    ;FILL IN FCB FROM INPUT BUFFER
    JC    NAMERR        ;ERROR IN NAME PRINT ERROR MESSAGE
    PUSH    H        ;POINTER TO START OF COMMENT
    FILL    FILBUF,FILBUF+128,20H   ;BLANK COMMENT FIELD OF FILE
    LDA    80H        ;POINTS TO LENGTH OF COMMENT
    ADI    81H
    LXI    H,0        ;ZERO HL
    MOV    L,A        ;HL POINTS TO END OF COMMENT
    POP    D        ;POINTS TO START OF COMMENT
    LXI    B,FILBUF+11    ;POINTS TO OUTPUT BUFFER
MOVCOM:    CPHL            ;FINISHED MOVE ?
    JZ    ENDMOV
    LDAX    D        ;GET BYTE OF COMMENT
    STAX    B        ;STORE IT
    INX    D
    INX    B
    JNZ    MOVCOM        ;LOOP BACK
ENDMOV:    CALL    SCANFCB        ;CHECK FOR AMBIGUOUS FILE NAME
    JNC    DTAPE1
    MOVE    FCB,AMBNAM,12    ;SAVE AMBIGUOUS FILE NAME
    MVI    A,0FFH
    STA    AMBIG        ;SET AMBIGUOUS NAME FLAG
    RESDRV    NEWDRV        ;SELECT NEW DRIVE IF ANY
    CALL    GETNAM
DAM:    LXI    D,FCB        ;POINT TO FCB
    MVI    C,12        ;LENGTH
MNAM:    MOV    A,M
    STAX    D
    INX    H
    INX    D
    DCR    C
    JNZ    MNAM        ;MOVE NAME
    FILL    FCB+12,FCB+8    ;ZERO REST OF FCB
DTAPE1:    MOVE    FCB+1,FILBUF,11    ;MOVE NAME TO OUTPUT BUFFER
    RESDRV    NEWDRV        ;SELECT NEW DRIVE
    OPEN    FCB
    JNC    LDFIL
OPNERR:    PRINT    CRLF
    LDA    NEWDRV
    ORA    A
    JNZ    OER1
    PRINTL    'NO FILE BY THAT NAME ON DRIVE A$'
    JMP    MOREIN
OER1:    PRINTL    'NO FILE BY THAT NAME ON DRIVE B$'
    JMP    MOREIN
LDFIL:    LXI    H,FILBUF+128    ;SET DISK FILE BUFFER POINTER
    SHLD    BPOINT
    LXI    H,80H
    SHLD    IPOINT        ;RESET INPUT BUFFER POINTER TO 80H
    LXI    H,0
    SHLD    NBLOCKS        ;INITIALIZE BLOCK COUNT TO ZERO
LD1:    READ    FCB        ;READ A RECORD FROM DISK
    JC    ENDFIL        ;EXIT IF ERROR OR EOF
    MOVEI    IPOINT,BPOINT,128    ;MOVE BLOCK TO BUFFER
    INDEX    NBLOCKS,1    ;INDEX BLOCK COUNT BY ONE
    INDEX    BPOINT,128    ;INDEX BUFFER POINTER BY 128
    XCHG
    LHLD    MEMEND        ;TEST FOR MEMORY OVERFLOW
    CPHL            ;COMPARE DE AND HL
    JNC    LD1        ;BACK TO READ LOOP
MEMFUL:    PRINT    CRLF2
    PRINTL    'BLOCKED TAPE REQUESTED OR$'
    PRINT    CRLF
    PRINTL    'FILE TOO LARGE FOR MEMORY$'
    PRINT    CRLF
    PRINTL    'WRITING BLOCKED OUTPUT TAPE$'
    LDA    FAMBIG
    ORA    A
    JNZ    GOBLK        ;DISPLAY MESS ONLY FOR FIRST BLK
    MVI    A,-1
    STA    FAMBIG        ;START TAPE DISPLAY OFF
    CALL    STARTW        ;DISPLAY START MESSAGE
GOBLK:    PRINT    CRLF2
    MOVE    FILBUF,FILBUF+1280,128    ;SAVE COMMENT FIELD
    JMP    BLKOUT        ;WRITE BLOCKED OUTPUT TAPE
ENDFIL:    CPI    1        ;TEST FOR EOF
    JZ    TAPE
RDERR:    PRINT    CRLF
    PRINTL    'DISK READ ERROR$'
    JMP    MOREIN        ;EXIT
TAPE:    LHLD    NBLOCKS        ;GET NO OF 128 BYTE BLOCKS READ
    INX    H
    INX    H        ;ADD 2 FOR ROUNDING
    MOV    A,H        ;SHIFT RIGHT 1 BIT DOUBLE
    RAR
    MOV    A,L
    RAR
    PUSH    PSW        ;STACK HAS NO OF 256 BYTE BLOCKS
    JC    PM1        ;CARRY SET, PRINT MESSAGE
    LHLD    BPOINT        ;NOT SET, FILL LAST 128 BYTES WITH ^Z
    PUSH    H
    INDEX    BPOINT,128
    XCHG            ;END OF BLOCK IN D
    LHLD    MEMEND        ;TOP OF MEMORY
    CPHL
    JC    MEMFUL        ;MEMORY FILLED PRINT ERROR MESSAGE
    POP    H        ;BEGINING OF BLOCK IN HL
LF1:    MVI    A,1AH        ;CONTROL Z
    MOV    M,A        ;STORE IT IN MEMORY
    INX    H
    CPHL            ;LIMIT REACHED
    JNZ    LF1
PM1:    LDA    FAMBIG
    ORA    A
    JNZ    PMX        ;NO START MESSAGE
    CALL    STARTW        ;DISPLAY MESSAGE
    MVI    A,0FFH
    STA    FAMBIG        ;SET SWITCH FOR DISPLAY OFF
PMX:    CALL    WRID        ;WRITE AN ID BLOCK ON TAPE
    POP    B        ;NO OF 256 BYTE BLOCKS IN B
    LXI    H,FILBUF
    MVI    C,1        ;RECORD TYPE
    CALL    TAPOUT        ;WRITE THE RECORD
PMY:    LDA    AMBIG        ;AMBIGUOUS NAME FLAG
    ORA    A
    JZ    PM2        ;NOT SET THEN EXIT
    CALL    GETNAM        ;SEARCH DIR WITH PREVIOUS NAME
    MOVE    AMBNAM,FCB,12    ;AMBIG NAME FOR NEXT SEARCH
    CALL    GETNEXT        ;SEARCH DIR FOR NEXT NAME
    JC    PM2        ;EXIT IF NO MORE NAMES
    PUSH    H
    PRINT    CRLF2        ;SPACE AND RING BELL
    POP    H
    JMP    DAM        ;WRITE THE FILE ON TAPE
PM2:    CALL    STOP        ;DISPLAY STOP MESSAGE
    JMP    MOREIN        ;EXIT
;
;    THIS ROUTINE WRITES BLOCKED OUTPUT TAPES FOR FILES
;    TOO LARGE FOR MEMORY
;
BLKOUT:    CLOSE    FCB
    FILL    FCB+12,FCB+8,0
    FILL    FILBUF+128,FILBUF+1024,1AH
    OPEN    FCB        ;POSITION FILE TO FIRST RECORD
    LXI    H,FILBUF+128
    SHLD    BPOINT
    LXI    H,80H
    SHLD    IPOINT        ;RESET DATA TRANSFER POINTERS
    MVI    A,0FFH
    STA    FIRST        ;INDICATE FIRST RECORD
    MVI    A,15
    STA    BLKBLK        ;RESET BLOCK COUNTER
RBEG:    MVI    A,1
    STA    BLOCK        ;SET BLOCK COUNT TO 1
RLOOP:    READ    FCB        ;READ A RECORD FROM DISK
    JC    FEND        ;CARRY SET ON EOF OR ERROR
    MOVEI    IPOINT,BPOINT,128    ;MOVE BLOCK
    LDA    BLOCK
    CPI    8
    JZ    TAPWRT        ;IF 8 RECORDS WRITE TAPE
    INR    A
    STA    BLOCK        ;INCR BLOCK COUNT
    INDEX    BPOINT,128    ;INCR  ADDR BY 128
    JMP    RLOOP
FEND:    CPI    1
    JNZ    RDERR        ;DISK READ ERROR
    MVI    C,2        ;TYPE
    XRA    A        ;CLEAR CARRY
    LDA    BLOCK        ;BLOCK COUNT
    INR    A
    RAR            ;NO OF 256 BYTE BLOCKS
    MOV    B,A        ;STORE IN B
    LXI    H,FILBUF    ;BUFFER POINTER
    CALL    WRSPAC        ;WRITE SPACER BLOCK
    CALL    TAPOUT
    MOVE    FILBUF+1280,FILBUF,128    ;RESTORE COMMENT FIELD
    JMP    PMY        ;PRINT MESSAGE AND EXIT
TAPWRT:    LDA    FIRST
    ORA    A        ;IS THIS THE FIRST RECORD
    JNZ    BLK1        ;YES, WRITE IT WITH HEADER
    MVI    C,1
    MVI    B,4        ;BLOCK COUNT
BLKN:    LXI    H,FILBUF    ;BUFFER POINTER
    CALL    WRSPAC        ;WRITE SPACER BLOCK
    CALL    TAPOUT        ;WRITE TAPE
    FILL    FILBUF,FILBUF+1024,1AH
    LXI    H,FILBUF
    SHLD    BPOINT
    JMP    RBEG        ;BACK FOR MORE DISK INPUT
BLK1:    CALL    WRID        ;WRITE FILE HEADER
    MVI    C,0        ;FIRST BLOCK TYPE 0
    MVI    B,5        ;5 BLOCKS WITH HEADER
    XRA    A
    STA    FIRST        ;NOT FIRST
    JMP    BLKN        ;BACK TO OUTPUT
;
;
;    RUN TAPE FILE
;
RUNFIL:    LXI    H,87H
    SHLD    SLOC1        ;POINTER TO FILE NAME
    MVI    A,0FFH
    STA    RUNFLG        ;SET RUN FLAG TRUE
    JMP    TDISK
;
;    SELECT DISK DRIVE
;
ADISK:    XRA    A        ;0 - DRIVE A
    STA    NEWDRV
    JMP    BD1
BDISK:    MVI    A,1        ;1 - DRIVE B
    STA    NEWDRV
BD1:    LXI    H,85H
    SHLD    SLOC1        ;POINTER TO NAME
;
;  TDISK - START OF TAPE TO DISK ROUTINE
;
TDISK:    FILFCB    FCB,SLOC1    ;FILL IN FCB FROM INPUT BUFFER
    JC    NAMERR        ;FILE NAME ERROR PRINT MESS
    CALL    SCANFCB        ;CONVERT * TO ? IN AMBIG FILE NAMES
    JNC    TDISK1
    MVI    A,-1
    STA    AMBIG        ;SET AMBIGUOUS NAME FLAG
    MOVE    FCB,AMBNAM,12    ;SAVE AMBIG NAME
TDISK1:    MOVE    80H,FILBUF,128    ;SAVE NAME AND COMMENT, RESDRV MAY USE BUFFER
    RESDRV    NEWDRV        ;LOAD NEW DRIVE NO IF SELECTED
    MOVE    FILBUF,80H,128    ;RESTORE NAME AND COMMENT
    PRINT    CRLF2
    PRINTL    'START CASSETTE TAPE - TYPE CARRIAGE RETURN$'
    PRINT    CRLF2
    CONIN            ;WAIT FOR CONSOLE INPUT
    CPI    3        ;CONTROL C ?
    JZ    MOREIN        ;RETURN TO MONITOR
    JMP    TAPIN        ;TO TAPE INPUT ROUTINE
;
;   CASW - CASSETTE OUTPUT ROUTINE  (DATA IN A)
;
CASW:    PUSH    H        ;SAVE REGS
    PUSH    D
    PUSH    B
    PUSH    PSW
    CALL    ESCAPE        ;CHECK FOR CONTROL C
CAS1:    IN    CASC        ;GET STATUS
    ANI    20H
    JNZ    CAS1        ;WAIT FOR STATUS READY
    POP    PSW        ;DATA BACK TO A
    PUSH    PSW        ;SAVE IT AGAIN
    OUT    CASD        ;WRITE BYTE TO TAPE
    OUT    0FFH        ;OUT TO LIGHTS
    LXI    H,CKSUM        ;MEMORY ADDR OF CHECKSUM
    ADD    M        ;ADD TO A
    STA    CKSUM        ;STORE IT BACK
    POP    PSW        ;GET BACK DATA
    CALL    DISPLY        ;OUTPUT TO CONSOLE
    POP    B        ;RESTORE REGISTERS
    POP    D
    POP    H
    RET
CASC    ==    6EH        ;CASSETTE STATUS PORT
CASD    ==    6FH        ;CASSETTE DATA   PORT
;
CASR:    PUSH    H        ;SAVE REGISTERS
    PUSH    D
    PUSH    B
ETEST:    CALL    ESCAPE        ;CHECK FOR CONTROL C
READCT:    IN    CASC        ;READ CASSETTE STATUS
    ANI    10H        ;CHECK BIT 4
    JNZ    ETEST        ;WAIT TILL READY
    IN    CASD        ;READ CASSETTE DATA
    PUSH    PSW        ;SAVE IT
    OUT    0FFH        ;OUT TO LIGHTS
    LXI    H,CKSUM        ;POINTER TO CKSUM
    ADD    M        ;ADD IT TO DATA
    STA    CKSUM        ;STORE IT BACK
    POP    PSW        ;GET BACK DATA
    PUSH    PSW        ;SAVE IT AGAIN
    CALL    DISPLY        ;OUT TO CONSOLE
    POP    PSW        ;GET BACK DATA
    POP    B
    POP    D
    POP    H        ;RESTORE REGISTERS
    RET
;  ESCAPE - TEST FOR CONTROL C AND RETURN TO MONITOR
;
ESCAPE:    MVI    C,11
    CALL    5
    ANI    1
    RZ            ;RETURN IF LOW BIT NOT SET
    CONIN
    CPI    3        ;TEST FOR ^C
    JZ    MOREIN        ;EXIT TO MONITOR OR BACK TO INPUT
    RET
;
;
;   DISPLY - OUTPUT A TO CONSOLE AND SUBSTITUTE . FOR ^ CHARACTERS
;
DISPLY:    PUSH    PSW        ;SAVE DATA
    LDA    DISFLG        ;DISPLAY FLAG
    ORA    A
    JZ    YSKIP        ;OUT IF ZERO
    LDA    DFLAG1
    ORA    A        ;DISPLAY OFF FOR SLOW TERMINALS
    JNZ    YSKIP        ;OUT IF NOT ZERO
    LDA    BCOUNT        ;COUNT OF BYTES PER LINE
    DCR    A        ;DECR BY ONE
    STA    BCOUNT        ;STORE IT BACK
    JNZ    USKIP        ;CONTINUE IF NOT END OF LINE
    PRINT    CRLF
    MVI    A,64        ;CHAR PER LINE
    STA    BCOUNT        ;RESET COUNTER
USKIP:    POP    PSW        ;GET BACK DATA
    CPI    7FH        ;COMPARE WITH RUBOUT
    JP    VSKIP        ;PRINT PERIOD
    CPI    20H        ;COMPARE WITH SPACE
    JP    XSKIP        ;SKIP SUBSTITUTION
VSKIP:    MVI    A,2EH        ;ASCII PERIOD
XSKIP:    CONOUT            ;OUT TO CONSOLE
    RET
YSKIP:    POP    PSW
    RET
;   NAME ERROR IN FILE NAME - PRINT ERROR MESSAGE
;
NAMERR:    PRINT    CRLF
    PRINTL    'ERROR IN FILE NAME$'
    JMP    MOREIN        ;EXIT BACK TO MONITOR
;
;
;
;   TAPEOUT - OUTPUT BLOCK OF TAPE IN TARBELL FORMAT
;
TAPOUT:    PUSH    H        ;SAVE POINTER
    LXI    H,BLKBLK    ;POINT TO BLOCK COUNT
    INR    M        ;INCR BY ONE
    MVI    A,16        ;BLOCK LIM 1
    CMP    M
    JZ    T0        ;WRITE SPACER BLOCK
    INR    A
    CMP    M        ;IS COUNT 18
    JNZ    T1        ;NO EXTRA SPACE BLOCK
    MVI    M,1        ;SET BLOCK COUNT TO ONE
T0:    CALL    WRSPAC        ;WRITE SPACE BLOCK
    CALL    WRSPAC        ;WRITE SPACE BLOCK
T1:    POP    H        ;RESTORE POINTER
    MVI    A,3CH        ;START BYTE
    CALL    CASW        ;WRITE IT OUT
    MVI    A,0E6H        ;SYNC BYTE
    CALL    CASW        ;WRITE IT
    XRA    A
    STA    CKSUM        ;ZERO CHECKSUM
    MVI    A,0FFH        ;DECODE BYTE
    CALL    CASW        ;WRITE IT
    MOV    A,C        ;TYPE BYTE
    CALL    CASW        ;WRITE IT TO TAPE
    MOV    A,B        ;NO OF 256 BYTE BLOCKS
    CALL    CASW        ;WRITE IT OUT
    MVI    A,0FFH        ;SET DISPLAY FLAG
    STA    DISFLG
T2:    MVI    C,0        ;BLOCK LENGTH IN BYTES - 1
T3:    MOV    A,M        ;GET A BYTE FROM MEMORY
    CALL    CASW        ;WRITE IT TO CASSETTE
    INX    H
    DCR    C
    JNZ    T3        ;LOOP TILL END OF BLOCK
    DCR    B
    JNZ    T2        ;LOOP TILL ALL BLOCKS DONE
T4:    XRA    A
    STA    DISFLG        ;TURN OFF DISPLAY
    LDA    CKSUM
    CALL    CASW        ;WRITE CHECKSUM
    RET            ;BYE
;
;  TAPIN - TAPE INPUT ROUTINE
;
TAPIN:    XRA    A
    STA    DISFLG        ;TURN OFF DISPLAY
    CALL    RDID        ;SEARCH TAPE FOR ID BLOCK
    XRA    A        ;ZERO
    STA    CKSUM        ;ZERO CHECKSUM
    MVI    A,10H
    OUT    CASC        ;RESET RECEIVER
    CALL    CASR        ;READ DECODE BYTE
    CPI    0FFH        ;CHECK IT
    JNZ    TAPIN
    CALL    CASR        ;READ TYPE BYTE
    STA    TYPE        ;SAVE IT
    CPI    3        ;CHECK TYPE < 3
    JP    TAPIN
    CALL    CASR        ;READ LENGTH
    LXI    H,0
    MOV    L,A        ;NO OF 256 BYTE BLOCKS ON TAPE
    MOV    B,A        ;SAVE IT IN B
    DAD    H        ;SHIFT LEFT 1
    DCX    H        ;NUMBER OF 128 BYTE BLOCKS (FOR DISK)
    SHLD    NBLOCKS        ;STORE TO MEMORY
    MVI    A,0FFH        ;.TRUE.
    STA    DISFLG        ;TURN ON DISPLAY FLAG
    LXI    H,FILBUF    ;BUFFER POINTER
    LXI    D,1        ;BLOCK COUNT FOR NAME CHECK
RD1:    MVI    C,128        ;NO BYTES PER BLOCK - 1
RD2:    CALL    CASR        ;READ A BYTE
    MOV    M,A        ;STORE IT
    INX    H
    DCR    C        ;DECR LENGTH
    JNZ    RD2        ;LOOP BACK
    DCX    D
    MOV    A,D        ;DECR BLOCK COUNT FOR NAME CHECK
    ORA    E
    JZ    NAMCHK        ;COMPARE NAME FROM TAPE WITH FCB
GOON:    DCR    B        ;DECR NO OF BLOCKS
    MVI    C,0        ;NO OF BYTES PER BLOCK - 1
    JNZ    RD2        ;LOOP BACK
    SHLD    ENDF        ;SAVE LOCATION OF LAST BYTE READ
    LDA    CKSUM        ;GET CHECKSUM FROM MEMORY
    MOV    B,A        ;STORE IT TEMPORARILY IN B
    XRA    A        ;ZERO
    STA    DISFLG        ;TURN OFF DISPLAY
    CALL    CASR        ;READ CHECKSUM FROM TAPE
    SUB    B        ;COMPARE IT WITH MEMORY
    JNZ    TPERR        ;CHECKSUM ERROR
    LDA    AMBIG        ;CHECK AMBIG FLAG
    ORA    A
    JNZ    PCR2        ;TO DISK ROUTINE
    CALL    STOP        ;DISPLAY STOP MESSAGE
    JMP    WDISK        ;TO DISK WRITE ROUTINE
PCR2:    PRINT    CRLF2        ;CARRIAGE RET
    JMP    WDISK        ;TO DISK WRITE ROUTINE
;
TPERR:    PRINT    BELL
    PRINTL    'CHECKSUM ERROR$'
    PRINT    CRLF
    PRINTL    'TO RESTART - REWIND TAPE AND TYPE CARRIAGE RETURN$'
    PRINT    CRLF
    CONIN            ;READ CONSOLE
    CPI    3        ;CONTROL C ?
    JZ    MOREIN        ;RETURN TO MONITOR
    JMP    TAPIN        ;BACK TO TAPE INPUT ROUTINE
;
;
NAMCHK:    PUSH    H
    PUSH    D
    PUSH    B
    PRINT    CRLF
    LXI    H,FILBUF    ;SET POINTERS
    LXI    D,FCB+1
    MVI    C,11
NAMC1:    DCR    C
    JM    NAMC3        ;MATCH IF MINUS
    LDAX    D        ;GET BYTE OF FCB NAME
    CPI    '?'
    JNZ    NAMCY
    MOV    A,M        ;CHECK NAME FOR NON PRINTABLE CHAR
    CPI    20H
    JM    NAMC2
    CPI    7FH        ;DELETE CODE
    JP    NAMC2
    JMP    NAMCX
NAMCY:    CMP    M        ;COMPARE WITH FILE NAME
    JNZ    NAMC2
NAMCX:    INX    H
    INX    D
    JMP    NAMC1
NAMC2:    XRA    A        ;CLEAR CARRY
    JMP    ENDCK
NAMC3:    STC
ENDCK:    POP    B
    POP    D
    POP    H
    JC    TYPCHK        ;MATCH, CHECK TYPE
    JMP    TAPIN        ;NO MATCH SEARCH SOME MORE
TYPCHK:    LDA    TYPE        ;GET TYPE
    CPI    1        ;IS IT TYPE 1
    JZ    RD1        ;YES,UNBLOCKED RECORD
;
;    THIS ROUTINE READS BLOCKED TAPES
;
BLKIN:    PUSH    B        ;SAVE BLOCK COUNT
    MOVE    FILBUF,FCB+1,11    ;MOVE NAME INTO FCB
    XRA    A
    STA    FCB+32
    POP    B        ;RESTORE BLOCK COUNT
    LXI    H,FILBUF    ;POINTER TO BUFFER
    MVI    C,128        ;BYTES LEFT IN FIRST BLOCK
RD5:    CALL    CASR        ;READ A BYTE FROM TAPE
    MOV    M,A        ;STORE IN BUFFER
    INX    H        ;INCR BUFFER POINTER
    DCR    C        ;DECR BYTE COUNT
    JNZ    RD5        ;BLOCK NOT FINISHED
    MVI    C,0        ;RESET BYTES PER BLOCK (256)
    DCR    B        ;DECR BLOCK COUNT
    JNZ    RD5        ;READ ANOTHER BLOCK
    SHLD    ENDF        ;SAVE LAST LOCATION USED IN BUFFER
    XRA    A
    STA    DISFLG        ;TURN OFF DISPLAY
    LDA    CKSUM        ;GET CHECKSUM READ FROM TAPE
    MOV    B,A        ;SAVE IT IN B
    CALL    CASR        ;READ BLOCK CHECKSUM
    SUB    B        ;COMPARE
    JNZ    TPERR        ;CHECKSUM ERROR
;
;    NOW WRITE THE BLOCK ON DISK OR VERIFY IT
;
    LDA    TYPE        ;GET TYPE
    ORA    A
    JNZ    WBLK        ;IF NOT ZERO WRITE BLOCK
    LDA    VERFLG        ;CHECK VERIFY FLAG (SET IF CKSUM ERROR)
    ORA    A
    JNZ    VERBLK        ;VERIFY TAPE
    $INSTR    IPOINT,120,'VERIFY'    ;VERIFY FILE ?
    JNC    REN1
    MVI    A,0FFH
    STA    VERFLG        ;SET VERIFY FLAG
    JMP    VERBLK
REN1:    CALL    RENFIL        ;RENAME FILE ?
    $INSTR    IPOINT,120,'RUN'    ;RUN FILE ?
    JC    RUNERR
    CALL    $$$TYP        ;SAVE OLD TYPE AND SUB $$$
    DELMAK    FCB        ;IF FIRST BLOCK DELETE
WD3X:    OPEN    FCB        ;AND OPEN FILE
    LDA    NBLOCKS        ;NO OF 128 BYTE BLOCKS
    DCR    A        ;SUBTRACT 1 FOR HEADER
    STA    NBLOCKS        ;STORE IT BACK
WBLK:    LDA    VERFLG        ;CHECK VERIFY ONLY
    ORA    A
    JNZ    VERNXT
    LXI    H,FILBUF
    SHLD    BPOINT        ;SET DMA ADDR
WD4:    MOVEI    BPOINT,IPOINT,128    ;MOVE BLOCK
    WRITE    FCB        ;WRITE A RECORD ON DISK
    JC    DERR        ;DISK WRITE ERROR (FULL)
    INDEX    BPOINT,128    ;INCR  ADDR BY 128
    LDA    NBLOCKS        ;BLOCK COUNT
    DCR    A
    STA    NBLOCKS        ;DECR BY 1
    JNZ    WD4        ;WRITE ANOTHER BLOCK
WD4X:    LDA    TYPE
    CPI    2        ;IS IT LAST BLOCK
    JZ    WD5        ;CLOSE FILE AND EXIT
    XRA    A
    STA    CKSUM        ;ZERO CHECKSUB
    STA    DISFLG        ;TURN OFF DISPLAY
    MVI    A,10H
    OUT    CASC        ;RESET RECEIVER
    CALL    CASR        ;READ DECODE BYTE
    CALL    CASR        ;READ    TYPE
    STA    TYPE        ;SAVE IT
    CALL    CASR        ;READ    LENGTH
    LXI    H,0
    MOV    L,A
    MOV    B,A        ;NO OF 256 BYTE BLOCKS
    DAD    H
    SHLD    NBLOCKS        ;SAVE NO OF 128 BYTE BLOCKS
    LXI    H,FILBUF    ;BUFFER POINTER
    MVI    C,0        ;NO OF BYTES PER BLOCK (256)
    MVI    A,0FFH
    STA    DISFLG        ;TURN ON DISPLAY
    JMP    RD5        ;READ ANOTHER BLOCK
WD5:    LDA    AMBIG        ;CHECK AMBIG FILE NAME FLAG
    ORA    A
    JNZ    WD6        ;OMIT STOP MESSAGE
    CALL    STOP        ;DISPLAY STOP TAPE MESSAGE
WD6:    LDA    VERFLG        ;CHECK VERIFY FLAG
    ORA    A
    JNZ    VOUT
    JMP    DWCLOS
;
;   WDISK - DISK OUTPUT ROUTINE
;
WDISK:    MOVE    FILBUF,FCB+1,11    ;MOVE NAME INTO FCB
    LDA    VERFLG
    ORA    A
    JNZ    VERIFY
    $INSTR    IPOINT,120,'VERIFY'    ;VERIFY ONLY?
    JC    VERIFY
    $INSTR    IPOINT,120,'RUN'    ;LOAD AND EXEC FILE?
    JC    RUN
    LDA    RUNFLG        ;GET RUN FLAG, OTHER RUN TEST
    ORA    A
    JNZ    RUN
    CALL    RENFIL        ;RENAME ?
WDISK1:    CALL    $$$TYP        ;CHANGE TYPE TO $$$ AND SAVE OLDTYP
    DELMAK    FCB        ;DELETE AND MAKE FILE
    OPEN    FCB        ;OPEN THE FILE
    JC    OPNERR        ;ERROR ON OPEN - PRINT MESS AND EXIT
    LXI    H,FILBUF+128    ;POINTER TO START OF FILE IN MEMORY
    SHLD    BPOINT        ;SET POINTER
DWLOOP:    MOVEI    BPOINT,IPOINT,128    ;MOVE INDIRECT BLOCK TO OUT BUFFER
    WRITE    FCB        ;WRITE IT OUT
    JC    DERR        ;JUMP TO WRITE ERROR
    LHLD    NBLOCKS        ;NO OF BLOCKS TO WRITE
    DCX    H        ;DECREMENT IT
    MOV    A,H
    ORA    L
    JZ    DWCLOS        ;CLOSE FILE AND EXIT
    SHLD    NBLOCKS        ;OTHERWISE STORE IT BACK
    INDEX    BPOINT,128    ;INCR MEMORY POINTER BY 128
    JMP    DWLOOP        ;BACK TO WRITE ANOTHER BLOCK
;
DWCLOS:    CLOSE    FCB        ;CLOSE FILE
    MOVE    FCB,FCB+16,12    ;RENAME FILE
    MOVE    OLDTYP,FCB+25,3
    MVI    C,19        ;DELETE
    LXI    D,FCB+16
    CALL    5
    MVI    C,23
    LXI    D,FCB
    CALL    5        ;RENAME ROUTINE
    JMP    AMBCHK        ;RETURN FOR MORE TAPE INPUT ON AMBIG NAME
;
;
VERIFY:    LXI    H,FILBUF+128    ;POINTER TO START OF TAPE FILE
    SHLD    BPOINT
    MVI    A,-1
    STA    VERFLG        ;SET VERIFY FLAG
    OPEN    FCB        ;OPEN THE DISK FILE
    JC    OPNERR        ;PRINT ERROR MESSAGE IF NO FILE
VLOOP:    READ    FCB        ;READ A DISK RECORD
    JC    VEND        ;EXIT ON EOF OR ERROR
    LHLD    BPOINT        ;POINTER FOR COMPARE
    IMATCH    80H,HL,128    ;COMPARE (HL POINTS TO ONE STRING)
    JNC    VERERR        ;EXIT IF NO MATCH
    INDEX    BPOINT,128    ;INCR THE POINTER
    JMP    VLOOP        ;DO ANOTHER RECORD
VEND:    CPI    1        ;CHECK END FILE
    JNZ    RDERR        ;READ ERROR IF NOT 1
VOUT:    PRINT    BELL2
    PRINTL    'VERIFIED SUCCESSFULLY$'
    PRINT    CRLF
AMBCHK:    LDA    AMBIG        ;CONTINUE IF AMBIGUOUS FILE NAME
    ORA    A
    JZ    MOREIN        ;EXIT
    MOVE    AMBNAM,FCB,12    ;REPLACE AMBIG NAME IN FCB
    XRA    A
    STA    FCB+12        ;ZERO EXTENTS
    STA    FCB+32
    JMP    TAPIN        ;BACK TO TAPE INPUT
;
;    THIS SECTION MOVES THE FILE TO 100H AND EXECUTES IT. A CHECK IS
;    MADE TO VERIFY THAT IT IS A COM FILE.
;
RUN:    $MATCH    65H,'COM'    ;TYPE IN FCB
    JNC    TYPERR
    MOVE    CODE,80H,40    ;FILE OVERLAYS PROG MOVE TO BUFFER
    JMP    80H        ;GO EXECUTE MOVE ROUTINE
CODE:    LXI    B,100H
    LXI    D,FILBUF+128    ;POINTS TO BEGINNING OF FILE
    LHLD    ENDF        ;LAST LOC TO BE MOVED
MLOOP:    LDAX    D        ;GET A BYTE
    STAX    B        ;STORE IT
    INX    D
    INX    B
    MOV    A,H        ;COMPARE DE WITH HL
    CMP    D
    JNZ    89H
    MOV    A,L
    CMP    E
    JNZ    89H
    LXI    H,0
    SHLD    80H        ;ZERO START OF INPUT BUFFER
    JMP    100H        ;EXECUTE MOVED FILE
;
;    RENAME ROUTINE - RENAME FILE FOR TAPE TO DISK TRANSFER
;
RENFIL:    $INSTR    IPOINT,120,'RENAME'    ;RENAME ?
    RNC            ;RETURN IF NO 'RENAME'
SKPBLK:    INX    H        ;INCR POINTER
    MOV    A,M        ;GET A BYTE
    CPI    20H        ;IS IT A BLANK
    JZ    SKPBLK        ;SKIP OVER BLANKS
    SHLD    SLOC2        ;STORE POINTER
    FILFCB    FCB,SLOC2    ;FILL IN FCB WITH NEW NAME
    JC    NAMERR        ;ERROR IN NAME (TOO LONG)
    RET
;
;    VERIFY BLOCKED TAPE
;
VERBLK:    OPEN    FCB        ;OPEN THE FILE
    JC    OPNERR        ;EXIT IF NO FILE
VERNXT:    LXI    H,FILBUF+1024    ;POINTER FOR DISK INPUT
    SHLD    BPOINT
    LDA    NBLOCKS
    CPI    9        ;SET BLOCKS TO 8 IF > 8
    JM    VER2
    MVI    A,8        ;SET BLOCKS TO 8
    STA    NBLOCKS
VER2:    READ    FCB        ;READ A RECORD
    JNC    VER3
    CPI    1        ;TEST EOF
    JNZ    RDERR        ;DISK READ ERROR
    JMP    WD5        ;PRINT STOP MESSAGE AND EXIT
VER3:    MOVEI    IPOINT,BPOINT,128
    INDEX    BPOINT,128    ;INCR POINTER
    LDA    NBLOCKS        ;BLOCK COUNT
    DCR    A
    STA    NBLOCKS        ;DECR COUNT BY 1
    JNZ    VER2        ;READ SOME MORE
    LHLD    BPOINT        ;POINTS TO END OF BLOCK
    DCX    H        ;DECR BY 1
    XCHG            ;TO DE
    LXI    H,FILBUF+1024    ;POINTS TO DISK DATA
    LXI    B,FILBUF    ;POINTS TO TAPE DATA
VER4:    LDAX    B        ;GET A BYTE
    CMP    M        ;COMPARE
    JNZ    VERERR        ;ERROR, NO MATCH
    INX    H
    INX    B
    CPHL            ;COMPARE HL AND DE
    JNZ    VER4
    JMP    WD4X        ;BACK INTO TAPE INPUT ROUTINE
;
;    THIS ROUTINE SCANS FCB NAME AND FILLS * TO ?.
;    CARRY SET SET IF * OR ? IN FILE NAME
;
SCANFCB:LXI    H,FCB+1        ;POINTS TO FILE NAME
    MVI    B,'?'
    MVI    A,'*'
    CMP    M        ;IS NAME *
    JNZ    SCAN2
    MVI    C,8        ;FILL IN 8 '?'
SCAN1:    MOV    M,B        ;MOVE A BYTE
    INX    H
    DCR    C
    JNZ    SCAN1
SCAN2:    LXI    H,FCB+9        ;POINTS TO TYPE
    CMP    M        ;IS TYPE A *
    JNZ    SCAN4
    MVI    C,3        ;FILL TYPE WITH '?'
SCAN3:    MOV    M,B        ;MOVE A BYTE
    INX    H
    DCR    C
    JNZ    SCAN3
SCAN4:    LXI    H,FCB+1        ;RESCAN FOR ? AND SET CARRY
    MVI    C,11
    MOV    A,B        ;PUT '?' IN A
SCAN5:    CMP    M
    JZ    SCAN6
    INX    H
    DCR    C
    JNZ    SCAN5
    XRA    A        ;CARRY OFF NO '?'
    RET
SCAN6:    STC            ;CARRY ON
    RET
;
;    THIS ROUTINE SEARCHES DIRECTORY WITH AMBIGUOUS FILE NAME
;
GETNAM:    MVI    A,0
    STA    FCB+12        ;SET FILE EXTENT TO ZERO
    SEARCH    FCB
    CPI    0FFH        ;CHECK NAME NOT PRESENT
    JZ    OPNERR        ;DISPLAY ERROR MESSAGE
    JMP    N1
GETNEXT:SERNXT    FCB        ;SEARCH FOR NEXT OCCURRANCE OF NAME
    CPI    0FFH        ;NAME NOT FOUND ?
    JNZ    N1        ;RETURN ADDR IF FOUND
    STC
    RET            ;SET CARRY AND RETURN
N1:    ANI    03        ;ADDR MOD 4
    RRC
    RRC
    RRC            ;ADDR * 32
    ADI    80H        ;ADD BASE ADDR
    LXI    H,0
    MOV    L,A        ;HL NOW POINTS TO FCB FROM DIR
    XRA    A        ;CLEAR CARRY
    RET
;
;   WRITE SYNC STREAM ON TAPE (65K BYTES)
;
SYNC:    CALL    STARTW        ;PRINT START MESSAGE
    MVI    A,0FFH
    STA    DISFLG        ;TURN ON DISPLAY
    LXI    D,0        ;SYNC BYTE COUNTER
SYNC1:    MVI    A,0E6H        ;LOAD A SYNC BYTE
    CALL    CASW        ;WRITE IT OUT
    DCX    D        ;DECR COUNT
    MOV    A,D
    ORA    E
    JNZ    SYNC1        ;TEST COUNT AND LOOP
    CALL    STOP        ;PRINT STOP MESSAGE
    JMP    MOREIN
;
;
;    SWAP FCB TYPE WITH $$$
;
$$$TYP:    MOVE    FCBTYP,OLDTYP,3    ;MOVE TYPE TO TEMPORARY STORAGE
    FILL    FCBTYP,FCBTYP+2,'$'
    RET
;
;    WRITE LEADER AND ID BLOCK OF 100 76H BYTES ON TAPE
;
WRID:    LXI    D,1500        ;LOAD COUNT
WRHD:    MVI    A,3CH        ;START BYTE
    CALL    CASW        ;WRITE IT
    DCX    D        ;DECR COUNT
    MOV    A,D
    ORA    E
    JNZ    WRHD        ;LOOP TILL ZERO
    MVI    D,100        ;LOAD COUNT
    MVI    A,0E6H        ;SYNC BYTE
    CALL    CASW        ;WRITE IT
WRID1:    MVI    A,76H        ;HALT CODE
    CALL    CASW        ;WRITE IT
    DCR    D
    JNZ    WRID1        ;WRITE ANOTHER BYTE
    RET
;
;    SEARCH FOR BLOCK OF 100 76H BYTES ON TAPE
;
RDID:    MVI    D,100        ;LOAD COUNT
    MVI    A,10H
    OUT    CASC        ;RESET RECEIVER
RDID1:    CALL    CASR        ;READ A BYTE
    CPI    76H        ;COMPARE WITH 76H
    JNZ    RDID        ;START OVER
    DCR    D        ;DECR COUNT
    JNZ    RDID1        ;READ ANOTHER BYTE
    RET
;
;
;
;   WRITE SPACER BLOCK OF START BYTES FOR BLOCKED TAPES
;
WRSPAC:    PUSH    H
    PUSH    D
    PUSH    B
    LXI    D,160        ;COUNT
WRSP1:    MVI    A,3CH        ;START BYTE
    CALL    CASW        ;WRITE IT
    DCX    D        ;DECR COUNT
    MOV    A,D
    ORA    E
    JNZ    WRSP1        ;LOOP TILL COUNT IS ZERO
    POP    B
    POP    D
    POP    H
    RET
;
;   CONSOLE MESSAGE ROUTINES
;
STARTW:    PRINT    CRLF2
    PRINTL    'START CASSETTE TAPE <<RECORD>> - TYPE CARRIAGE RETURN$'
    PRINT    CRLF2
    CONIN
    CPI    3        ;ESCAPE CHARACTER
    JZ    GETOUT
    RET
GETOUT:    POP    PSW        ;RESET STACK POINTER
    JMP    MOREIN        ;BACK FOR MORE INPUT
STOP:    PRINT    BELL2
    PRINTL    'STOP CASSETTE TAPE$'
    PRINT    CRLF
    RET
;
;
;   EXIT AND ERROR ROUTINES
;
VERERR:    PRINT    BELL2
    PRINTL    'VERIFY ERROR$'
    JMP    MOREIN
;
TYPERR:    PRINT    BELL2
    PRINTL    'ERROR - FILE TYPE NOT <COM> - CANNOT BE RUN$'
    JMP    MOREIN
;
RUNERR:    PRINT    CRLF2
    PRINTL 'ERROR - A PROGRAM CAN NOT BE RUN FROM A BLOCKED TAPE$'
    PRINT    CRLF
    PRINTL    'TO EXECUTE PROGRAM FIRST LOAD TO DISK$'
    CALL    STOP        ;DISPLAY STOP TAPE MESSAGE
    JMP    MOREIN
;
DERR:    PRINT    BELL2
    PRINTL    'DISK WRITE ERROR - DISK OR DIRECTORY FULL$'
    PRINT    CRLF
    PRINTL    'FILE DELETED FROM DISK$'
    DELETE    FCB
;
MOREIN:    LDA    INFLAG
    ORA    A
    JNZ    NEWIN
;
MONITOR: PRINT    CRLF
    RESDRV    DRVNO        ;RESTORE ORIGINAL DRIVE NUMBER
    JMP    0        ;EXIT BACK TO MONITOR
;
;
;   DATA ALLOCATIONS -
;
FCB    =    5CH    ;FILE CONTROL BLOCK
FCBNAM    =    FCB+1    ;FILE NAME
FCBTYP    =    FCB+9    ;FILE TYPE
BELL:    .ASCII    [07H][0DH][0AH][24H]
BELL2:    .ASCII    [07H][0DH][0AH][0AH][24H]
CRLF:    .ASCII    [0DH][0AH]'$'
CRLF2:    .ASCII    [0DH][0AH][0AH][24H]
BCOUNT:    .BYTE    65    ;COUNT OF BYTES PER LINE
RUNFLG:    .BYTE    0    ;CONTROLS FILE TO BE LOADED AND EXECUTED
DISFLG:    .BYTE    0    ;CONTROLS DISPLAY DURING TAPE OPERATIONS
DRVNO:    .BYTE    0    ;CURRENTLY LOGGED DISK DRIVE NO
NEWDRV:    .BYTE    0    ;STORAGE FOR NEW DRIVE NO IF ONE IS SELECTED
CKSUM:    .BYTE    0    ;STORAGE FOR TAPE CHECKSUM
INFLAG:    .BYTE    0    ;FLAG - IF SET RETURN FOR MORE CONSOLE INPUT
FIRST:    .BYTE    0    ;INDICATES FIRST RECORD OF BLOCKED TAPE
BLOCK:    .BYTE    0    ;BLOCK COUNT FOR BLOCKED TAPE
TYPE:    .BYTE    0    ;TYPE CODE FOR BLOCKED TAPE
LENGTH:    .BYTE    0    ;LENGTH OF BLOCKED RECORD 256 BYTE BLOCKS
DFLAG1:    .BYTE    0    ;DISPLAY OFF FOR SLOW TERMINALS
VERFLG:    .BYTE    0    ;FLAG - SET FOR VERIFICATION
AMBIG:    .BYTE    0    ;AMBIGUOUS NAME FLAG
FAMBIG:    .BYTE    0    ;FIRST AMBIGUOUS FILE FLAG
BLKBLK:    .BYTE    0    ;BLOCK COUNT FOR BLOCKED TAPES
MEMEND:    .WORD    0    ;END MEMORY FOR FILE STORAGE
BPOINT:    .WORD    0    ;POINTER TO FILE MEMORY BUFFER
SLOC2:    .WORD    0    ;STORAGE FOR POINTER TO FCB NAME
SLOC1:    .WORD    88H    ;POINTER TO NAME IN INPUT BUFFER
IPOINT:    .WORD    80H    ;POINTER TO DISK INPUT BUFFER
NBLOCKS:.WORD    0    ;NUMBER OF 256 BYTE BLOCKS IN FILE
ENDF:    .WORD    0    ;LAST MEMORY LOC USED TO STORE FILE
OLDTYP:    .BLKB    3    ;TEMP STORAGE FOR FILE TYPE (FOR RENAME)
AMBNAM:    .BLKB    12    ;STORAGE FOR AMBIGUOUS FILE NAME
ENDSTK:    .BLKW    16    ;NEW STACK
NEWSTK:    .WORD    0    ;START OF NEW STACK
FILBUF:    .WORD    0    ;FILE BUFFER - TO TOP OF MEMORY
    .END