Oakland CPM Archive/oakcpm.iso/sigm/sigmv039.ark/3740UTIL.ASM

Assembly Source File | 1984-04-29 | 66.0 KB | 3,302 lines

    TITLE    '3740UTIL - 3740/CP/M UTILITY'
;
;PROGRAM    3740UTIL - 3740 DISK UTILITY
;PROGRAMMER    ROBERT    M. WHITE
;        3986 BRYSON WAY
;        BOISE, ID  83704
;/////////////////////////////////////////////////////////////
;/                         W-A-R-N-I-N-G                     /
;/ USE THIS PROGRAM AT YOUR OWN RISK.  THE AUTHOR WILL NOT   /
;/ BE RESPONSIBLE FOR THIS PROGRAM OR ITS USE IN ANY WAY.    /
;/////////////////////////////////////////////////////////////
;
;DATE WRITTEN    AUGUST 15, 1979
;DATE FINISHED    DECEMBER 23, 1979
;UPDATES
;        APRIL 21, 1980 - CHANGED DATASET LIST FUNCTION
;            (11) TO PRINT 80 CHARS.  BEFORE IT USED
;            BUFFER WRITE, THIS CAUSED BAD DISPLAYS
;            IF THE DATA CONTAINED IMBEDDED '$'s.
;        26 MAR 1981 - REMOVED STRUCTURED PROGRAMMING
;            MACROS TO GIVE 'MAC' MORE ROOM TO
;            ASSEMBLE IN AND LESSEN RISK OF NOT
;            BEING ABLE TO ASSEMBLE IT PROPERLY.
;        APRIL 9, 1981 - FIXED BUG IN TRANSFER WHERE
;            IBM OPEN DID NOT RESET BUFFER HEADER
;            CAUSING THE TRANSFER TO NOT BE PERFORMED.
;        APRIL 9, 1981 - ADDED RECORD COUNT DISPLAY FOR
;            SOURCE TRANSFERS AND IBM DISPLAY.
;        APRIL 9, 1981 - ADDED TRAILING BLANK REMOVAL ON
;            SOURCE TRANSFER FROM IBM TO CP/M.
;PURPOSE    THIS PROGRAM GIVES THE USER THE CAPABILITY
;        OF CONVERTING IBM 374X DISKETTES TO CP/M
;        FORMAT AND VICE VERSA.  ALSO, CERTAIN
;        OTHER MAINTENANCE FUNCTIONS ARE PROVIDED.
;INPUT
;OUTPUT
;OUTLINE
;REMARKS
;        1. REFERENCES FOR THIS PROGRAM ARE IBM
;           MANUALS:
;           A. GA21-9182, IBM GENERAL INFORMATION
;              MANUAL ON DISKETTES
;        2. THIS PROGRAM IS BASED ON IBM'S BASIC
;           DATA EXCHANGE FORMAT.  THE ABOVE MANUAL
;           DESCRIBE THIS FORMAT.  IN PARTICULAR,
;           IT WAS WRITTEN TO FORMAT DATA ACCEPTABLE
;           TO THE 3741 AND 3540 DISKETTE READER
;           FOR EXCHANGE OF DATA BETWEEN CP/M AND
;           IBM 370 MAINFRAME.
;        3. ALL CP/M FILE NAMES ARE ASSUMED TO BE
;           THE EIGHT BYTE DATASET NAME ENTERED IN
;           THE PARTICULAR FUNCTION WITH A FILE TYPE
;           OF 'DAT'.  OTHER THAN THIS, BOTH THE CP/M
;           AND IBM FILE NAMES ARE IDENTICAL.
;        4. ALL DISPLAYS ARE BASED ON THE SOROC-120.
;           THE CLEAR SCREEN IS THE ONLY DEPENDENT
;           ROUTINE AND IS LABELLED CLRSCRN.
;        5. ALL IBM DISKETTES ARE ASSUMED TO BE FORMATTED
;           TO 128-BYTE SECTORS, 26 SECTORS PER TRACK AND
;           76 TRACKS (SINGLE DENSITY ONLY).
;        6. THE 3741 REQUIRES THAT THE REMAINING BYTES AFTER
;           THE RECORD LENGTH BE NULLS.  OTHERWISE, IT ISSUES
;           A READ ERROR ON THE RECORD.

;MACLIBS
    MACLIB    MACS3740

;EQUATES
;;
;;        * * *  ASSEMBLER EQUATES  * * *
;;
TRUE    SET    0FFFFH        ;;TRUE VALUE
FALSE    SET    NOT TRUE    ;;FALSE VALUE
;;
;;
;;
;;
;;        * * *  CP/M EQUATES  * * *
;;
;;        * *  ADDRESS ASSIGNMENTS  * *
CPMEXIT    SET    0        ;;WARM START BOOT LOCATION
BDOS    SET    5        ;;BDOS ENTRY POINT
TBUFF    SET    0080H        ;;DEFAULT BUFFER LOCATION
TDDN    SET    0004H        ;;CURRENT DEFAULT DRIVE NUMBER
TFCB    SET    005CH        ;;DEFAULT FCB LOCATION 1
TFCB2    SET    006CH        ;;DEFAULT FCB LOCATION 2 ( MUST BE MOVED)
TIOBYTE    SET    0003H        ;;INTEL STANDARD I/O BYTE
TPABGN    SET    0100H        ;;TRANSIENT PROGRAM AREA BEGINNING
;;
;;        *  FDOS FUNCTIONS  *
CREAD    SET    1        ;;**CODE FOR CONSOLE READ
CWRITE    SET    2        ;;**CODE FOR CONSOLE WRITE
CPB    SET    9        ;;**CODE FOR CONSOLE PRINT BUFFER
CRB    SET    10        ;;**CODE FOR CONSOLE READ BUFFER
CSTAT    SET    11        ;;**CODE FOR CONSOLE STATUS CHECK
DLDH    SET    12        ;;**CODE FOR LIFT DISK HEAD
DRDS    SET    13        ;;**CODE FOR RESET DISK SYSTEM
DSD    SET    14        ;;**CODE FOR SELECT DISK
DOF    SET    15        ;;**CODE FOR OPEN FILE
DCF    SET    16        ;;**CODE FOR CLOSE FILE
DSF    SET    17        ;;**CODE FOR SEARCH FIRST
DSN    SET    18        ;;**CODE FOR SEARCH NEXT
DDF    SET    19        ;;**CODE FOR DELETE FILE
DRR    SET    20        ;;**CODE FOR READ A RECORD
DWR    SET    21        ;;**CODE FOR WRITE A RECORD
DCRF    SET    22        ;;**CODE FOR CREATE A FILE
DREN    SET    23        ;;**CODE FOR RENAME A FILE
DINTL    SET    24        ;;**CODE FOR INTERROGATE LOGIN
DRINT    SET    25        ;;**CODE FOR DRIVE INTERROGATE
DDMA    SET    26        ;;**CODE FOR SET DMA ADDRESS
DINTA    SET    27        ;;**CODE FOR INTERROGATE ALLOCATION
;;        * FCB EQUATES *
FCBET    SET    0        ;;FCB ENTRY TYPE - *NOT USED*
FCBFN    SET    1        ;;FILE NAME, 8 CHARS, PADDED WITH BALNKS
FCBFT    SET    9        ;;FILE TYPE, 3 CHARS, PADDED WITH BLANKS
FCBEX    SET    12        ;;FILE EXTENT, NORMALLY SET TO ZERO
;;        13-14        ;;*NOT USED*
FCBRC    SET    15        ;;RECORD COUNT IN CURRENT EXTENT (0-128)
FCBDM    SET    16        ;;DISK ALLOCATION MAP, USED BY CP/M
FCBNR    SET    32        ;;NEXT RECORD NUMBER TO READ OR WRITE
FCBLEN    SET    FCBNR-FCBET+1    ;;FCB LENGTH
;;
;;
;;
;;        * *  DOUBLE REGISTER EQUATES  * *
BC    SET    B
DE    SET    D
HL    SET    H
;;
;;
@TRNASEB SET    TRUE
@TRNEBAS SET    TRUE
@OUTTRN    SET    TRUE
NBIOS    SET    FALSE    ;TRUE IF USING NEW BIOS FOR CP/M 2.0
DMA$BIOS SET    TRUE    ;TRUE IF USING DMA BIOS FOR CP/M 2.0
SPOOLER SET    FALSE    ;TRUE IF KLH SPOOLER IS IN NEW BIOS
Z80    SET    FALSE    ;TRUE IF CPU IS Z80

    IF    SPOOLER    ;DISP TO SPECIAL BIOS 2.0 JUMPS
JMPDSP    SET    033H+9
    ELSE
JMPDSP    SET    033H
    ENDIF
$+PRINT
$+PRINT

;IN-LINE MACROS
$+PRINT
;
;        MOVE ASCII TO EBCDIC.
MOVAE    MACRO    DST,SRC,LEN
    LOCAL    OVERSUB,LOOP
    JMP    OVERSUB
@MVAE:    DS    0
    MOV    A,M        ;;GET NEXT BYTE.
    CALL    TRNASEB        ;;TRANSLATE TO EBCDIC.
    STAX    DE        ;;SAVE IT.
    INX    HL        ;;BUMP PTRS.
    INX    DE
    DCR    C        ;;DECR COUNT.
    JNZ    @MVAE        ;;LOOP FOR ALL CHARACTERS.
    RET
OVERSUB:
;
;        MOVE EBCDIC TO ASCII.
MOVAE    MACRO    D,S,L
    IF    NOT NUL D
    LXI    DE,D        ;;POINT OT DESTINATION.
    ENDIF
    IF    NOT NUL S
    LXI    HL,S        ;;POINT TO SOURCE.
    ENDIF
    IF    NOT NUL L
    LSR    C,L        ;;GET LENGTH.
    ENDIF
    CALL    @MVAE        ;;DO THE MOVE.
    ENDM
    MOVAE    DST,SRC,LEN
    ENDM
;
;        PRINT AN EBCIDIC FIELD.
PRNTEAF MACRO    ?STR,FLD,LNG
    IF    NOT NUL ?STR
    MVC    TBUFF,?STR    ;;MOVE IT TO THE BUFFER.
    ENDIF
    MOVEA    <>,FLD,LNG
    MVI    A,CR        ;;ADD CR.
    STAX    DE
    INX    DE
    MVI    A,LF        ;;ADD LF.
    STAX    DE
    INX    DE
    MVI    A,'$'        ;;ADD EOL MARKER.
    STAX    DE
    CPM    CPB,TBUFF    ;;PRINT THE BUFFER.
    ENDM
;


;        MOVE EBCDIC TO ASCII.
MOVEA    MACRO    DST,SRC,LEN
    LOCAL    OVERSUB,LOOP
    JMP    OVERSUB
@MVEA:    DS    0
    MOV    A,M        ;;GET NEXT BYTE.
    CALL    TRNEBAS        ;;TRANSLATE TO ASCII.
    STAX    DE        ;;SAVE IT.
    INX    HL        ;;BUMP PTRS.
    INX    DE
    DCR    C        ;;DECR COUNT.
    JNZ    @MVEA        ;;LOOP FOR ALL CHARACTERS.
    RET
OVERSUB:
MOVEA    MACRO    D,S,L
    IF    NOT NUL D
    LXI    DE,D        ;;POINT OT DESTINATION.
    ENDIF
    IF    NOT NUL S
    LXI    HL,S        ;;POINT TO SOURCE.
    ENDIF
    IF    NOT NUL L
    LSR    C,L        ;;GET LENGTH.
    ENDIF
    CALL    @MVEA        ;;DO THE MOVE.
    ENDM
    MOVEA    DST,SRC,LEN
    ENDM
;
;
;
;
;
;        * * *  BEGINNING OF PROGRAM  * * *
;
    ORG    TPABGN        ;ORG TO BEGINNING OF TPA
;        ESTABLISH STACK POINTER.
    LHLD    6        ;GET ADDRESS OF BEGINNING OF CP/M.
    DCX    HL
    SPHL            ;INIT STACK.
    CPM    DRDS        ;RESET ALL DISKS.
    JMP    MAINMENU
;
;
;        * *  SPECIAL BIOS JUMPS * *
BIOSSEL:            ;SELECT DISK.
    PUSH    H
    LHLD    1
    MVI    L,000H+JMPDSP
    XTHL
    RET

BIOSHOM:            ;HOME DISK.
    PUSH    H
    LHLD    1
    MVI    L,003H+JMPDSP
    XTHL
    RET

BIOSSEK:            ;SEEK TRACK.
    PUSH    H
    LHLD    1
    MVI    L,006H+JMPDSP
    XTHL
    RET

BIOSRED:            ;READ SECTOR.
    PUSH    H
    LHLD    1
    MVI    L,009H+JMPDSP
    XTHL
    RET

BIOSWRT:            ;WRITE SECTOR.
    PUSH    H
    MVI    C,1        ;CP/M 2.0 - DIR WRITE (IMMED)
    LHLD    1
    MVI    L,00CH+JMPDSP
    XTHL
    RET

CLRSCRN:
    PRINT    <27,'*',0,0>    ;CLEAR SCREEN.
    RET


;        * *  MAIN PROGRAM LOOP  * *
;
;        DISPLAY BASE MENU.
MAINMENU: DS    0
$+PRINT
    CALL    CLRSCRN
    PRINT    <'* * *  3740 IBM UTILITY  * * *',CR,LF>
    PRINT    <'SELECT ONE OF THE FOLLOWING:',CR,LF>
    PRINT    <'   0 - RETURN TO CP/M',CR,LF>
    PRINT    <'   1 - INITIALIZE THE DIRECTORY',CR,LF>
    PRINT    <'   2 - CHANGE A VOLUME SERIAL NUMBER',CR,LF>
    PRINT    <'   3 - CHANGE A DATASET ENTRY',CR,LF>
    PRINT    <'   4 - DELETE A DATASET ENTRY',CR,LF>
    PRINT    <'   5 - DISPLAY A DATASET ENTRY',CR,LF>
    PRINT    <'   6 - LIST THE DIRECTORY',CR,LF>
    PRINT    <'   7 - TRANSFER CP/M TO 3740 (BLOCK)',CR,LF>
    PRINT    <'   8 - TRANSFER 3740 TO CP/M (BLOCK)',CR,LF>
    PRINT    <'   9 - TRANSFER CP/M TO 3740 (SOURCE)',CR,LF>
    PRINT    <'  10 - TRANSFER 3740 TO CP/M (SOURCE)',CR,LF>
    PRINT    <'  11 - DISPLAY AN IBM DATASET',CR,LF>
    INPUT    'ENTER CHOICE: ',TBUFF
    PRINT    <CR,LF>
;
;
;        IF NO INPUT, ISSUE ERROR MSG.
    LDA    TBUFF+1        ;GET INPUT COUNT.
    CPI    0        ;LENGTH CHECK (1-2)
    JZ     MAINERR        ;...ISSUE ERROR.
    CPI    2+1
    JNC    MAINERR
;
;
;        CONVERT INPUT TO BINARY.
    DECIN    TBUFF+2,TBUFF+1    ;GET INPUT NUMBER.
    CPI    11+1        ;IF INVALID NUMBER
    JNC    MAINERR        ;...ISSUE ERROR MESSAGE.
;
;
;               CLEAR THE SCREEN FOR EACH ROUTINES OUTPUT.
        PUSH    PSW             ;SAVE OPTION CODE.
    CALL    CLRSCRN
        POP     PSW             ;RESTORE OPTION CODE.
;
;
;        CALL THE APPROPRIATE ROUTINE.
;
    ADD    A        ;INDEX INTO TABLE.
    LXI    HL,FNCTBL
    ADDHA
;
    MOV    E,M        ;GET ENTRY.
    INX    HL
    MOV    D,M
;
    LXI    HL,MAINMENU    ;SET RETURN PTR.
    PUSH    HL
;
    XCHG        ;CALL THE ROUTINE.
    PCHL
;
;
;        ISSUE ERROR MESSAGE AND RE-PRINT MENU.
MAINERR: DS    0
    PRINT    <'***INVALID REPLY***',CR,LF>
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    JMP    MAINMENU
;
;
;
;
$+PRINT
$+PRINT
;        * * *  RETURN TO CPM  * * *
;PURPOSE
;        THIS ROUTINE RETURNS CONTROL TO CP/M ISSUEING
;        A WARM START AND DISK RESET.
;INPUT
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
RTNCPM:    DS    0
    PRINT    <'*** RETURN TO CPM ***',CR,LF>
    PRINT    <'PUT MASTER CP/M DISK IN DRIVE A.',CR,LF>
    INPUT    'PRESS <ENTER> WHEN READY. ',TBUFF
    CPM    DRDS        ;RESET ALL DRIVES.
    JMP    CPMEXIT        ;COLD START CP/M.
;
;
;
;
$+PRINT
$+PRINT
;        * * *  INITIALIZE A DISKETTE  * * *
;PURPOSE
;        THIS ROUTINE ALLOWS THE USER TO FORMAT A
;        DISKETTE TO IBM FORMAT.  FIRST, IT BUILDS
;        THE DIRECTORY AND THEN BLANKS ALL REMAINING
;        RECORDS.
;INPUT
;        DISK DRIVE OF DISK TO BE FORMATTED
;        VOLUME SERIAL NUMBER FOR THE DISK
;OUTPUT
;        FORMATTED DISK
;REMARKS
;
;
;
;        DO INITIALIZATION.
INITDISK: DS    0
    PRINT    <'*** INITIALIZE A DISK  ***',CR,LF>
;
;
;        GET DISK DRIVE.
    CALL    INPDSKNO
    STA    DIRDSK        ;SAVE IT.
;
;
;        GET VOLUME SERIAL NUMBER.
    FILL    VOLSER,6,' '
INITDIRV: DS    0
    INPUT    'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LENGTH.
    CPI    1
    JC    $+8        ;...INVALID.
    CPI    6+1
    JC    INITDIRG    ;...VALID
    PRINT    <'*** INVALID REPLY ***',CR,LF>
    JMP    INITDIRV
INITDIRG: DS    0
    MVC    VOLSER,TBUFF+2,TBUFF+1
;
;
;        WRITE SECTORS (1-4 AND 6)
    FILL    DIRBUF,80,040H
    FILL    DIRBUF+80,48,000H
    MVI    A,1        ;SET SECTOR TO 1.
    STA    DIRSCT
    LDA    DIRSCT
INITDIR0: DS    0
    CPI    4+1
    JNC    INITDIR1
    CALL    WRTDIR
    LDA    DIRSCT        ;BUMP SCTOR NUMBER.
    INR    A
    STA    DIRSCT
    JMP    INITDIR0
INITDIR1: DS    0
    MVI    A,6
    CALL    WRTDIR
;
;
;        WRITE SECTOR 5 (ERMAP).
    MOVAE    DIRBUF,CERMAP,5
    MVI    A,5
    CALL    WRTDIR
;
;
;        WRITE SECTOR 7 (VOL1).
    MOVAE    DIRBUF,CVOL1,4    ;PUT 'VOL1' IN COL 1.
    MOVAE    DIRBUF+4,VOLSER,6 ;PUT VOLSER IN COL 5.
    MVI    A,0E6H        ;PUT 'W' IN COL 80.
    STA    DIRBUF+79
    MVI    A,7
    CALL    WRTDIR
;
;
;        WRITE SECTORS 8-26 (DATA).
    MVI    A,8
    STA    DIRSCT
INITDIR2:
    LDA    DIRSCT
    CPI    26+1
    JNC    INITDIR3
    CALL    DFTDIR
    LDA    DIRSCT
    CALL    WRTDIR
    LDA    DIRSCT
    INR    A
    STA    DIRSCT
    JMP    INITDIR2
INITDIR3: DS    0
;
;
;        WRITE REMAINING DISK BUFFERS.
    PRINT    <'THE DIRECTORY HAS BEEN INITIALIZED.',CR,LF>
    PRINT    <'THE REST OF THE DISK SHOULD HAVE BEEN',CR,LF>
    PRINT    <'PREVIOUSLY INITIALIZED.',CR,LF>
;
;
;        ISSUE COMPLETION MESSAGE.
    PRINT    <'*** INITIALIZATION IS COMPLETE ***',CR,LF>
    INPUT   'PRESS <ENTER> TO CONTINUE.',TBUFF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  CHANGE A VOLUME SERIAL NUMBER  * * *
;PURPOSE
;        THIS ROUTINE ALLOWS THE USER TO CHANGE AN IBM
;        VOLUME SERIAL NUMBER AS FOUND IN THE 'VOL1'
;        SECTOR (00008).
;INPUT
;        DISK DRIVE OF IBM DISKETTE
;        VOLUME SERIAL NUMBER (OPTIONAL)
;OUTPUT
;        THE VOLUME SERIAL NUMBER IS CHANGED IF ENTERED.
;REMARKS
;
;
;
;        DO INITIALIZATION.
CHGVOL: DS    0
    PRINT    <'*** CHANGE A VOLUME SERIAL NUMBER ***',CR,LF>
;
;
;        GET THE DISK DRIVE AND VERIFY IT.
    CALL    INPDSKNO    ;GET IT.
    STA    DIRDSK        ;SAVE IT.
    CALL    VERIBMD        ;VERIFY IBM DISK.
    JC    CHGVOLE        ;...DIDN'T VERFIY, MSG WAS GIVEN.
;
;
;        PRINT THE VOLUME SERIAL NUMBER.
    PRNTEAF    'CURRENT VOLUME SERIAL NUMBER: ',DIRBUF+4,6
    MOVEA    VOLSER,DIRBUF+4,6
;
;
;        GET VOLUME SERIAL NUMBER.
CHGVOLIV: DS    0
    PRINT    <'(OPTIONALLY) '>
    INPUT    'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LENGTH.
    CPI    1
    JC    CHGVOLIB    ;...NO ENTRY, SKIP REPLACE.
    CPI    6+1
    JC    CHGVOLIG    ;...VALID
    PRINT    <'*** INVALID REPLY ***',CR,LF>
    JMP    CHGVOLIV
CHGVOLIG: DS    0
    FILL    VOLSER,6,020H
    MVC    VOLSER,TBUFF+2,TBUFF+1
CHGVOLIB: DS    0
;
;
;        WRITE THE SECTOR BACK OUT.
    MOVAE    DIRBUF+4,VOLSER,6    ;PUT VOLSER IN BUFFER.
    MVI    A,7        ;WRITE OUT SECTOR 7 (VOL1).
    CALL    WRTDIR
;
;
;        RETURN TO CALLER.
    PRINT    <'*** CHANGE IS SUCCESSFUL.***',CR,LF>
CHGVOLE: DS    0
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  CHANGE A DATASET ENTRY  * * *
;PURPOSE
;        THIS ROUTINE ACTIVATES A DIRECTORY ENTRY AND/OR
;        ALLOWS THE USER TO CHANGE DIRECTORY INFORMATION
;        PERTAINING TO THAT DATASET.
;INPUT
;        IBM DISKETTE DISK DRIVE
;        DIRECTORY SECTOR NUMBER AS GIVEN IN DIRECTORY LIST
;OUTPUT
;        THE DIRECTORY ENTRY IS UPDATED.
;REMARKS
;
;
;
;        DO INITIALIZATION.
CHGDIR: DS    0
    PRINT    <'*** CHANGE A DATASET ENTRY ***',CR,LF>
;
;
;        GET DISK DRIVE.
    CALL    INPDSKNO    ;GET IT.
    STA    DIRDSK        ;SAVE IT.
    CALL    VERIBMD        ;VERIFY IBM DISK.
    RC
;
;
;        GET THE SECTOR NUMBER.
    CALL    INPSCTNO    ;GET IT.
    STA    DIRSCT        ;SAVE IT.
;
;
;        PRINT THE ENTRY.
    CALL    REDDIR        ;READ THE ENTRY.
    CALL    PRTDIR        ;PRINT IT.
;
;
;        PRINT CHANGE MESSAGES.
    PRINT
    PRINT    <'CHANGE ONLY THE FIELDS THAT YOU WANT UPDATED.',CR,LF>
    PRINT    <'IF YOU DO NOT ENTER ANY DATA, THE FIELD',CR,LF>
    PRINT    <'REMAINS UNCHANGED.',CR,LF>
    PRINT
;
;
;        CHANGE THE FIELDS AND UPDATE THE RECORD.
    MVI    A,0C8H        ;INSURE ACTIVE DATASET.
    STA    DSHD
    CALL    INPDIR        ;CHANGE THE FIELDS.
    LDA    DIRSCT        ;UPDATE THE RECORD.
    CALL    WRTDIR
    PRINT    <'***CHANGE IS SUCCESSFUL.***',CR,LF>
;
;
;        RETURN TO CALLER.
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  DELETE A DATASET ENTRY  * * *
;PURPOSE
;        THIS FUNCTION ALLOWS THE USER TO DELETE A
;        SPECIFIED DIRECTORY ENTRY.  THE ENTRY IS MARKED
;        AS DELETED AND INITIALIZED TO ITS INITIAL FORMAT
;        AS WHEN THE ENTIRE DIRECTORY WAS INITIALIZED.
;INPUT
;        IBM DISK DRIVE
;        DIRECTORY SECTORY NUMBER
;OUTPUT
;        DELETED INITIAL DIRECTORY ENTRY
;REMARKS
;        1. AT THIS POINT, WE HAVE FOUND THAT THE AM2 FIELD
;           OF THE RECORD DOES NOT HAVE TO INDICATE DELETED
;           RECORD.
;
;
;
;        DO INITIALIZATION.
DELDIR: DS    0
    PRINT    <'*** DELETE A DATASET ENTRY ***',CR,LF>
;
;
;        GET DISK DRIVE.
    CALL    INPDSKNO    ;GET IT.
    STA    DIRDSK        ;SAVE IT.
    CALL    VERIBMD        ;VERIFY IBM DISK.
    RC            ;...NOT IBM FORMAT!!
;
;
;        GET THE SECTOR NUMBER.
    CALL    INPSCTNO    ;GET IT.
    STA    DIRSCT        ;SAVE IT.
;
;
;        DELETE THE ENTRY.
    LDA    DIRSCT        ;INITIALIZE THE ENTRY.
    CALL    DFTDIR
    LDA    DIRSCT        ;WRITE IT BACK TO DISK.
    CALL    WRTDIR
;
;
;        RETURN TO CALLER.
    PRINT    <'***DELETION IS SUCCESSFUL.***',CR,LF>
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  DISPLAY A DATASET ENTRY  * * *
;PURPOSE
;        THIS ROUTINE DISPLAYS A SINGLE DIRECTORY ENTRY.
;        IT IS PRIMARILY USED TO INSURE THAT AN ENTRY
;        WAS CHANGED PROPERLY.
;INPUT
;        IBM DISK DRIVE
;        DIRECTORY SECTOR NUMBER
;OUTPUT
;        DIRECTORY ENTRY IS DISPLAYED
;REMARKS
;
;
;
;        DO INITIALIZATION.
DSPLDIR: DS    0
    PRINT    <'*** DISPLAY A DIRECTORY ENTRY ***',CR,LF>
;
;
;        GET DISK DRIVE.
    CALL    INPDSKNO    ;GET IT.
    STA    DIRDSK        ;SAVE IT.
    CALL    VERIBMD        ;VERIFY IBM DISK.
    RC
;
;
;        GET THE SECTOR NUMBER.
    CALL    INPSCTNO    ;GET IT.
    STA    DIRSCT        ;SAVE IT.
;
;
;        PRINT THE ENTRY.
    CALL    REDDIR        ;READ THE ENTRY.
    CALL    PRTDIR        ;PRINT IT.
;
;
;        RETURN TO CALLER.
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  LIST THE DIRECTORY  * * *
;PURPOSE
;        THIS ROUTINE DISPLAYS THE ENTIRE IBM DISKETTE
;        DIRECTORY AND ALL PERTINENT DATA ASSOCIATED
;        WITH IT.
;INPUT
;        IBM DISK DRIVE
;OUTPUT
;        THE DIRECTORY IS DISPLAYED.
;REMARKS
;
;
;
;        DO INITIALIZATION.
LISTDIR: DS    0
    PRINT    <'*** LIST THE DIRECTORY ***',CR,LF>
;
;
;        GET THE DISK NUMBER.
    CALL    INPDSKNO    ;GET IT.
    STA    DIRDSK        ;SAVE IT.
;
;
;        READ AND VERIFY THE VOLSER.
    CALL    VERIBMD        ;VERIFY 'VOL1' ID.
    JC    LISTDIRR    ;...BAD VOL1.
    CALL    CLRSCRN
    PRNTEAF    '              DIRECTORY FOR ',DSHD+4,6
    PRINT    <'                                           '>
    PRINT    <'         M VL B S W V',CR,LF>
    PRINT    <'SCT DATASET D LRECL  BOE   EOE   EOD  CREDT'>
    PRINT    <'  EXPDT  V SQ I S P C',CR,LF>
;
;
;        LIST ALL DIRECTORY ENTRIES.
    MVI    C,8        ;SET BEGINNING SECTOR.
    MOV    A,C
LISTDIR0: DS 0
    CPI    26+1        ;LOOP FOR SECTORS 8-26.
    JNC    LISTDIR1
    CALL    LISTDIRE    ;LIST THE ENTRY.
    INR    C        ;BUMP SECTOR.
    MOV    A,C        ;SET FOR DOWHILE.
    JMP    LISTDIR0
LISTDIR1: DS 0
;
;
;        RETURN TO CALLER.
LISTDIRR: DS    0
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
$+PRINT
$+PRINT

;        * *  LIST A DIRECORTY ENTRY  * *
;
;        DO INITIALIZATION.
LISTDIRE: DS    0
    PUSH    BC        ;SAVE REGS.
;
;
;        READ SECTOR.
    MOV    A,C        ;GET SECTOR.
    CALL    REDDIR        ;READ IT.
;
;
;        BUILD OUTPUT LINE.
    FILL    TBUFF,80,' '    ;MOVE SPACES TO TBUFF.
    LXI    HL,CSCTNO    ;  SECTOR NUMBER
    LDA    DIRSCT
    SUI    8
    ADD    A
    ADDHA
    MVC    TBUFF,,2
    LDA    DIRSCT
    CPI    8
    JNZ    LISTDIR2
    MVC    TBUFF,'08'
LISTDIR2: DS    0
    MOVEA    TBUFF+3,DSID,8    ;  DATASET NAME
    LDA    DSHD        ;  **DELETED**
    CPI    0C4H
    JNZ    LISTDIR3
    MVI    A,'D'
    STA    TBUFF+12
LISTDIR3: DS    0
    MOVEA    TBUFF+14,DSBLK,5    ;  LRECL
    MOVEA    TBUFF+20,DSBOE,5    ;  BOE
    MOVEA    TBUFF+26,DSEOE,5    ;  EOE
    MOVEA    TBUFF+32,DSEOD,5    ;  EOD
    MOVEA    TBUFF+38,DSCREDT,6
    MOVEA    TBUFF+45,DSEXPDT,6    ;  EXP DATE
    MOVEA    TBUFF+52,DSMVI,1    ;  MULTI-VOL IND
    MOVEA    TBUFF+54,DSVLSQ,2    ;  VOL SEQ
    MOVEA    TBUFF+57,DSBYPI,1    ;  BYP IND
    MOVEA    TBUFF+59,DSSS,1        ;  SECURE IND
    MOVEA    TBUFF+61,DSWP,1        ;  WRITE PRO IND
    MOVEA    TBUFF+63,DSVCI,1    ;  VERI/COPY IND
;
;
;        PRINT THE LINE.
    MVC    TBUFF+72,CEOL,3
    PRINT    TBUFF,$
;
;
;        RETURN TO CALLER.
    POP    BC        ;RESTORE REGS.
    RET
;
;
;
;
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSFER CP/M TO 3740 (BLOCK)  * * *
;PURPOSE
;        THIS ROUTINE TRANSFERS A DATASET FROM CP/M TO
;        IBM FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
;        EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
;        ARE ONE SECTOR.
;INPUT
;        CP/M INPUT DRIVE
;        IBM OUTPUT DRIVE
;        EIGHT-BYTE DATASET NAME
;OUTPUT
;        THE FILE IS MOVED TO THE IBM DISKETTE.
;REMARKS
;        1.  IT IS ASSUMED THAT THE INPUT FILE NAME
;            IS THE EIGHT-BYTE DATASET NAME CONCATENATED
;            WITH A FILE TYPE OF 'DAT'.
;        2.  IT IS ASSUMED THAT THE IBM FILE HAS BEEN
;            PRE-ALLOCATED ON THE DISK WITH ENOUGH SPACE
;            DEFINED TO HOLD THE INPUT FILE.
;
;
;
;        DO INITIALIZATION.
TRSCIBLK: DS    0
    PRINT    <'*** TRANSFER CP/M TO 3740 (BLOCK) ***',CR,LF>
    XRA    A        ;ZERO ERROR COUNT.
    STA    TRSERR
;
;
;        GET INPUT AND OPEN FILES.
    CALL    TRSGETIN    ;GET INPUT PARMS.
    MVI    A,0        ;OPEN CP/M FOR INPUT.
    CALL    CPMOPEN
    JC    TRSCIBEN    ;...UNSUCCESSFUL.
    MVI    A,1        ;OPEN IBM FOR OUTPUT.
    LXI    HL,DATDSK2
    CALL    IBMOPEN
    JC    TRSCIBEN
;
;
;        GET THE BLOCK LENGTH FOR MOVE.
    MOVEA    TBUFF,DSBLK,5    ;GET THE DATASET BLOCK LENGTH.
    DECIN    TBUFF,5        ;CONVERT TO BINARY.
    XCHG            ;GET BINARY BLOCK LENGTH.
    SHLD    BLKLEN        ;SAVE IT.
;
;
;        GET AN CP/M BLOCK.
TRSCIBLP: DS    0
    CPM    CSTAT        ;CHECK FOR SUSPEND.
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;SELECT THE DISK DRIVE.
    CPM    DDMA,DATA1    ;SET FOR CP/M BUFFER.
    CPM    DRR,TRSFCB    ;READ THE BLOCK.
    CPI    0        ;ERROR?
    JZ    TRSCIB00    ;...NO.
    CPI    1        ;EOF?
    JZ    TRSCIBOK    ;...YES, CLOSE FILES.
    PRINT    <'*** CP/M READ ERROR ***',CR,LF>
    BUMP    TRSERR
TRSCIB00: DS    0
;
;
;        MOVE BLOCK TO IBM BUFFER.
    FILL    DATA2,128,000H    ;MOVE LOW VALUES TO BUFFER.
    MOVAE    DATA2,DATA1,BLKLEN ;MOVE IN THE DATA.
;
;
;        IF PAST EOE, ISSUE ERROR.
    CLC    DATTRK2,TDSEOE,2
    JC    TRSCIBNF
    JZ    TRSCIBNF
    PRINT    <'*** IBM EXTENT FULL ***',CR,LF>
    BUMP    TRSERR
    JMP    TRSCIBOK
TRSCIBNF: DS    0
;
;
;        WRITE IBM BLOCK.
    CALL    WRTDAT2        ;WRITE THE BLOCK.
;
;
;        BUMP THE IBM TRK/SCT.
    BUMP    DATSCT2
    LDA    DATSCT2        ;LIMIT TO 26.
    CPI    26+1        ;ROLL TRACK AFTER LAST
    JC    TRSCIBLP
    MVI    A,1
    STA    DATSCT2
    BUMP    DATTRK2
    JMP    TRSCIBLP
;
;
;        CLOSE ALL FILES.
TRSCIBOK: DS    0
    MVI    A,0        ;CP/M FILE.
    CALL    CPMCLOSE
    MVI    A,1        ;IBM FILE.
    LXI    HL,DATTRK2
    CALL    IBMCLOSE
;
;
;        RETURN TO CALLER.
TRSCIBEN: DS    0
    LDA    TRSERR
    CPI    0
    JNZ    TRSCIB02
    PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
    JMP    TRSCIB03
TRSCIB02: DS    0
    PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
    PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSCIB03: DS    0
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSFER 3740 TO CP/M (BLOCK)  * * *
;PURPOSE
;        THIS ROUTINE TRANSFERS A DATASET FROM IBM TO
;        CP/M FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
;        EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
;        ARE ONE SECTOR.
;INPUT
;        CP/M OUTPUT DRIVE
;        IBM INPUT DRIVE
;        EIGHT-BYTE DATASET NAME
;OUTPUT
;        THE FILE IS MOVED TO THE CP/M DISK.
;REMARKS
;        1.  IT IS ASSUMED THAT THE INPUT FILE NAME
;            IS THE EIGHT-BYTE DATASET NAME CONCATENATED
;            WITH A FILE TYPE OF 'DAT'.
;
;
;
;        DO INITIALIZATION.
TRSICBLK: DS    0
    PRINT    <'*** TRANSFER 3740 TO CP/M (BLOCK) ***',CR,LF>
    XRA    A        ;ZERO ERROR COUNT.
    STA    TRSERR
;
;
;        GET INPUT AND OPEN FILES.
    CALL    TRSGETIN    ;GET INPUT PARMS.
    MVI    A,0        ;OPEN IBM FOR INPUT.
    LXI    HL,DATDSK1
    CALL    IBMOPEN
    JC    TRSICBEN    ;...UNSUCCESSFUL.
    MVI    A,1        ;OPEN CP/M FOR OUTPUT.
    CALL    CPMOPEN
    JC    TRSICBEN
;
;
;        GET BLOCK LENGTH OF IBM DATASET.
    MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
    DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
    XCHG            ;SAVE IT.
    SHLD    BLKLEN
;
;
;        GET AN IBM BLOCK.
TRSICBLP: DS    0
    CPM    CSTAT        ;CHECK FOR SUSPEND.
    CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
    CMC
    JC    TRSICBOK    ;...YES.
    CALL    REDDAT1        ;GET THE BLOCK.
;
;
;        MOVE BLOCK TO CP/M BUFFER.
    FILL    DATA2,128,000H    ;ZERO OUTPUT BUFFER.
    MOVEA    DATA2,DATA1,BLKLEN
    MVI    A,00DH        ;INSERT <CR><LF> PAIR FOR CP/M
    STAX    DE
    INX    DE
    MVI    A,00AH
    STAX    DE
;
;
;        WRITE CP/M BLOCK.
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;SELECT DISK DRIVE.
    CPM    DDMA,DATA2
    CPM    DWR,TRSFCB
    CPI    0        ;WRITE ERROR?
    JZ    TRSICB00    ;...NO.
    PRINT    <'*** CP/M WRITE ERROR ***',CR,LF>
    BUMP    TRSERR
    JMP    TRSICBOK
TRSICB00:
;
;
;        BUMP TO NEXT IBM BLOCK.
    BUMP    DATSCT1        ;BUMP SECTOR BY 1.
    CPI    26+1        ;ALLOW FOR TRACK OVERFLOW.
    JC    TRSICBLP
    MVI    A,1        ;SECTOR = 1
    STA    DATSCT1
    BUMP    DATTRK1
    JMP    TRSICBLP
;
;
;        CLOSE ALL FILES.
TRSICBOK: DS    0
    MVI    A,0        ;IBM FILE.
    LXI    HL,DATTRK1
    CALL    IBMCLOSE
    MVI    A,1        ;CP/M FILE.
    CALL    CPMCLOSE
;
;
;        RETURN TO CALLER.
TRSICBEN: DS    0
    LDA    TRSERR
    CPI    0
    JNZ    TRSICB01
    PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
    JMP    TRSICB02
TRSICB01:
    PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
    PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSICB02:
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSFER CP/M TO 3740 (SOURCE)  * * *
;PURPOSE
;        THIS ROUTINE TRANSFERS A CP/M SOURCE FILE TO AN
;        IBM FILE ONE LINE AT A TIME.  <TAB>'S ARE EX-
;        PANDED AS THEY ARE ENCOUNTERED.  EOF WILL OCCUR
;        WHEN (A) A 01AH IS ENCOUNTERED OR (B) THE PHYSICAL
;        EOF IS ENCOUNTERED.  NOTE THAT <CR><LF>'S ARE
;        NOT TRANSFERRED.
;INPUT
;        CP/M DISK DRIVE
;        IBM DISK DRIVE
;        DATASET NAME
;OUTPUT
;        IBM DATASET
;REMARKS
;        1.  EACH LINE OF TEXT IS TRANSFERRED AS ONE PHYSICAL
;            RECORD ON THE IBM DRIVE.  THE IBM BEGINNING-OF-EXTENT
;            POINTER INDICATES WHERE THE TRANSFER IS TO BEGIN.
;        2.  IT IS ASSUMED THAT THE IBM DATASET HAS BEEN
;            PRE-ALLOCATED WITH ENOUGH SPACE TO HOLD THE
;            ENTIRE CP/M DATASET.
;
;
;
;        DO INITIALIZATION.
TRSCISRC: DS    0
    PRINT    <'*** TRANSFER CP/M TO 3740 (SOURCE) ***',CR,LF>
    LXI    HL,0        ;ZERO RECORD COUNT.
    SHLD    RCDCNT
    XRA    A        ;ZERO ERROR COUNT.
    STA    TRSERR
;
;
;        GET INPUT AND OPEN FILES.
    CALL    TRSGETIN    ;GET INPUT PARMS.
    MVI    A,0        ;OPEN CP/M FOR INPUT.
    CALL    CPMOPEN
    JC    TRSCISEN    ;...UNSUCCESSFUL.
    MVI    A,1        ;OPEN IBM FOR OUTPUT.
    LXI    HL,DATDSK2
    CALL    IBMOPEN
    JC    TRSCISEN
    CALL    TRSCISGT    ;GET THE FIRST CP/M BLOCK.
    JC    TRSCISOK    ;...**EOF REACHED**
;
;
;        GET THE BLOCK LENGTH FOR MOVE.
    MOVEA    TBUFF,DSBLK,5    ;GET THE DATASET BLOCK LENGTH.
    DECIN    TBUFF,5        ;CONVERT TO BINARY.
    XCHG            ;GET BINARY BLOCK LENGTH.
    SHLD    BLKLEN        ;SAVE IT.
;
;
;        GET THE NEXT LINE OF CP/M TEXT.
TRSCISLP: DS    0
    CALL    TRSCISGL    ;GET THE LINE.
    JC    TRSCISOK    ;...**EOF REACHED**
    INDEX    RCDCNT        ;BUMP RECORD COUNT.
;
;
;        MOVE BLOCK TO IBM BUFFER.
    FILL    DATA2,128,000H    ;MOVE LOW VALUES TO BUFFER.
    MOVAE    DATA2,TBUFF,BLKLEN ;MOVE IN THE DATA.
;
;
;        IF PAST EOE, ISSUE ERROR.
    CLC    DATTRK2,TDSEOE,2
    JC    TRSCISNF
    JZ    TRSCISNF
    PRINT    <'*** IBM EXTENT FULL ***',CR,LF>
    BUMP    TRSERR
    JMP    TRSCISOK
TRSCISNF: DS    0
;
;
;        WRITE IBM BLOCK.
    CALL    WRTDAT2        ;WRITE THE BLOCK.
;
;
;        BUMP THE IBM TRK/SCT.
    BUMP    DATSCT2
    CPI    26+1
    JC    TRSCISLP
    MVI    A,1
    STA    DATSCT2
    BUMP    DATTRK2
    JMP    TRSCISLP
;
;
;        CLOSE ALL FILES.
TRSCISOK: DS    0
    MVI    A,0        ;CP/M FILE.
    CALL    CPMCLOSE
    MVI    A,1        ;IBM FILE.
    LXI    HL,DATTRK2
    CALL    IBMCLOSE
;
;
;        RETURN TO CALLER.
TRSCISEN: DS    0
    DECOUT    RCDCNT        ;DISPLAY RECORDS XFERED.
    PRINT    <' RECORDS TRANSFERRED.',CR,LF>
    LDA    TRSERR
    CPI    0
    JNZ    TRSCIS01
    PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
    JMP    TRSCIS02
TRSCIS01:
    PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
    PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSCIS02:
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;        * *  GET A LINE OF CP/M TEXT  * *
TRSCISGL: DS    0
    FILL    TBUFF,128,' '    ;MOVE SPACES TO BUFFER.
    LXI    DE,TBUFF    ;POINT TO BEGINNING OF BUFFER.
;
;
;        MOVE THE TEXT TO THE BUFFER.
TRSCISGN: DS    0
    PUSH    DE        ;SAVE BUFFER PTR.
    CALL    TRSCISGB    ;GET THE NEXT BYTE.
    POP    DE        ;RESTORE BUFFER PTR.
    RC            ;...**EOF REACHED**
;
;        HANDLE SPECIAL CHARACTERS.
    CPI    009H        ;**<TAB>**
    JNZ    TRSCIS03
    INX    DE        ;BUMP OUTPUT PTR.
    MOV    A,E        ;ALIGN TO 8 BYTE BOUNDARY.
    ANI    8-1
    JNZ    $-4
    JMP    TRSCISGN    ;GO GET NEXT BYTE.
TRSCIS03:
    CPI    00DH        ;**<CR> OR <EOL>**
    JNZ    TRSCIS04
    CALL    TRSCISGB    ;GET TRAILING <LF>.
    RET
TRSCIS04:
    CPI    00AH        ;**<LF> OR <EOL>**
    RZ
;
;        ADD CHARACTER TO BUFFER.
    STAX    DE
    INX    DE        ;BUMP BUFFER PTR.
    JMP    TRSCISGN
;
;
;
;        * *  GET A BYTE  * *
TRSCISGB: DS    0
    LHLD    TRSBUFP        ;POINT INTO CP/M BUFFER.
    LDA    TRSBUFA        ;GET REMAINING # OF BYTES.
    CPI    0        ;NEED A NEW BLOCK?
    JNZ    TRSCIS05    ;...NO.
    CALL    TRSCISGT    ;READ IT.
    RC            ;...**EOF REACHED**
TRSCIS05:
;
;
    MOV    C,M        ;GET THE NEXT BYTE.
    INX    HL        ;BUMP BUFFER PTR.
    DCR    A        ;DECR BUFFER COUNT.
    SHLD    TRSBUFP        ;SAVE BUFFER PTR AND CNT.
    STA    TRSBUFA
    MOV    A,C
;
;
    CPI    01AH        ;**LOGICAL EOF**
    JNZ    TRSCIS06
    STC
    RET
TRSCIS06:
    ORA    A        ;RESET CY.
    RET
;
;
;
;        * *  GET A CP/M BLOCK  * *
TRSCISGT: DS    0
    CPM    CSTAT        ;CHECK FOR SUSPEND.
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;SELECT THE DISK DRIVE.
    CPM    DDMA,DATA1    ;SET FOR CP/M BUFFER.
    CPM    DRR,TRSFCB    ;READ THE BLOCK.
    CPI    0
    JZ    TRSCIS07
    CPI    1
    JZ    TRSCIS08
    PRINT    <'*** CP/M READ ERROR ***',CR,LF>
    BUMP    TRSERR
TRSCIS08:
;                ;** EOF REACHED **
    STC
TRSCIS07:
;        SET UP VARIABLES AND RETURN.
    LXI    HL,DATA1    ;CURRENT BUFFER PTR
    SHLD    TRSBUFP
    MVI    A,128        ;# OF BYTES REMAINING
    STA    TRSBUFA
    RET
;
;
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSFER 3740 TO CP/M (SOURCE)  * * *
;PURPOSE
;        THIS ROUTINE TRANSFERS A IBM DATASET TO A CP/M
;        SOURCE FILE ONE LINE AT A TIME.  LINES ARE ENDED
;        WITH <CR><LF> PAIRS AND OUTPUTTED CONTIGUOUSLY.
;        INITIALLY, THE OUTPUT BUFFER IS INITIALIZED TO
;        01AH (LOGICAL EOF).  THEREFORE, ALL CONSTRAINTS
;        FOR A CP/M SOURCE FILE ARE MET.
;INPUT
;        CP/M DISK DRIVE
;        IBM DISK DRIVE
;        DATASET NAME
;OUTPUT
;        CP/M DATASET
;REMARKS
;        1.  IF THE DATASET WAS PREVIOUSLY CREATED ON THE CP/M
;            DRIVE.  IT IS DELETED AND RE-ALLOCATED.
;
;
;
;        DO INITIALIZATION.
TRSICSRC: DS    0
    PRINT    <'*** TRANSFER 3740 TO CP/M (SOURCE) ***',CR,LF>
    LXI    HL,0        ;ZERO RECORD COUNT.
    SHLD    RCDCNT
    XRA    A        ;ZERO ERROR COUNT.
    STA    TRSERR
;
;
;        GET INPUT AND OPEN FILES.
    CALL    TRSGETIN    ;GET INPUT PARMS.
    MVI    A,0        ;OPEN IBM FOR INPUT.
    LXI    HL,DATDSK1
    CALL    IBMOPEN
    JC    TRSICSEN    ;...UNSUCCESSFUL.
    MVI    A,1        ;OPEN CP/M FOR OUTPUT.
    CALL    CPMOPEN
    JC    TRSICSEN
    CALL    TRSICSIN    ;INITIALIZE OUTPUT BUFFER.

;        GET BLOCK LENGTH OF IBM DATASET.
    MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
    DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
    XCHG            ;SAVE IT.
    SHLD    BLKLEN

;        GET AN IBM BLOCK.
TRSICSLP: DS    0
    CPM    CSTAT        ;CHECK FOR SUSPEND.
    CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
    CMC
    JC    TRSICSOK    ;...YES.
    CALL    REDDAT1        ;GET THE BLOCK.
    INDEX    RCDCNT        ;BUMP RECORD COUNT.

;        MOVE RECORD TO CP/M BUFFER.
    MOVEA    TBUFF,DATA1,BLKLEN

;        REMOVE TRAILING BLANKS.
    LXI    HL,TBUFF    ;POINT TO BUFFER.
    LDA    BLKLEN        ;GET BLOCK LENGTH - 1.
    DCR    A
    MOV    C,A        ;SAVE IT.
    ADD    L        ;POINT TO LAST BYTE.
    MOV    L,A
    MOV    A,H
    ACI    0
    MOV    H,A
TRSICS06:
    MOV    A,M        ;GET A BYTE.
    CPI    ' '        ;BLANK?
    JNZ    TRSICS07    ;...NO.
    DCX    HL        ;TRY NEXT BYTE.
    DCR    C        ;DECR COUNT.
    JNZ    TRSICS06
TRSICS07:
    MOV    A,C        ;SAVE THE NEW LENGTH.
    INR    A        ;MAKE IT RELATIVE TO ONE.
    STA    TWRKC3        ;SAVE IT.

;        PUT THE RECORD TO CP/M.
    LXI    HL,TBUFF    ;POINT TO BUFFER.
TRSICS00:
    LDA    TWRKC3        ;** LOOP FOR FULL BUFFER **
    CPI    0
    JZ    TRSICS01
    MOV    A,M        ;GET THE NEXT BYTE.
    CPI    ' '        ;BLANK?
    JNZ    TRSICS08    ;...NO, PUT BYTE TO CP/M.
    MOV    A,L        ;8-BYTE BOUNDARY?
    ANI    8-1
    CPI    8-1        ;LAST BYTE ON BOUNDARY?
    JZ    TRSICS08-1    ;YES, SKIP TAB COMPRESS.
    SUI    8        ;GET REMAINING BYTES TO BOUNDARY.
    CMA
    MOV    C,A        ;SAVE IT.
    MOV    B,A
    PUSH    HL        ;SAVE HL.
TRSICS09:            ;**CHECK IF REST OF BOUNDARY IS
;                ;**BLANK.
    INX    HL
    MOV    A,M        ;GET THE NEXT BYTE.
    CPI    ' '        ;IS IT A BLANK?
    JNZ    TRSICS08-2    ;...NO, SKIP COMPRESSION.
    DCR    C        ;DECR COUNT.
    JNZ    TRSICS09    ;LOOP FOR ALL BYTES.
    POP    DE        ;PUT PTR TO 8-BYTE BOUNDARY.
    LDA    TWRKC3        ;ADJUST BYTE COUNT.
    SUB    B
    STA    TWRKC3
    MVI    A,009H        ;OUTPUT A <TAB>.
    JMP    TRSICS08
    POP    HL
    MOV    A,M        ;GET THE BYTE.
TRSICS08:
    INX    HL        ;BUMP PTR.
    PUSH    HL        ;SAVE IT.
    CALL    TRSICSPB    ;ADD THE BYTE.
    POP    HL
    JC    TRSICSOK    ;...** WRITE ERROR **
    BUMP    TWRKC3,-1    ;DECR REMAINING COUNT.
    JMP    TRSICS00
TRSICS01:

;        ADD TRAILING CR,LF FOR CP/M.
    MVI    A,00DH        ;ADD <CR>.
    CALL    TRSICSPB
    MVI    A,00AH        ;ADD <LF>.
    CALL    TRSICSPB

;        BUMP TO NEXT IBM BLOCK.
    BUMP    DATSCT1        ;BUMP SECTOR BY 1.
    CPI    26+1
    JC    TRSICSLP
    MVI    A,1        ;SECTOR = 1
    STA    DATSCT1
    BUMP    DATTRK1
    JMP    TRSICSLP

;        CLOSE ALL FILES.
TRSICSOK: DS    0
    CALL    TRSICSPT    ;PUT THE LAST BLOCK.
    MVI    A,0        ;IBM FILE.
    LXI    HL,DATTRK1
    CALL    IBMCLOSE
    MVI    A,1        ;CP/M FILE.
    CALL    CPMCLOSE

;        RETURN TO CALLER.
TRSICSEN: DS    0
    DECOUT    RCDCNT        ;DISPLAY RECORDS XFERED.
    PRINT    <' RECORDS TRANSFERRED.',CR,LF>
    LDA    TRSERR
    CPI    0
    JNZ    TRSICS02
    PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
    JMP    TRSICS03
TRSICS02:
    PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
    PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
TRSICS03:
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET


;        * *  PUT A BYTE TO CP/M FILE  * *

;        PUT BYTE IN BUFFER.
TRSICSPB: DS    0
    LHLD    TRSBUFP        ;GET BUFFER POINTER.
    MOV    M,A        ;ADD THE BYTE.
    INX    HL        ;BUMP BUFFER PTR.
    SHLD    TRSBUFP        ;SAVE IT.

;        IF FULL BUFFER, WRITE IT OUT.
    BUMP    TRSBUFA,-1    ;DECR REMAINING BYTE CNT.
    LDA    TRSBUFA
    CPI    0        ;** FULL BUFFER **
    JNZ    TRSICS04
    CALL    TRSICSPT    ;ADD THE RECORD.
    RC            ;...** WRITE ERROR **
    CALL    TRSICSIN    ;INITIALIZE BUFFER.
TRSICS04:

;        RETURN TO CALLER.
    ORA    A
    RET

;        * *  WRITE CP/M BLOCK  * *
TRSICSPT: DS    0
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;SELECT DISK DRIVE.
    CPM    DDMA,DATA2
    CPM    DWR,TRSFCB
    CPI    0        ;WRITE ERROR?
    JZ    TRSICS05    ;...NO.
    PRINT    <'*** CP/M WRITE ERROR ***',CR,LF>
    BUMP    TRSERR
    STC            ;INDICATE ERROR.
    RET
TRSICS05:
    ORA    A
    RET

;        * *  INITIALIZE OUTPUT BUFFER  * *
TRSICSIN: DS    0
    FILL    DATA2,128,01AH    ;INITIALIZE BUFFER TO LOGICAL EOF.
    LXI    HL,DATA2    ;RESET BUFFER PTR.
    SHLD    TRSBUFP
    MVI    A,128        ;RESET REMAINING BYTE COUNT.
    STA    TRSBUFA
    RET



$+PRINT
$+PRINT
;        * * *  DISPLAY AN IBM DATASET  * * *
;PURPOSE
;        THIS ROUTINE DISPLAYS THE CONTENTS OF A PARTICULAR
;        IBM DATASET TO THE USER.  NOTE THAT ALL RECORDS
;        ARE DISPLAYED.
;INPUT
;        IBM DISK DRIVE
;        IBM EIGHT-BYTE DATASET NAME
;OUTPUT
;        THE CONTENTS OF THE FILE ARE LISTED ON THE SCREEN.
;REMARKS
;
;
;
;        DO INITIALIZATION.
DSPIBMDS: DS    0
    PRINT    <'*** DISPLAY AN IBM DATASET ***',CR,LF>
    LXI    HL,0        ;ZERO RECORD COUNT.
    SHLD    RCDCNT
    XRA    A        ;ZERO ERROR COUNT.
    STA    TRSERR
;
;
;        GET IBM DISK DRIVE.
    PRINT    <'(IBM) '>
    CALL    INPDSKNO    ;GET IT.
    STA    IBMDSKNO    ;SAVE IT.
;
;
;        GET DATASET NAME.
DSPIBMDD: DS    0
    INPUT    'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;CHECK FOR 1-8 CHARS.
    CPI    1
    JC    DSPIBMDB
    CPI    8+1
    JC    DSPIBMDG
DSPIBMDB: DS    0
    PRINT    <'*** INVALID REPLY ***',CR,LF>
    JMP    DSPIBMDD
DSPIBMDG: DS    0
    FILL    TDSN,8,020H    ;INITIALIZE DATASET NAME.
    MVC    TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
;
;
;        GET INPUT FILE.
    MVI    A,0        ;OPEN IBM FOR INPUT.
    LXI    HL,DATDSK1
    CALL    IBMOPEN
    JC    DSPIBMD1    ;...UNSUCCESSFUL.
;
;
;        GET BLOCK LENGTH OF IBM DATASET.
    MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
    DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
    XCHG            ;SAVE IT.
    SHLD    BLKLEN
;
;
;        GET AN IBM BLOCK.
DSPIBMDL: DS    0
    CPM    CSTAT        ;CHECK FOR SUSPEND.
    CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
    CMC
    JC    DSPIBMD2    ;...YES.
    CALL    REDDAT1        ;GET THE BLOCK.
    INDEX    RCDCNT        ;BUMP RECORD COUNT.
;
;
;        PRINT 80 CHARS OF INFO.
    MVI    C,80        ;SET COUNTER.
    LXI    HL,DATA1    ;POINT TO DATA.
DSPIBMRL: DS    0
    MOV    A,M        ;GET A CHAR.
    CALL    TRNEBAS        ;TRANSLATE IT TO ASCII.
    CALL    OUTTRN        ;REMOVE NON-PRINTABLE CHARS.
    PUSH    BC        ;SAVE REGS.
    CPM    CWRITE,,??    ;PUT THE CHAR.
    POP    BC        ;RESTORE REGS.
    INX    HL        ;BUMP CHAR PTR.
    DCR    C        ;LOOP FOR ALL CHARS.
    JNZ    DSPIBMRL
;
;
;        BUMP TO NEXT IBM BLOCK.
    BUMP    DATSCT1        ;BUMP SECTOR BY 1.
    CPI    26+1
    JC    DSPIBMDL
    MVI    A,1        ;SECTOR = 1
    STA    DATSCT1
    BUMP    DATTRK1
    JMP    DSPIBMDL
;
;
;        CLOSE ALL FILES.
DSPIBMD2: DS    0
    MVI    A,0        ;IBM FILE.
    LXI    HL,DATTRK1
    CALL    IBMCLOSE
;
;
;        RETURN TO CALLER.
DSPIBMD1: DS    0
    DECOUT    RCDCNT        ;DISPLAY RECORDS XFERED.
    PRINT    <' RECORDS DISPLAYED.',CR,LF>
    LDA    TRSERR
    CPI    0
    JNZ    DSPIBM01
    PRINT    <'*** DISPLAY SUCCESSFUL ***',CR,LF>
    JMP    DSPIBM02
DSPIBM01: DS    0
    PRINT    <'*** ERROR DURING DISPLAY ***',CR,LF>
DSPIBM02: DS    0
    INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  GET TRANSFER INPUT  * * *
;PURPOSE
;        THIS ROUTINE QUIRIES THE OPERATOR FOR THE
;        CP/M DRIVE, IBM DRIVE AND EIGHT-BYTE DATASET
;        NAME TO BE USED IN THE TRANSFERS.
;INPUT
;        CP/M DISK DRIVE
;        IBM DISK DRIVE
;        EIGHT BYTE DATASET NAME
;OUTPUT
;        CPMDSKNO CONTAINS THE CP/M DISK DRIVE.
;        IBMDSKNO CONTAINS THE IBM DISK DRIVE.
;        TDSN CONTAINS THE EIGHT-BYTE DATASET NAME.
;REMARKS
;
;
;
;        DO INITIALIZATION.
TRSGETIN: DS    0
;
;
;        GET CP/M DISK DRIVE.
TRSGETCD: DS    0
    PRINT    <'(CP/M) '>
    CALL    INPDSKNO    ;GET IT.
    STA    CPMDSKNO    ;SAVE IT.
;
;
;        GET IBM DISK DRIVE.
    PRINT    <'(IBM) '>
    CALL    INPDSKNO    ;GET IT.
    STA    IBMDSKNO    ;SAVE IT.
;
;
;        INSURE IBM DRIVE IS SEPERATE FROM CP/M DRIVE.
    LDA    IBMDSKNO
    MOV    C,A
    LDA    CPMDSKNO
    JNZ    TRSGETD
    PRINT    <'*** IBM AND CP/M DRIVES MUST BE DIFFERENT. ***',CR,LF>
    PRINT    <'*** PLEASE RE-ENTER. ***',CR,LF>
    JMP    TRSGETCD
;
;
;        GET DATASET NAME.
TRSGETD: DS    0
    INPUT    'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;CHECK FOR 1-8 CHARS.
    CPI    1
    JC    TRSGETDB
    CPI    8+1
    JC    TRSGETDG
TRSGETDB: DS    0
    PRINT    <'*** INVALID REPLY ***',CR,LF>
    JMP    TRSGETD
TRSGETDG: DS    0
    FILL    TDSN,8,020H    ;INITIALIZE DATASET NAME.
    MVC    TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  OPEN A CP/M FILE  * * *
;PURPOSE
;        THIS ROUTINE OPENS THE CP/M INPUT/OUTPUT
;        FILE WITH THE APPROPRIATE HOUSEKEEPING.
;INPUT
;        A=0 (OPEN INPUT)
;        A=1 (OPEN OUTPUT)
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
CPMOPEN: DS    0
    SAVE
    PUSH    PSW        ;SAVE INPUT/OUTPUT INDICATOR.
    MVI    A,0        ;RESET ERROR INDICATOR.
    STA    TRSERR

;        SELECT THE DISK DRIVE.
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;COORDINATE BIOS.
    CPM    DDMA,TBUFF    ;SET DMA TO DEFAULT BUFFER.
    CPM    DSD,,CPMDSKNO    ;ISSUE LOGIN FOR DISK.
;
;
;        SET UP CP/M FCB.
    FILL    TRSFCB,33,000H
    MVC    TRSFCB+FCBFN,TDSN,8
    MVC    TRSFCB+FCBFT,'DAT'
;
;
;        IF OUTPUT, CREATE FILE.
    POP    PSW
    CPI    1
    JNZ    CPMOPEN00
    CPM    DDF,TRSFCB    ;DELETE IT FIRST.
    CPM    DCRF,TRSFCB    ;CREATE IT.
    CPI    255        ;UNSUCCESSFUL?
    JNZ    CPMOPEN00
    PRINT    <'*** CP/M OUTPUT FILE DIRECTORY FULL ***',CR,LF>
    BUMP    TRSERR
CPMOPEN00:
;
;
;        OPEN THE FILE.
    CPM    DOF,TRSFCB    ;ISSUE OPEN.
    CPI    255
    JNZ    CPMOPEN01
    PRINT    <'*** CP/M FILE OPEN FAILURE ***',CR,LF>
    BUMP    TRSERR
CPMOPEN01:
;
;
;        RETURN TO CALLER.
    RESTORE
    LDA    TRSERR        ;GET ERROR COUNT.
    ORA    A        ;RESET CY.
    RZ            ;...RETURN, NO ERROR.
    STC
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  CLOSE A CP/M FILE  * * *
;PURPOSE
;        THIS ROUTINE CLOSES A CP/M FILE WITH THE
;        APPROPRIATE HOUSEKEEPING.
;INPUT
;        A=0 (CLOSE INPUT)
;        A=1 (CLOSE OUTPUT)
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
CPMCLOSE: DS    0
    SAVE            ;SAVE REGS.
    MVI    A,0        ;RESET ERROR INDICATOR.
    STA    TRSERR

;        SELECT THE DISK DRIVE.
    CPM    DRINT        ;GET CP/M CURRENT DRIVE.
    SELDSK            ;COORDINATE BIOS.
    CPM    DDMA,TBUFF    ;SET DMA FOR DEFAULT BUFFER.

;        CLOSE THE FILE.
    CPM    DCF,TRSFCB    ;ISSUE CLOSE.
    CPI    255        ;UNSUCCESSFUL
    JNZ    CPMCLOS0
    PRINT    <'*** CP/M CLOSE FAILURE ***',CR,LF>
    BUMP    TRSERR
CPMCLOS0:

;        RETURN TO CALLER.
    RESTORE            ;RESTORE REGS.
    LDA    TRSERR
    ORA    A        ;RESET CY.
    RZ
    STC
    RET



$+PRINT
$+PRINT
;        * * *  CLOSE AN IBM FILE  * * *
;PURPOSE
;        THIS ROUTINE OPENS AN IBM FILE WITH THE
;        APPROPRIATE HOUSEKEEPING.
;INPUT
;        A = 0 - INPUT FILE
;            1 - OUTPUT FILE
;        HL => INTERNAL DATA SECTOR
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
IBMCLOSE: DS    0
    SAVE            ;SAVE REGS.
    PUSH    PSW
    MVI    A,0        ;ZERO ERROR INDICATOR.
    STA    TRSERR
    POP    PSW
    CPI    1        ;SKIP IF NOT OUTPUT.
    JNZ    IBMCLSEN
;
;
;        DSEOD = DATA TRK/SCT
    MOV    D,M        ;GET TRK.
    INX    HL
    MOV    E,M        ;GET SCT.
    LXI    HL,TBUFF    ;CONVERT TO EXTERNAL.
    CALL    OUTTRSAD
    MOVAE    DSEOD,TBUFF,5    ;CONVERT TO EBCDIC.
;
;
;        REWRITE THE DIRECTORY ENTRY.
    LDA    DIRSCT        ;GET THE SECTOR.
    CALL    WRTDIR        ;WRITE IT OUT.
;
;
;        RETURN TO CALLER.
IBMCLSEN: DS    0
    RESTORE            ;RESTORE REGS.
    LDA    TRSERR        ;IF ERROR, CY:ON.
    CPI    0
    RZ
    STC
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * * *  OPEN AN IBM FILE  * * *
;PURPOSE
;        THIS ROUTINE OPENS AN IBM FILE WITH
;        THE APPROPRIATE HOUSEKEEPING.
;INPUT
;        A=0 (OPEN INPUT)
;        A=1 (OPEN OUTPUT)
;        HL <= TRK/SCT AREA (2 BYTES)
;OUTPUT
;        TRK/SCT AREA = DSEOD
;REMARKS
;
;
;
;        DO INITIALIZATION.
IBMOPEN: DS    0
    SAVE            ;SAVE REGS.
    PUSH    PSW
    MVI    A,0        ;ZERO ERROR INDICATOR.
    STA    TRSERR
    POP    PSW

;        ZERO BUFFER HEADER.
    XRA    A
    MOV    M,A
    INX    HL
    MOV    M,A
    INX    HL
    MOV    M,A
    DCX    HL        ;RESET PTR.
    DCX    HL

;        GET IBM DISK DRIVE.
    LDA    IBMDSKNO    ;DIRDSK.
    MOV    M,A        ;SAVE IN DATA AREA.
    INX    HL
    PUSH    HL
    STA    DIRDSK

;        SCAN IBM DISK DRIVE FOR DATASET.
    MVI    A,8        ;SET FOR FIRST DIR ENTRY.
    STA    DIRSCT
IBMOPEN00: DS    0
    LDA    DIRSCT
    CPI    26+1
    JNC    IBMOPEN01
    CALL    REDDIR        ;READ THE DIRECTORY.
    MOVEA    TBUFF,DSID,8    ;COMPARE DATASET NAMES.
    CLC    TBUFF,TDSN,8
    JZ    IBMOPNFD    ;...FOUND IT.
    BUMP    DIRSCT
    JMP    IBMOPEN00
IBMOPEN01: DS    0
    PRINT    <'*** IBM DATASET NOT FOUND ***',CR,LF>
    BUMP    TRSERR
    POP    PSW
    JMP    IBMOPNEN
IBMOPNFD: DS    0

;        GET BEGINNING OF EXTENT.
    MOVEA    TBUFF,DSBOE,5
    LXI    HL,TBUFF    ;CONVERT TO BINARY.
    CALL    VERTRSAD
    JNC    IBMOPNGB
    PRINT    <'*** IBM BAD BOE FOUND ***',CR,LF>
    BUMP    TRSERR
IBMOPNGB: DS    0
    MOV    A,H        ;SAVE IT.
    MOV    H,L
    MOV    L,A
    SHLD    TDSBOE

;        GET END OF EXTENT.
    MOVEA    TBUFF,DSEOE,5
    LXI    HL,TBUFF    ;CONVERT TO BINARY.
    CALL    VERTRSAD
    JNC    IBMOPNGE
    PRINT    <'*** IBM BAD EOE FOUND ***',CR,LF>
    BUMP    TRSERR
IBMOPNGE: DS    0
    MOV    A,H        ;SAVE IT.
    MOV    H,L
    MOV    L,A
    SHLD    TDSEOE

;        GET END OF DATA.
    MOVEA    TBUFF,DSEOD,5
    LXI    HL,TBUFF    ;CONVERT TO BINARY.
    CALL    VERTRSAD
    JNC    IBMOPNGD
    PRINT    <'*** IBM BAD EOD FOUND ***',CR,LF>
    BUMP    TRSERR
IBMOPNGD: DS    0
    MOV    A,H        ;SAVE IT.
    MOV    H,L
    MOV    L,A
    SHLD    TDSEOD

;        DATA TRK/SCT = BOE
    POP    HL
    XCHG
    MVC    <>,TDSBOE,2

;        RETURN TO CALLER.
IBMOPNEN: DS    0
    RESTORE            ;RESTORE REGS.
    LDA    TRSERR        ;IF ERROR, CY:ON.
    ORA    A
    RZ
    STC
    RET



$+PRINT
$+PRINT
;        * *  INPUT DISK DRIVE NUMBER  * *
;PURPOSE    THIS ROUTINE INPUTS A DISK DRIVE NUMBER
;        AND VERIFIES IT.
;INPUT        NONE
;OUTPUT        A = DRIVE NO (0-3)
;
;
;        DO INITIALIZATION.
INPDSKNO: DS    0
    SAVE    BC,DE,HL
;
;        REQUEST DRIVE NO.
INPDSKL: DS    0
    INPUT    'ENTER DISK DRIVE (A-D): ',TBUFF
    PRINT    <CR,LF>
;
;        VERIFY INPUT.
    LDA    TBUFF+1        ;IF INPUT LEN <>1 THEN ERR.
    CPI    1
    JNZ    INPDSKER
    LDA    TBUFF+2        ;VERIFY A-D.
    CPI    'A'
    JC    INPDSKER
    CPI    'D'+1
    JNC    INPDSKER
;
;        RETURN TO CALLER WITH ANSWER.
    SUI    'A'        ;MAKE RELATIVE TO ZERO.
    RESTORE HL,DE,BC
    RET
;
;        ERROR - RETRY.
INPDSKER: DS    0
    PRINT    <'***INVALID REPLY***',CR,LF>
    JMP    INPDSKL
;
;
;
;
$+PRINT
$+PRINT
;        * *  INPUT DIRECTORY ENTRY  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;        1.  INSURE THAT THE FIELDS ARE ENTERED IN THE SAME
;            SEQUENCE AS THE FIELDS ARE PRINTED IN 'PRTDIR'.
;
;
;
;        DO INITIALIZATION.
INPDIR:    DS    0
    SAVE            ;SAVE REGS.
;
;
;        ENTER DATSET ID.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER DATASET ID: ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPIDB
    CPI    8+1
    JNC    INPERR
    FILL    DSID,8,040H    ;MOVE SPACES TO FIELD.
    MOVAE    DSID,TBUFF+2,TBUFF+1
INPIDB:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        ENTER LOGICAL RECORD LENGTH.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER LOGICAL RECORD LENGTH (NNNNN): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;CHECK FOR PROPER LENGTH.
    ORA    A        ;...SKIP IF NO ENTRY.
    JZ    INPLRC
    CPI    5
    JNZ    INPERR        ;...INVALID
    DECIN    TBUFF+2,5    ;CONVERT TO INTERNAL FORMAT.
    JC    INPERR        ;...INVALID
    MOV    A,E        ;GET VALUE.
    CPI    1        ;RANGE CHECK (1-128).
    JC    INPERR
    CPI    128+1
    JNC    INPERR
    MOVAE    DSBLK,TBUFF+2,5 ;MOVE IT TO DIR BUFFER.
INPLRC: POP    HL        ;RESET STACK FOR NEXT INPUT.
;
;
;        ENTER BEGINNING OF EXTENT.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    PRINT    <'(BEGINNING OF EXTENT) '>
    CALL    INPTRSAD    ;GET TT0SS FOR BOE.
    JC    INPERR        ;...INVALID INPUT.
    LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
    ORA    A
    JZ    INPBOE
    MOVAE    DSBOE,TBUFF+2,5 ;MOVE IT IN PLACE.
INPBOE: POP    HL
;
;
;        ENTER END OF EXTENT.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    PRINT    <'(END OF EXTENT) '>
    CALL    INPTRSAD    ;GET TT0SS FOR BOE.
    JC    INPERR        ;...INVALID INPUT.
    LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
    ORA    A
    JZ    INPEOE
    MOVAE    DSEOE,TBUFF+2,5 ;MOVE IT IN PLACE.
INPEOE: POP    HL
;
;
;        ENTER END OF DATA.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    PRINT    <'(END OF DATA) '>
    CALL    INPTRSAD    ;GET TT0SS FOR BOE.
    JC    INPERR        ;...INVALID INPUT.
    LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
    ORA    A
    JZ    INPEOD
    MOVAE    DSEOD,TBUFF+2,5 ;MOVE IT IN PLACE.
INPEOD: POP    HL
;
;
;        ENTER CREATION DATE.
;
;
;        ENTER EXPIRATION DATE.
;
;
;        ENTER MULTI-VOLUME IND.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER MULTI-VOLUME IND (C, L, OR BLANK): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPMVIB
    JNZ    INPERR
    LDA    TBUFF+2        ;GET CHAR INPUTTED.
    CPI    'C'        ;MUST BE C, L, OR BLANK.
    JZ    $+13
    CPI    'L'
    JZ    $+8
    CPI    ' '
    JNZ    INPERR
    CALL    TRNASEB        ;MAKE IT EBCDIC.
    STA    DSMVI        ;SAVE IT.
INPMVIB:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        ENTER VOLUME SEQUENCE NUMBER.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER VOLUME SEQUENCE NUMBER (NN): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;CHECK FOR PROPER LENGTH.
    ORA    A        ;...SKIP IF NO ENTRY.
    JZ    INPVLS
    CPI    2
    JNZ    INPERR        ;...INVALID
    DECIN    TBUFF+2,2    ;CONVERT TO INTERNAL FORMAT.
    JC    INPERR        ;...INVALID
    MOV    A,E        ;GET VALUE.
    CPI    1        ;RANGE CHECK (1-99).
    JC    INPERR
    CPI    99+1
    JNC    INPERR
    MOVAE    DSVLSQ,TBUFF+2,2 ;MOVE IT TO DIR BUFFER.
INPVLS: POP    HL        ;RESET STACK FOR NEXT INPUT.
;
;
;        ENTER BYPASS IND.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER BYPASS IND (B OR BLANK): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPBYPIB
    JNZ    INPERR
    LDA    TBUFF+2
    CPI    'B'
    JZ    $+8
    CPI    ' '
    JNZ    INPERR
    CALL    TRNASEB        ;MAKE IT EBCDIC.
    STA    DSBYPI        ;SAVE IT.
INPBYPIB:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        ENTER SECURITY IND.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER SECURITY IND (NON-BLANK OR BLANK): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPSSP
    JNZ    INPERR
    LDA    TBUFF+2
    CALL    TRNASEB        ;MAKE IT EBCDIC.
    STA    DSSS        ;SAVE IT.
INPSSP:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        ENTER WRITE PROTECT IND.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER WRITE PROTECT IND (P OR BLANK): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPWPB
    JNZ    INPERR
    LDA    TBUFF+2
    CPI    'P'
    JZ    $+8
    CPI    ' '
    JNZ    INPERR
    CALL    TRNASEB        ;MAKE IT EBCDIC.
    STA    DSWP        ;SAVE IT.
INPWPB:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        ENTER VERIFY/COPY IND.
    LXI    HL,$        ;SET FOR ERROR.
    PUSH    HL
    INPUT    'ENTER VERIFY/COPY IND (C, V, OR BLANK): ',TBUFF
    PRINT
    LDA    TBUFF+1        ;VERIFY LEN (1-8).
    CPI    1
    JC    INPVCIB
    JNZ    INPERR
    LDA    TBUFF+2
    CPI    'C'
    JZ    $+13
    CPI    'V'
    JZ    $+8
    CPI    ' '
    JNZ    INPERR
    CALL    TRNASEB        ;MAKE IT EBCDIC.
    STA    DSVCI        ;SAVE IT.
INPVCIB:    POP    HL        ;RESET STACK FOR NEXT INP.
;
;
;        RETURN TO CALLER.
    RESTORE
    RET
;
;
;        ISSUE ERROR MESSAGE.
INPERR:    DS    0
    PRINT    <'***INVALID REPLY***',CR,LF>
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  INPUT SECTOR NUMBER  * *
;PURPOSE    THIS ROUTINE INPUTS A SECTOR NUMBER
;        AND VERIFIES IT.
;INPUT        NONE
;OUTPUT
;        A = SECTOR NUMBER (8-26)
;
;
;        DO INITIALIZATION.
INPSCTNO: DS    0
    SAVE    BC,DE,HL
;
;        REQUEST SECTOR NO.
INPSCTL: DS    0
    INPUT    'ENTER SECTOR NUMBER (8-26): ',TBUFF
    PRINT
;
;        VERIFY INPUT.
    LDA    TBUFF+1        ;IF INPUT LEN <1 THEN ERR.
    CPI    1
    JC    INPSCTER
    CPI    2+1        ;IF INPUT LEN > 2, THEN ERR.
    JNC    INPSCTER
    DECIN    TBUFF+2,TBUFF+1
    JC    INPSCTER    ;...CONVERSION ERROR.
    MOV    A,E
    CPI    8        ;IF <8 THEN
    JC    INPSCTER    ;   ERROR.
    CPI    26+1        ;IF >26 THEN
    JNC    INPSCTER    ;...ERROR.
;
;        RETURN TO CALLER WITH ANSWER.
    RESTORE HL,DE,BC
    RET
;
;        ERROR - RETRY.
INPSCTER: DS    0
    PRINT    <'***INVALID REPLY***',CR,LF>
    JMP    INPSCTL
;
;
;
;
$+PRINT
$+PRINT
;        * *  INPUT TRACK/SECTOR NUMBER  * *
;PURPOSE
;INPUT
;OUTPUT
;        H = TRACK NUMBER
;        L = SECTOR NUMBER
;REMARKS
;
;
;
;        DO INITIALIZATION.
INPTRSAD: DS    0
;
;
;        GET THE DATA TRACK/SECTOR.
INPTRSL: DS    0
    INPUT    'ENTER TRACK/SECTOR (TT0SS): ',TBUFF
    PRINT
;
;
;        VERIFY AND CONVERT INPUT.
    LDA    TBUFF+1        ;IF INPUT LENGTH <> 5, THEN ERROR.
    ORA    A        ;CHECK FOR INPUT GIVEN OR NOT.
    JZ    INPTRSOK    ;...NO.
    CPI    5
    JNZ    INPTRSER
;
    LXI    HL,TBUFF+2    ;VERIFY CONTENTS.
    CALL    VERTRSAD
    JC    INPTRSER    ;...INVALID.
;
;
;        RETURN TO CALLER.
INPTRSOK: DS    0
    ORA    A        ;RESET CARRY.
    RET
;
;
;        HANDLE INPUT ERROR.
INPTRSER: DS    0
    STC            ;SET CARRY.
    RET
;
;
;
$+PRINT
$+PRINT
;        * *  OUTPUT DATA TRACK/SECTOR  * *
;PURPOSE
;INPUT
;        D = TRACK NUMBER
;        E = SECTOR NUMBER
;        HL <= 5 BYTE TRACK/SECTOR (TT0SS)
;OUTPUT
;        SAME AS INPUT
;REMARKS
;
;
;        DO INITIALIZATION.
OUTTRSAD: DS    0
    SAVE            ;SAVE REGS.
;
;
;        OUTPUT THE TRACK.
    MOV    A,D        ;SET FOR CALL.        .
    CALL    OUTTRSSB    ;DO IT.
;
;
;        OUTPUT THE '0'.
    MVI    M,'0'
    INX    HL
;
;
;        OUTPUT THE SECTOR.
    MOV    A,E        ;SET FOR CALL
    CALL    OUTTRSSB    ;DO IT.
;
;
;        RETURN TO CALLER.
    RESTORE            ;RESTORE REGS.
    RET
;
;
;        OUTPUT A TRACK/SECTOR ADDRESS.
OUTTRSSB: DS    0
    PUSH    DE        ;SAVE TRK/SCT.
    PUSH    HL        ;SAVE OUTPUT PTR.
    BAU8    TWRKC3        ;CONVERT TO ASCII.
    POP    HL        ;RESTORE OUTPUT PTR.
    XCHG            ;DE <= OUTPUT
    MVC    <>,TWRKC3+1,2    ;GET TRK/SCT.
    XCHG
    POP    DE        ;RESTORE TRK/SCT.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  VERIFY DATA TRACK/SECTOR  * *
;PURPOSE
;INPUT
;        HL <= 5 BYTE TRACK/SECTOR (TT0SS)
;OUTPUT
;        H = TRACK NUMBER
;        L = SECTOR NUMBER
;REMARKS
;
;
;        DO INITIALIZATION.
VERTRSAD: DS    0
;
;
;        VERIFY THE TRACK.
    DECIN    ,2        ;CONVERT IT TO DECIMAL.
    JC    VERTRSER    ;...INVALID.
    CPI    1        ;RANGE CHECK (1-74)
    JC    VERTRSER
    CPI    74+1
    CMC
    JC    VERTRSER
    STA    VERTRSTK    ;SAVE IT.
;
;
;        VERIFY THE SECTOR NUMBER.
    DECIN    ,3        ;CONVERT IT TO DECIMAL.
    JC    VERTRSER    ;...INVALID.
    CPI    1        ;RANGE CHECK (1-26).
    JC    VERTRSER
    CPI    26+1
    CMC
    JC    VERTRSER
;
;
;        RETURN TO CALLER.
    LDA    VERTRSTK    ;PUT TRACK NUMBER IN H.
    MOV    D,A
    XCHG            ;HL = TRK/SCT
    ORA    A        ;RESET CARRY.
    RET
;
;
;        HANDLE ERROR.
VERTRSER: DS    0
    RET
;
;
;        CONSTANTS AND VARIABLES.
VERTRSTK: DS    1        ;TRACK NUMBER SAVE AREA
;
;
;
$+PRINT
$+PRINT
;        * *  VERIFY IBM DISK  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
VERIBMD: DS    0
    SAVE        ;SAVE REGS.
;
;
;        READ THE VOLSER SECTOR.
    MVI    A,7        ;READ SECTOR 7.
    CALL    REDDIR
;
;
;        VERIFY 'VOL1' ID.
    MOVEA    TBUFF,DSHD,4    ;VERIFY VOL1 CONSTANT.
    CLC    TBUFF,CVOL1,4
    JZ    VERIBMDE    ;...OK.
    PRINT    <'*** DISK VOLUME SERIAL NUMBER NOT FOUND ***',CR,LF>
    STC            ;...ERROR.
;
;
;        RETURN TO CALLER.
VERIBMDE: DS    0
    RESTORE
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  VERIFY SECTOR NUMBER  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
VERPTR: DS    0
;
;
;        RIGHT JUSTIFY INPUT.
    FILL    PTRIN,5,'0'    ;DEFAULT TO ALL ZEROES.
    LDA    TBUFF+1        ;GET INPUT LENGTH.
    CPI    1        ;VERFIY LENGTH IS 1-5.
    JC    PTRNONE
    CPI    5+1
    CMC
    RC
    MOV    C,A        ;SAVE IT.
    LXI    DE,PTRIN+4    ;MOVE DESCENDING.
    LXI    HL,TBUFF+2
    ADDHA
    DCX    HL
    MOV    A,M        ;DO THE MOVE.
    STAX    DE
    DCX    HL
    DCX    DE
    DCR    C
    JNZ    $-5
;
;
;        VERIFY THE TRACK.
    DECIN    PTRIN,2
    RC            ;...ERROR.
    MOV    A,E
    CPI    76+1
    CMC
    RC            ;...ERROR.
;
;
;        VERIFY '0'.
    LDA    PTRIN+2
    CPI    '0'
    STC
    RNZ
;
;
;        VERIFY SECTOR AND RETURN.
    DECIN    PTRIN+3,2
    RC            ;...ERROR.
    MOV    A,E
    CPI    1        ;RANGE CHECK 1-26.
    RC
    CPI    26+1
    CMC
    RET
;
;
;        RETURN W/O VERIFY.
PTRNONE: DS    0
    MVI    A,1        ;RESET CY BUT KEEP NZ.
    ORA    A
    RET
;
;
;        AREAS USED
PTRIN:    DS    5        ;TRK/SCT PTR
;
;
;
;
$+PRINT
$+PRINT
;        * *  PRINT DIRECTORY ENTRY  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
PRTDIR:    DS    0
    SAVE            ;SAVE REGS.
;
;
;        PRINT FIELDS.
    PRNTEAF    'DATASET NAME = ',DSID,8
    LDA    DSHD
    CPI    0C4H
    JNZ    PRTDIR00
    PRINT    <'    * * * DELETED * * *',CR,LF>
PRTDIR00:
    PRNTEAF    'LRECL = ',DSBLK,5
    PRNTEAF    'BOE = ',DSBOE,5
    PRNTEAF    'EOE = ',DSEOE,5
    PRNTEAF    'EOD = ',DSEOD,5
    PRNTEAF    'CREDT = ',DSCREDT,6
    PRNTEAF    'EXPDT = ',DSEXPDT,6
    PRNTEAF    'MULTI-VOLUME IND = ',DSMVI,1
    PRNTEAF    'VOL SEQ IND = ',DSVLSQ,2
    PRNTEAF    'BYPASS IND = ',DSBYPI,1
    PRNTEAF 'SECURE IND = ',DSSS,1
    PRNTEAF    'WRITE PROTECT IND = ',DSWP,1
    PRNTEAF    'VERIFY/COPY IND = ',DSVCI,1
;
;
;        RETURN TO CALLER.
    RESTORE            ;RESTORE REGS.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  DEFAULT DIR BUF DATA  * *
;PURPOSE
;INPUT
;OUTPUT
;REMARKS
;
;
;
;        DO INITIALIZATION.
DFTDIR:    DS    0
    STA    DIRSCT
;
;
;        INITIALIZE BUFFER.
    FILL    DIRBUF,80,040H        ;EBCDIC SPACES
    FILL    DIRBUF+80,48,000H
    MOVAE    DSHD,CHDR1,4        ;DDR1
    MOVAE    DSID,CDSIDD,4        ;DATA
    LXI    HL,CSCTNO        ;SECTOR NUMBER
    LDA    DIRSCT
    SUI    8
    ADD    A
    ADDHA
    MOVAE    DSID+4,,2
    MOVAE    DSBLK,CLRL80,5        ;00080
    MOVAE    DSBOE,CSPRTRK,5        ;74001
    MOVAE    DSEOE,CHGHTRK,5        ;73026
    MOVAE    DSEOD,CSPRTRK,5        ;74001
;
;
;        SET BOE,EOE,EOD FOR SECTOR 8.
    LDA    DIRSCT
    CPI    8
    JNZ    DFTDIR00
    MVI    A,'H'            ;HDR1
    CALL    TRNASEB
    STA    DSHD
    MOVAE    DSBOE,CLOWTRK,5        ;01001
    MOVAE    DSEOD,CLOWTRK,5        ;01001
DFTDIR00:
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  READ A DIRECTORY SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
REDDIR:    DS    0
    STA    DIRSCT        ;SAVE SECTOR NUMBER.
    XRA    A        ;SET TRKNO = 0.
    STA    DIRTRK
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DIRDSK        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DIRDSK        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DIRTRK        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DIRSCT        ;READ THE SECTOR
    MOV    C,A
    LXI    H,DIRBUF    ;INTO DIRBUF.
    CALL    BIOSRED
    ENDIF
    IF DMA$BIOS
    SETTRK    DIRTRK        ;SET THE TRACK NO.
    SETSEC    DIRSCT        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD        ;READ THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DIRTRK        ;SET THE TRACK NO.
    SETSEC    DIRSCT        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD        ;READ THE SECTOR.
    ENDIF

;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  WRITE A DIRECTORY SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
WRTDIR:    DS    0
    STA    DIRSCT        ;SAVE SECTOR NUMBER.
    XRA    A        ;SET TRKNO = 0.
    STA    DIRTRK
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DIRDSK        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DIRDSK        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DIRTRK        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DIRSCT        ;WRITE THE SECTOR
    MOV    C,A
    LXI    H,DIRBUF    ;FROM DIRBUF.
    CALL    BIOSWRT
    ENDIF
    IF DMA$BIOS
    SETTRK    DIRTRK        ;SET THE TRACK NO.
    SETSEC    DIRSCT        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;READ THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DIRTRK        ;SET THE TRACK NO.
    SETSEC    DIRSCT        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;READ THE SECTOR.
    ENDIF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  READ A DATA 1 SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
REDDAT1:    DS    0
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DATDSK1        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DATDSK1        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DATTRK1        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DATSCT1        ;READ THE SECTOR
    MOV    C,A
    LXI    H,DATBUF1    ;INTO DATBUF1.
    CALL    BIOSRED
    ENDIF
    IF DMA$BIOS
    SETTRK    DATTRK1        ;SET THE TRACK NO.
    SETSEC    DATSCT1        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD        ;READ THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DATTRK1        ;SET THE TRACK NO.
    SETSEC    DATSCT1        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD        ;READ THE SECTOR.
    ENDIF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  WRITE A DATA 1 SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
WRTDAT1:    DS    0
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DATDSK1        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DATDSK1        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DATTRK1        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DATSCT1        ;WRITE THE SECTOR
    MOV    C,A
    LXI    H,DATBUF1    ;FROM DATBUF1.
    CALL    BIOSWRT
    ENDIF
    IF DMA$BIOS
    SETTRK    DATTRK1        ;SET THE TRACK NO.
    SETSEC    DATSCT1        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;WRITE THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DATTRK1        ;SET THE TRACK NO.
    SETSEC    DATSCT1        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;WRITE THE SECTOR.
    ENDIF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  READ A DATA 2 SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
REDDAT2:    DS    0
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DATDSK2        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DATDSK2        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DATTRK2        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DATSCT2        ;READ THE SECTOR
    MOV    C,A
    LXI    H,DATBUF2    ;INTO DATBUF2.
    ENDIF
    IF DMA$BIOS
    SETTRK    DATTRK2        ;SET THE TRACK NO.
    SETSEC    DATSCT2        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF2    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD         ;READ THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DATTRK2        ;SET THE TRACK NO.
    SETSEC    DATSCT2        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF2    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DREAD         ;READ THE SECTOR.
    ENDIF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
$+PRINT
$+PRINT
;        * *  WRITE A DATA 2 SECTOR  * *
;PURPOSE
;INPUT
;        A = SECTOR NUMBER
;OUTPUT
;
;
;
;        DO INITIALIZATION.
WRTDAT2:    DS    0
;
;
;        READ THE SECTOR USING BIOS.
    SELDSK    DATDSK2        ;SELECT THE DISK.
    IF    NBIOS
    LDA    DATDSK2        ;SELECT IT PHYSICALLY.
    MOV    C,A
    CALL    BIOSSEL
    LDA    DATTRK2        ;SET THE TRACK.
    MOV    C,A
    CALL    BIOSSEK
    LDA    DATSCT2        ;WRITE THE SECTOR
    MOV    C,A
    LXI    H,DATBUF2    ;FROM DATBUF2.
    CALL    BIOSWRT
    ENDIF
    IF DMA$BIOS
    SETTRK    DATTRK2        ;SET THE TRACK NO.
    SETSEC    DATSCT2        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF2    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;WRITE THE SECTOR.
    ENDIF
    IF (NOT NBIOS) AND (NOT DMA$BIOS)
    SETTRK    DATTRK2        ;SET THE TRACK NO.
    SETSEC    DATSCT2        ;SET THE SECTOR NO.
    RC            ;...INVALID SECTOR.
    LXI    BC,DATBUF2    ;SET DMA TO DIRBUF.
    CALLBIOS DSETDMA
    CALLBIOS DWRITE        ;WRITE THE SECTOR.
    ENDIF
;
;
;        RETURN TO CALLER.
    RET
;
;
;
;
;        * * *  PROGRAM CONSTANTS AND AREAS  * * *
;
;        * *  GENERAL  * *
;
$+PRINT
;        *  MAIN FUNCTION TABLE  *
FNCTBL:    DS    0
    DW    RTNCPM        ;00 - RETURN TO CPM
    DW    INITDISK    ;01 - INITIALIZE A DISKETTE
    DW    CHGVOL        ;02 - CHANGE A VOLUME SERIAL NUMBER
    DW    CHGDIR        ;03 - CHANGE A DATASET ENTRY
    DW    DELDIR        ;04 - DELETE A DATASET
    DW    DSPLDIR        ;05 - DISPLAY A DATASET ENTRY
    DW    LISTDIR        ;06 - LIST THE DIRECTORY
    DW    TRSCIBLK    ;07 - TRANSFER CP/M TO 3740 (BLOCKED)
    DW    TRSICBLK    ;08 - TRANSFER 3740 TO CP/M (BLOCKED)
    DW    TRSCISRC    ;09 - TRANSFER CP/M TO 3740 (SOURCE)
    DW    TRSICSRC    ;10 - TRANSFER 3740 TO CP/M (SOURCE)
    DW    DSPIBMDS    ;11 - DISPLAY AN IBM DATASET
;
;        *  CONSTANTS  *
CVOL1:    DB    'VOL1'        ;VOLUME SECTOR ID
CHDR1:    DB    'DDR1'        ;DATASET SECTOR ID
CSPRTRK: DB    '74001'        ;SPARE TRACK PTR
CHGHTRK: DB    '73026'        ;HIGH TRACK PTR
CLOWTRK: DB    '01001'        ;LOW TRACK PTR
CLRL80: DB    '00080'        ;DEFAULT RECORD LENGTH
CDSIDD:    DB    'DATA'        ;DEFAULT DATASET ID
CERMAP: DB    'ERMAP'        ;ERMAP SECTOR ID
CSCTNO: DB    '  091011121314151617'    ;ASCII SECTOR NUMBERS.
    DB    '181920212223242526'
CEOL:    DB    CR,LF,'$'
CSPACES: DB    '        '    ;8 SPACES
;
;        * GENERAL VARIABLES *
VOLSER: DS    6        ;VOLUME SERIAL NUMBER
RCDCNT: DW    0        ;RECORD COUNT
;
;        * TRANSFER VARIABLES *
CPMDSKNO: DS    1        ;CP/M DISK DRIVE
IBMDSKNO: DS    1        ;IBM DISK DRIVE
TDSN:    DS    8        ;DATASET NAME
TDSBOE:    DS    2        ;IBM BOE (INTERNAL)
TDSEOE:    DS    2        ;IBM EOE (INTERNAL)
TDSEOD:    DS    2        ;IBM EOD (INTERNAL)
BLKLEN: DS    2        ;IBM BLOCK LENGTH (INTERNAL)
TRSFCB:    DS    33        ;CP/M FCB FOR TDSN
TWRKC3:    DS    3        ;CHAR WORK AREA
TRSERR:    DS    1        ;TRANSFER ERROR COUNT
TRSBUFP: DS    2        ;CURRENT BUFFER POINTER.
TRSBUFA: DS    1        ;CURRENT # OF BYTES REMAINING IN BUFFER
;
;
$+PRINT
$+PRINT
;        * *  DISK I/O BUFFERS  * *
;
;        * IBM DIRECTORY BUFFER *
DIRDSK:    DS    1        ;CURRENT DISK NO
DIRTRK:    DS    1        ;CURRENT TRACK NO
DIRSCT:    DS    1        ;CURRENT SECTOR NO
DIRBUF:    DS    0
DSHD:    DS    4        ;'HDR1'
    DS    1        ;RESERVED
DSID:    DS    8        ;DATASET IDENTIFIER
    DS    9        ;**RESERVED
DSBLK:    DS    5        ;BLOCK LENGTH OR PHYSICAL
;                ;RECORD SIZE
DSATTR:    DS    1        ;RECORD ATTRIBUTE
;                ;  B - RECORDS UNBLOCKED, UNSPANNED
;                ;  R - RECORDS BLOCKED, SPANNED
;                ;  B - RECORDS BLOCKED, UNSPANNED
DSBOE:    DS    5        ;GEGINNING OF EXTENT
DSPRL:    DS    1        ;PHYSICAL RECORD LENGTH
;                ;  B - 128 BYTES
;                ;  1 - 256 BYTES
;                ;  2 - 512 BYTES
DSEOE:    DS    5        ;END OF EXTENT
DSRBF:    DS    1        ;RECORD/BLOCK FORMAT
;                ;  MUST BE B OR F
DSBYPI:    DS    1        ;BYPASS INDICATOR
;                ;  B - TRANSFER DATA
;                ;  B - BYPASS TRANSFER
DSSS:    DS    1        ;DATASET SECURITY
;                ;  B - NOT SECURED
;                ;  ANYTHING - SECURED
DSWP:    DS    1        ;WRITE PROTECT
;                ;  B - READ AND WRITE VALID
;                ;  P - READ ONLY
DSETI:    DS    1        ;EXCHANGE TYPE INDICATOR
;                ;  B - BASIC DATA EXCHANGE
;                ;  ANYTHING - ADDITIONAL
;                ;      CHECKING REQUIRED
DSMVI:    DS    1        ;MULTI-VOLUME INDICATOR
;                ;  B - DATASET RESIDES ON
;                ;      VOLUME ONLY
;                ;  C - DATASET IS CONTINUED
;                ;      ON ANOTHER VOLUME
;                ;  L - LAST VOLUME OF DATA-
;                ;      SET
DSVLSQ:    DS    2        ;VOLUME SEQUENCE NUMBER
DSCREDT: DS    6        ;CREATION DATE (YYMMDD)
DSRL:    DS    4        ;RECORD LENGTH
DSONRS:    DS    5        ;OFFSET TO NEXT RECORD SPACE
    DS    4        ;**RESERVED
DSEXPDT: DS    6        ;EXPIRATION DATE (YYMMDD)
DSVCI:    DS    1        ;VERIFY/COPY INDICATOR
;                ;  B - DATASET CREATED
;                ;  C - SUCCESSFULLY COPIED
;                ;  V - DATASET VERIFIED
    DS    1        ;**RESERVED
DSEOD:    DS    5        ;END OF DATA
    DS    1        ;**RESERVED
DSLV:    DS    48        ;**RESERVED - LOW VALUES
;
;        *  DATA BUFFER 1  *
DATDSK1: DS    1        ;CURRENT DISK NO
DATTRK1: DS    1        ;CURRENT TRACK
DATSCT1: DS    1        ;CURRENT SECTOR
    ORG    $+(($+7)MOD 256) ;ORG TO 8-BYTE BOUNDARY
DATBUF1: DS    0
DATA1:    DS    80
    DS    48        ;FILLER
;
;        *  DATA BUFFER 2  *
DATDSK2: DS    1        ;CURRENT DISK NO
DATTRK2: DS    1        ;CURRENT TRACK NO
DATSCT2: DS    1        ;CURRENT SECTOR NO
    ORG    $+(($+7)MOD 256) ;ORG TO 8-BYTE BOUNDARY
DATBUF2: DS    0
DATA2:    DS    80
    DS    48        ;FILLER
;
;
;
$+PRINT
$+PRINT
;FILE        TRNSUBS.LIB
;        * * * *  CHARACTER TRANSLATIONS  * * * *
;PURPOSE    THESE ROUTINES PROVIDE THE MEANS OF TRANS-
;        LATING CHARACTERS FROM ASCII TO EBCDIC OR
;        VICE VERSA.  ALSO, THEY PROVIDE A MEANS
;        FOR REMOVING UNWANTED CHARACTERS FROM PRINT
;        LINES SUCH AS FOR A DUMP OF CORE.
;INPUT
;        A = CHARACTER TO BE TRNASLATED
;OUTPUT
;        A = TRANSLATED CHARACTER
;REMARKS
;        1.  EACH SUBROUTINE WILL ONLY BE GENERATED
;            IF ITS GLOBAL IS SET TO TRUE.  THE GLO-
;            BALS ARE:
;            @TRNASEB - ASCII TO EBCDIC
;            @TRNEBAS - EBCDIC TO ASCII
;            @OUTTRN - OUTPUT TRANSLATION
;
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSLATE ASCII TO EBCDIC  * * *
;PURPOSE    THIS ROUTINE TRANSLATES AN ASCII CHARACTER
;        TO EBCDIC.
;INPUT
;        A = ASCII CHARACTER
;OUTPUT
;        A = EBCDIC CHARACTER
;
;
;        DO INITIALIZATION.
    IF    @TRNASEB
TRNASEB: DS    0
    PUSH    BC        ;SAVE REGS.
    PUSH    HL
    MOV    C,A
;
;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
    ANI    07FH        ;ZERO HIGH ORDER BIT.
    MVI    B,0        ;BC=A
    MOV    C,A
    LXI    HL,ASEBTBL    ;HL=>TABLE.
    DAD    BC        ;INDEX INTO TABLE.
    MOV    A,M        ;GET TRNLTD CHAR.
;
;        RETURN TO CALLER.
    POP    HL        ;RESTORE REGS.
    POP    BC
    RET
;
;
;
;        * *  ASCII TO EBCDIC TRANSLATION TABLE  * *
;
ASEBTBL: DS    0
    DB    000H,001H,002H,003H,004H,02DH,02EH,02FH        ;000-007
    DB    016H,005H,025H,00BH,00CH,00DH,00EH,00FH        ;008-015
    DB    010H,011H,012H,013H,014H,03DH,032H,026H        ;016-023
    DB    018H,019H,03FH,027H,01CH,01DH,01EH,01FH        ;024-031
    DB    040H,05AH,07FH,07BH,05BH,06CH,050H,07DH        ;032-039
    DB    04DH,05DH,05CH,04EH,06BH,060H,04BH,061H        ;040-047
    DB    0F0H,0F1H,0F2H,0F3H,0F4H,0F5H,0F6H,0F7H        ;048-055
    DB    0F8H,0F9H,07AH,05EH,04CH,07EH,06EH,06FH        ;056-063
    DB    07CH,0C1H,0C2H,0C3H,0C4H,0C5H,0C6H,0C7H        ;064-071
    DB    0C8H,0C9H,0D1H,0D2H,0D3H,0D4H,0D5H,0D6H        ;072-079
    DB    0D7H,0D8H,0D9H,0E2H,0E3H,0E4H,0E5H,0E6H        ;080-087
    DB    0E7H,0E8H,0E9H,0ADH,0E0H,0BDH,05FH,06DH        ;088-095
    DB    079H,081H,082H,083H,084H,085H,086H,087H        ;096-103
    DB    088H,089H,091H,092H,093H,094H,095H,096H        ;104-111
    DB    097H,098H,099H,0A2H,0A3H,0A4H,0A5H,0A6H        ;112-119
    DB    0A7H,0A8H,0A9H,0C0H,06AH,0D0H,0A1H,007H        ;120-127
    ENDIF
;
;
;
;
$+PRINT
$+PRINT
;        * * *  TRANSLATE EBCDIC TO ASCII  * * *
;PURPOSE    THIS ROUTINE TRANSLATES AN EBCDIC CHARACTER
;        TO ASCII.
;INPUT
;        A = EBCDIC CHARACTER
;OUTPUT
;        A = ASCII CHARACTER
;
;
;        DO INITIALIZATION.
    IF    @TRNEBAS
TRNEBAS: DS    0
    PUSH    BC        ;SAVE REGS.
    PUSH    HL
    MOV    C,A
;
;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
    MVI    B,0        ;BC=A
    MOV    C,A
    LXI    HL,EBASTBL    ;HL=>TABLE.
    DAD    BC        ;INDEX INTO TABLE.
    MOV    A,M        ;GET TRNLTD CHAR.
;
;        RETURN TO CALLER.
    POP    HL        ;RESTORE REGS.
    POP    BC
    RET
;
;
;
;        * *  EBCDIC TO ASCII TRANSLATION TABLE  * *
;
EBASTBL: DS    0
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;00-07
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;08-0F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;10-17
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;18-1F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;20-27
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;28-2F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;30-37
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;38-3F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;40-47
    DB    020H,020H,020H,02EH,03CH,028H,02BH,07CH        ;48-4F
    DB    026H,020H,020H,020H,020H,020H,020H,020H        ;50-57
    DB    020H,020H,021H,024H,02AH,029H,03BH,07EH        ;58-5F
    DB    02DH,02FH,020H,020H,020H,020H,020H,020H        ;60-67
    DB    020H,020H,020H,02CH,025H,05FH,03EH,03FH        ;68-6F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;70-77
    DB    020H,020H,03AH,023H,040H,027H,03DH,022H        ;78-7F
    DB    024H,020H,020H,020H,020H,020H,020H,020H        ;80-87
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;88-8F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;90-97
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;98-9F
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;A0-A7
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;A8-AF
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;B0-B7
    DB    020H,020H,020H,020H,020H,020H,020H,020H        ;B8-BF
    DB    020H,041H,042H,043H,044H,045H,046H,047H        ;C0-C7
    DB    048H,049H,020H,020H,020H,020H,020H,020H        ;C8-CF
    DB    020H,04AH,04BH,04CH,04DH,04EH,04FH,050H        ;D0-D7
    DB    051H,052H,020H,020H,020H,020H,020H,020H        ;D8-DF
    DB    020H,020H,053H,054H,055H,056H,057H,058H        ;E0-E7
    DB    059H,05AH,020H,020H,020H,020H,020H,020H        ;E8-EF
    DB    030H,031H,032H,033H,034H,035H,036H,037H        ;F0-F7
    DB    038H,039H,020H,020H,020H,020H,020H,020H        ;F8-FF
    ENDIF
;
;
;
;
$+PRINT
$+PRINT
;        * * *  OUPUT TRANSLATION  * * *
;
;PURPOSE    THE FOLLOWING ROUTINE AND TABLE ARE
;        USED FOR OUTPUT TRANSLATION OF NON-
;        PRINTABLE CHARACTERS.  FOR INSTANCE,
;        IF THE CHARACTER IS A <CR>, IT WILL
;        BE PRINTED AS A SPACE.
;PROGRAMMER    ROBERT M. WHITE
;DATE CODED    MAY 23, 1977
;INPUT        A = CHARACTER TO BE TRANSLATED.
;OUTPUT        A = TRANSLATED CHARACTER
;
;
;
;        DO INITIALIZATION.
    IF    @OUTTRN
OUTTRN: DS    0
    PUSH    BC        ;SAVE REGS.
    PUSH    HL
    MOV    C,A
;
;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
    ANI    07FH        ;ZERO HIGH ORDER BIT.
    MVI    B,0        ;BC=A
    MOV    C,A
    LXI    HL,OUTTBL    ;HL=>TABLE.
    DAD    BC        ;INDEX INTO TABLE.
    MOV    A,M        ;GET TRNLTD CHAR.
;
;        RETURN TO CALLER.
    POP    HL        ;RESTORE REGS.
    POP    BC
    RET
;
;
;        * *  TRANSLATION TABLE  * *
OUTTBL:    DB    '                '    ;000 - 015
    DB    '                '    ;016 - 031
    DB    ' !"#$%&',027H,'()*+,-./'    ;032 - 047
    DB    '0123456789:;<=>?'    ;048 - 063
    DB    '@ABCDEFGHIJKLMNO'    ;064 - 079
    DB    'PQRSTUVWXYZ[\]^_'    ;080 - 095
    DB    ' abcdefghijklmno'    ;096 - 111
    DB    'pqrstuvwxyz{|}  '    ;112 - 127
    ENDIF
;
;
;
;
$+PRINT
;END        TRNSUBS.LIB
    END