Oakland CPM Archive/oakcpm.iso/sigm/vol119/lrun20.asm

Assembly Source File | 1984-04-29 | 19.9 KB | 908 lines

TITLE    'LRUN  Library Run--a utility for .LBR files'
VERSION    EQU    2$0    ;82-11-19 Added equates for user
;             area to search for command.lbr.
;
;        1$0    ;82-08-06 Initial source release
    PAGE    60
;
; Requires MAC for assembly.  Due to the complexity of
; the relocation macros, this program may take a while
; to assemble.    Be prepared for periods of no disk activity
; on both passes before pressing panic button.    G.P.N.
;

;--------------------------NOTICE------------------------------
;
;   (c) Copyright 1982    Gary P. Novosielski
;    All rights reserved.
;
;   The following features courtesy of Ron Fowler:
;    1) command line reparsing and repacking (this allows
;    the former load-only program to become a load & run
;    utility).
;    2) code necessary to actually execute the loaded file
;    3) the HELP facility (LRUN with no arguments)
;    4) modified error routines to avoid warm-boot delay
;       (return to CCP directly instead)
;
;    Permission to distribute this program in source or
;    object form without prior written aproval is granted
;    only under the following conditions.
;
;        1. No charge is imposed for the program.
;        2. Charges for incidental costs including
;           but not limited to media, postage, tele-
;           communications, and data storage do not
;           exceed those costs actually incurred.
;        3. This Notice and any copright notices in
;           the object code remain intact
;
;            (signed)  Gary P. Novosielski
;
;--------------------------------------------------------------
;
; LRUN is intended to be used in conjunction with libraries
; created with LU.COM, a library utility based upon the
; groundwork laid by Michael Rubenstein, with some additional
; inspiration from Leor Zolman's CLIB librarian for .CRL files.
;
; The user can place the less frequently used command (.COM)
; files in a library to save space, and  still be able to run
; them when required, by typing:
;     LRUN <normal command line>.
; The name of the library can be specified, but the greatest
; utility will be achieved by placing all commands in one
; library called COMMAND.LBR, or some locally defined name,
; and always letting LRUN use that name as the default.
;

;Syntax:
;    LRUN [-<lbrname>] <command> [<parameters>]
;
;where:
;<lbrname>    is the optional library name.  In the
;        distrubution version, this defaults to
;        COMMAND.LBR.  If the user wishes to use a
;        different name for the default, the 8-byte
;        literal at DFLTNAM below may be changed to
;        suit local requirements. The current drive
;        is searched for the .LBR file, and if not
;        found there, the A: drive is searched.
;        **Note that the leading minus sign (not a part
;        of the name) is required to indicate an
;        override library name is being entered.
;
;<command>    is the name of the .COM file in the library
;
;<line>        is the (possibly empty) set of parameters
;        which are to be passed to <command>, as in
;        normal CP/M syntax.  Notice that if the
;        library name is defaulted, the syntax is
;        simply:
;     LRUN <command line>
;        which is just the normal command line with
;        LRUN prefixed to it.
;
;--------------------------------------------------------------
;        USER MODIFIABLE EQUATES
;
;    Define a secondary search drive and user if .LBR is
;    not found after initial search of current area:
;
SSDRV:    EQU    'A'    ;Valid values are 'A' through 'P'.
SSUSR:    EQU    0    ;Valid values are  0  through 31.
;
;Default library may also be modified.  See label DFLTNAM.
;--------------------------------------------------------------
;
QUERY    SET    -1
@SYS    SET    0
@KEY    SET    1
@CON    SET    2
@RDR    SET    3
@PUN    SET    4
@LST    SET    5
@DIO    SET    6
@RIO    SET    7
@SIO    SET    8
@MSG    SET    9
@INP    SET    10
@RDY    SET    11
@VER    SET    12
@LOG    SET    13
@DSK    SET    14
@OPN    SET    15
@CLS    SET    16
@DIR    SET    17
@NXT    SET    18
@DEL    SET    19
@FRD    SET    20
@FWR    SET    21
@MAK    SET    22
@REN    SET    23
@CUR    SET    25
@DMA    SET    26
@CHG    SET    30
@USR    SET    32
@RRD    SET    33
@RWR    SET    34
@SIZ    SET    35
@REC    SET    36
@LOGV    SET    37    ;2.2 only
@RWR0    SET    40    ;2.2 only
;
CPMBASE EQU    0
BOOT    SET    CPMBASE
BDOS    SET    BOOT+5
TFCB    EQU    BOOT+5CH
TFCB1    EQU    TFCB
TFCB2    EQU    TFCB+16
TBUFF    EQU    BOOT+80H
TPA    EQU    BOOT+100H
CTRL    EQU    ' '-1        ;Ctrl char mask
CR    SET    CTRL AND 'M'
LF    SET    CTRL AND 'J'
TAB    SET    CTRL AND 'I'
FF    SET    CTRL AND 'L'
BS    SET    CTRL AND 'H'
FALSE    SET    0
TRUE    SET    NOT FALSE
;
CPM    MACRO    FUNC,OPERAND,CONDTN
    LOCAL    PAST
    IF    NOT NUL CONDTN
    DB    ( J&CONDTN ) XOR 8
    DW    PAST
    ENDIF        ;;of not nul condtn
    IF    NOT NUL OPERAND
    LXI    D,OPERAND
    ENDIF        ;;of not nul operand
    IF    NOT NUL FUNC
    MVI    C,@&FUNC
    ENDIF
    CALL    BDOS
PAST:
    ENDM
;
BLKMOV    MACRO    DEST,SRCE,LEN,COND
    LOCAL    PAST
    JMP    PAST
@BMVSBR:
    MOV    A,B
    ORA    C
    RZ
    DCX    B
    MOV    A,M
    INX    H
    STAX    D
    INX    D
    JMP    @BMVSBR
BLKMOV    MACRO    DST,SRC,LN,CC
    LOCAL    PST
    IF    NOT NUL CC
    DB    ( J&CC ) XOR 8
    DW    PST
    ENDIF
    IF    NOT NUL DST
    LXI    D,DST
    ENDIF
    IF    NOT NUL SRC
    LXI    H,SRC
    ENDIF
    IF    NOT NUL LN
    LXI    B,LN
    ENDIF
    CALL    @BMVSBR
    IF    NOT NUL CC
PST:
    ENDIF
    ENDM
PAST:    BLKMOV    DEST,SRCE,LEN,COND
    ENDM

;
OVERLAY SET    0
; Macro Definitions
;
RTAG    MACRO    LBL
??R&LBL EQU    $+2-@BASE
    ENDM
;
RGRND    MACRO    LBL
??R&LBL EQU    0FFFFH
    ENDM
;
R    MACRO    INST
@RLBL    SET    @RLBL+1
    RTAG    %@RLBL
    INST-@BASE
    ENDM
;
NXTRLD    MACRO    NN
@RLD    SET    ??R&NN
@NXTRLD SET    @NXTRLD + 1
    ENDM
;
;
; Enter here from Console Command Processor (CCP)
;
CCPIN    ORG    TPA
    JMP    INTRO        ;Jump around signon
;
SIGNON:
    DB    'LRUN Ver '    ;Signon message
    DB    VERSION/10+'0'
    DB    '.'
    DB    VERSION MOD 10+'0'
    DB    CR,LF
    DB    ' Copyright (c) 1982  Gary P. Novosielski '
    DB    '$',CTRL AND 'Z'
;
INTRO:
    LXI    H,0        ;get the CCP entry stackpointer
    DAD    SP        ;(used only if HELP request
    SHLD    SPSAVE        ; is encountered)
    CPM    MSG,SIGNON;    ;Display signon
    CALL    SETUP        ;initialize.
    LHLD    BDOS+1        ;find top of memory
    MOV    A,H        ;page address
                ;Form destination...
    SUI    PAGES         ;...address in
    MOV    D,A        ;DE pair.
    MVI    E,0
    PUSH    D        ;save on stack
;
    BLKMOV    ,@BASE,SEGLEN    ;Move the active segment.
;
;The segment is now moved to high memory, but not
;properly relocated.  The bit table which specifies
;which addresses need to be adjusted is located
;just after the last byte of the source segment,
;so (HL) is now pointing at it.
    POP    D    ;beginning of newly moved code.
    LXI    B,SEGLEN;length of segment
    PUSH    H    ;save pointer to reloc info
    MOV    H,D    ;offset page address
;
FIXLOOP:
;Scan through the newly moved code, and adjust any
;page addresses by adding (H) to them.    The word on
;top of the stack points to the next byte of the
;relocation bit table.    Each bit in the table
;corresponds to one byte in the destination code.
;A value of 1 indicates the byte is to be adjusted.
;A value of 0 indicates the byte is to be unchanged.
;
;Thus one byte of relocation information serves to
;mark 8 bytes of object code.  The bits which have
;not been used yet are saved in L until all 8
;are used.
;
    MOV    A,B
    ORA    C        ;test if finished
    JZ    FIXDONE
    DCX    B        ;count down
    MOV    A,E
    ANI    07H        ;on 8-byte boundry?
    JNZ    NEXTBIT
;
NEXTBYT:
;Get another byte of relocation bits
    XTHL
    MOV    A,M
    INX    H
    XTHL
    MOV    L,A        ;save in register L
;
NEXTBIT MOV    A,L        ;remaining bits from L
    RAL            ;next bit to CARRY
    MOV    L,A        ;save the rest
    JNC    NEXTADR
;
;CARRY was = 1.  Fix this byte.
    LDAX    D
    ADD    H        ;(H) is the page offset
    STAX    D
;
NEXTADR INX    D
    JMP    FIXLOOP
;
FIXDONE:
;Finished.  Jump to the first address in the new
;segment in high memory.
;
;First adjust the stack.  One garbage word was
;left by fixloop.
    INX    SP
    INX    SP
;
;(HL) still has the page address
    MOV    L,A    ;move zero to l
    PCHL        ;Stack is valid
SETUP:
;Any one-shot initialization code goes here.
;
    LXI    H,NOLOAD
    SHLD    CCPIN+1     ;Prevent reentry
;
;
    CPM    VER        ;Test version of CP/M in use
    CPI    20H        ;2.0 or better?
    JC    BADVER        ;No, bitch and quit.
;
    CPM    USR,QUERY    ;What's the current user area?
    STA    ENTUSR        ;Save for later.
;
    CALL    REPARS        ;Re-parse command line
;
    LXI    D,MEMBER+9    ;Check member filetype
    LDAX    D
    CPI    ' '        ;If blank,
    BLKMOV    ,COMLIT,3,Z    ; default to COM.
;
    LXI    D,LBRFIL+9    ;Check library filetype
    LDAX    D
    CPI    ' '        ;If blank,
    BLKMOV    ,LBRLIT,3,Z    ; default to LBR
;
    LXI    D,LBRFIL+1    ;Check name
    LDAX    D
    CPI    ' '        ;If blank,
    BLKMOV    ,DFLTNAM,8,Z    ; use default name.
;
;
DIROPN: CPM    OPN,LBRFIL    ;Open for directory read.
    INR    A        ;Was it found?
    JNZ    DIROK        ;yes, ok
    LXI    H,LBRFIL    ;No, test drive spec
    MOV    A,M        ; to see if it's
    ORA    A        ; explicit
    JNZ    NODIR        ;It is explicit.  Out of luck
    MVI    M,SSDRV-'@'    ;Look on secondary drive,
    CPM    USR,SSUSR    ; in secondary user.
    JMP    DIROPN        ; before giving up.
;
DIROK:
    CPM    DMA,TBUFF
FINDMBR:
    CPM    FRD,LBRFIL    ;Read the directory
    ORA    A
    JNZ    FISHY        ;Empty file, Give up.
    LXI    H,TBUFF
    MOV    A,M
    ORA    A
    JNZ    FISHY        ;Directory not active??
    MVI    B,8+3        ;Check for blanks
    MVI    A,' '
VALIDLOOP:
    INX    H
    CMP    M
    JNZ    FISHY
    DCR    B
    JNZ    VALIDLOOP
;
    LHLD    TBUFF+1+8+3    ;Index must be 0000
    MOV    A,H
    ORA    L
    JNZ    FISHY
;
    LHLD    TBUFF+1+8+3+2    ;Get directory size
    DCX    H        ;We already read one.
    PUSH    H        ;Save on stack
    JMP    FINDMBRN    ;Jump into loop
FINDMBRL:
    POP    H        ;Read sector count from TOS
    MOV    A,H
    ORA    L        ;0 ?
    JZ    NOMEMB        ;Member not found in library
    DCX    H        ;Count down
    PUSH    H        ;and put it back.
    CPM    FRD,LBRFIL    ;Get next directory sector
    ORA    A
    JNZ    FISHY


FINDMBRN:
    LXI    H,TBUFF       ;Point to buffer.
    MVI    C,128/32    ;Number of directory entries
;
FINDMBR1:
    CALL    COMPARE     ;Check if found yet.
    JZ    GETLOC        ;Found member in .DIR
    DCR    C
    JZ    FINDMBRL
;
    LXI    D,32        ;No match, point to next one.
    DAD    D
    JMP    FINDMBR1
;
GETLOC:     ;The name was found now get index and length
    POP    B    ;Clear stack garbage
    XCHG        ;Pointer to sector address.
    MOV    E,M    ;Get First
    INX    H
    MOV    D,M
    XCHG
    SHLD    INDEX    ;Save it
    XCHG
    INX    H    ;Get Size to DE
    MOV    E,M
    INX    H
    MOV    D,M
    XCHG        ; Size to HL
    SHLD    LENX
    CALL    PACKUP    ;Repack command line arguments
    CPM    CON,CR    ;do <cr> only (look like CCP)
    RET
;        End of setup.
;
;    Utility subroutines
NEGDE:            ;DE = -DE
    MOV    A,D
    CMA
    MOV    D,A
;
    MOV    A,E
    CMA
    MOV    E,A
    INX    D
    RET
;
;    REPARSE re-parses the fcbs from the command line,
;    to allow the "-" character to prefix the library name
;
REPARS: LXI    D,MEMBER    ;first reinitialize both fcbs
    CALL    NITF
    LXI    D,LBRFIL
    CALL    NITF
    LXI    H,TBUFF     ;store a null at the end of
    MOV    E,M        ; the command line (this is
    MVI    D,0        ; done by CP/M usually, except
    XCHG            ; in the case of a full com-
    DAD    D        ; mand line
    INX    H
    MVI    M,0
    XCHG            ;tbuff pointer back in hl
SCANBK: INX    H        ;bump to next char position
    MOV    A,M        ;fetch next char
    ORA    A        ;reached a null? (no arguments)
    JZ    HELP        ;interpret as a call for help
    CPI    ' '        ;not null, skip blanks
    JZ    SCANBK
    CPI    '-'        ;library name specifier?
    JNZ    NOTLBR        ;skip if not
    INX    H        ;it is, skip over flag character
    LXI    D,LBRFIL    ;parse library name into FCB
    CALL    GETFN
NOTLBR: LXI    D,MEMBER    ;now parse the command name
    CALL    GETFN
    LXI    D,HOLD+1    ;pnt to temp storage for rest of cmd line
    MVI    B,-1        ;init a counter
CLSAVE: INR    B        ;bump up counter
    MOV    A,M        ;fetch a char
    STAX    D        ;move it to hold area
    INX    H        ;bump pointers
    INX    D
    ORA    A        ;test whether char was a terminator
    JNZ    CLSAVE        ;continue moving line if not
    MOV    A,B        ;it was, get count
    STA    HOLD        ;save it in hold area
    RET
;
;    PACKUP retrieves the command line stored at
;    HOLD and moves it back to tbuff, then reparses
;    the default file control blocks so the command
;    will never know it was run from a library
;
PACKUP: LXI    H,HOLD        ;point to length byte of HOLD
    MOV    C,M        ;get length in BC
    MVI    B,0
    INX    B        ;bump up to because length byte doesn't
    INX    B        ;  include itself or null terminator
    BLKMOV    TBUFF        ;moving everybody to Tbuff
    LXI    H,TBUFF+1    ;point to the command tail
    LXI    D,TFCB1     ;first parse out tfcb1
    CALL    GETFN
    LXI    D,TFCB2     ;then tfcb2
    CALL    GETFN
    RET
;
;    Here when HELP is requested (indicated
;    by LRUN with no arguments)
;
HELP:    CPM    MSG,HLPMSG    ;print the HELP message
EXIT:    LHLD    SPSAVE        ;find CCP re-entry adrs
    SPHL            ;fix & return
    RET
;
;    the HELP message
;
HLPMSG: DB    CR,LF,'Correct syntax is:'
    DB    CR,LF
    DB    LF,TAB,'LRUN [-<lbrname>] <command line>'
    DB    CR,LF
    DB    LF,'Where <lbrname> is the optional library name'
    DB    CR,LF,'(Note the preceding "-".  ) If omitted,'
    DB    CR,LF,'the default command library is used.'
    DB    LF
    DB    CR,LF,'<command line> is the name and parameters'
    DB    CR,LF,'of the command being run from the library,'
    DB    CR,LF,'just as if a separate .COM file were being run.'
    DB    CR,LF,'$'
;
;
COMPARE:        ;Test status, name and type of
    PUSH    H        ;a directory entry.
    MVI    B,1+8+3
    XCHG            ;with the one we're
    LXI    H,MEMBER    ;looking for.
COMPAR1:
    LDAX    D
    CMP    M
    JNZ    COMPEXIT
    INX    D
    INX    H
    DCR    B
    JNZ    COMPAR1
COMPEXIT:            ;Return with DE pointing to
    POP    H        ;last match + 1, and HL still
    RET            ;pointing to beginning.
;
;
;    File name parsing subroutines
;
; getfn gets a file name from text pointed to by reg hl into
; an fcb pointed to by reg de.    leading delimeters are
; ignored.
; entry hl    first character to be scanned
;    de    first byte of fcb
; exit    hl    character following file name
;
;
;
GETFN:    CALL    NITF    ;init 1st half of fcb
    CALL    GSTART    ;scan to first character of name
    RZ        ;end of line was found - leave fcb blank
    CALL    GETDRV    ;get drive spec. if present
    CALL    GETPS    ;get primary and secondary name
    RET


;
; nitf fills the fcb with dflt info - 0 in drive field
; all-blank in name field, and 0 in ex,s1,s2 and rc flds
;
NITF:    PUSH    D    ;save fcb loc
    XCHG        ;move it to hl
    MVI    M,0    ;zap dr field
    INX    H    ;bump to name field
    MVI    B,11    ;zap all of name fld
NITLP1: MVI    M,' '
    INX    H
    DCR    B
    JNZ    NITLP1
    MVI    B,4    ;zero others
NITLP2: MVI    M,0
    INX    H
    DCR    B
    JNZ    NITLP2
    XCHG        ;restore hl
    POP    D    ;restore fcb pointer
    RET
;
; gstart advances the text pointer (reg hl) to the first
; non delimiter character (i.e. ignores blanks).  returns a
; flag if end of line (00h or ';') is found while scaning.
; exit    hl    pointing to first non delimiter
;    a    clobbered
;    zero    set if end of line was found
;
GSTART: CALL    GETCH    ;see if pointing to delim?
    RNZ        ;nope - return
    CPI    ';'    ;end of line?
    RZ        ;yup - return w/flag
    ORA    A
    RZ        ;yup - return w/flag
    INX    H    ;nope - move over it
    JMP    GSTART    ;and try next char
;
; getdrv checks for the presence of a drive spec at the text
; pointer, and if present formats it into the fcb and
; advances the text pointer over it.
; entry hl    text pointer
;    de    pointer to first byte of fcb
; exit    hl    possibly updated text pointer
;    de    pointer to second (primary name) byte of fcb
;
GETDRV: INX    D    ;point to name if spec not found
    INX    H    ;look ahead to see if ':' present
    MOV    A,M
    DCX    H    ;put back in case not present
    CPI    ':'    ;is a drive spec present?
    RNZ        ;nope - return
    MOV    A,M    ;yup - get the ascii drive name
    SUI    'A'-1    ;convert to fcb drive spec
    DCX    D    ;point back to drive spec byte
    STAX    D    ;store spec into fcb
    INX    D    ;point back to name
    INX    H    ;skip over drive name
    INX    H    ;and over ':'
    RET
;
; getps gets the primary and secondary names into the fcb.
; entry hl    text pointer
; exit    hl    character following secondary name (if present)
;
GETPS:    MVI    C,8    ;max length of primary name
    CALL    GETNAM    ;pack primary name into fcb
    MOV    A,M    ;see if terminated by a period
    CPI    '.'
    RNZ        ;nope - secondary name not given
            ;return default (blanks)
    INX    H    ;yup - move text pointer over period
FTPOINT:MOV    A,C    ;yup - update fcb pointer to secondary
    ORA    A
    JZ    GETFT
    INX    D
    DCR    C
    JMP    FTPOINT
GETFT:    MVI    C,3    ;max length of secondary name
    CALL    GETNAM    ;pack secondary name into fcb
    RET
;
; getnam copies a name from the text pointer into the fcb for
; a given maximum length or until a delimiter is found, which
; ever occurs first.  if more than the maximum number of
; characters is present, characters are ignored until a
; a delimiter is found.
; entry hl    first character of name to be scaned
;    de    pointer into fcb name field
;    c    maximum length
; exit    hl    pointing to terminating delimiter
;    de    next empty byte in fcb name field
;    c    max length - number of characters transfered
;
GETNAM: CALL    GETCH    ;are we pointing to a delimiter yet?
    RZ        ;if so, name is transfered
    INX    H    ;if not, move over character
    CPI    '*'    ;ambigious file reference?
    JZ    AMBIG    ;if so, fill the rest of field with '?'
    STAX    D    ;if not, just copy into name field
    INX    D    ;increment name field pointer
    DCR    C    ;if name field full?
    JNZ    GETNAM    ;nope - keep filling
    JMP    GETDEL    ;yup - ignore until delimiter
AMBIG:    MVI    A,'?'    ;fill character for wild card match
QFILL:    STAX    D    ;fill until field is full
    INX    D
    DCR    C
    JNZ    QFILL    ;fall thru to ingore rest of name
GETDEL: CALL    GETCH    ;pointing to a delimiter?
    RZ        ;yup - all done
    INX    H    ;nope - ignore another one
    JMP    GETDEL
;
; getch gets the character pointed to by the text pointer
; and sets the zero flag if it is a delimiter.
; entry hl    text pointer
; exit    hl    preserved
;    a    character at text pointer
;    z    set if a delimiter
;
GETCH:
    MOV    A,M    ;get the character
    CPI    '.'
    RZ
    CPI    ','
    RZ
    CPI    ';'
    RZ
    CPI    ' '
    RZ
    CPI    ':'
    RZ
    CPI    '='
    RZ
    CPI    '<'
    RZ
    CPI    '>'
    RZ
    ORA    A    ;Set zero flag on end of text
    RET
;
;
; Error routines:
;
BADVER:
    CALL    ABEND
    DB    'Can''t run under CP/M 1.4'
    DB    '$'
NODIR:
    CALL    ABEND
    DB    'Library not found'
    DB    '$'
FISHY:
    CALL    ABEND
    DB    'Name after "-" isn''t a library'
    DB    '$'
NOMEMB:
    CALL    ABEND
    DB    'Command not in directory'
    DB    '$'
NOLOAD:
    CALL    ABEND
    DB    'No program in memory'
    DB    '$'
NOFIT:
    CALL    ABEND
    DB    'Program too large to load'
    DB    '$'
;
COMLIT: DB    'COM'
;
DFLTNAM:DB    'COMMAND ' ; <---change this if you like---
LBRLIT: DB    'LBR'
;
ABEND:
    LDA    ENTUSR
    MOV    E,A
    CPM    USR        ;Reset to entry user.
    CPM    MSG,NEWLIN
    POP    D
    CPM    MSG
    CPM    DEL,SUBFILE
    CPM    MSG,ABTMSG
    JMP    EXIT
ABTMSG: DB    '...ABORTED.$'
NEWLIN:    DB    CR,LF,'$'
SPSAVE: DS    2        ;stack pointer save
;
    PAGE
;Adjust location counter to next 256-byte boundry
@BASE    ORG    ($ + 0FFH) AND 0FF00H
@RLBL    SET    0
;
; The segment to be relocated goes here.
; Any position dependent (3-byte) instructions
; are handled by the "R" macro.
;*************************************************
 R    <LHLD    LENX>    ;Get length of .COM member to load.
    MVI    A,TPA/128
    ADD    L    ;Calculate highest address
    MOV    L,A    ;To see if it will fit in
    ADC    H    ;available memory
    SUB    L
    MOV    H,A
    REPT    7
    DAD    H
    ENDM
    XCHG
    CALL    NEGDE    ;IT'S STILL IN LOW MEMORY
 R    <LXI    H,PROTECT>
    DAD    D
    JNC    NOFIT    ;Haven't overwritten it yet.
LBROPN:
; The library file is still open.  The open FCB has been
; moved up here into high memory with the loader code.
;
 R    <LHLD    INDEX>        ;Set up for random reads
 R    <SHLD    RANDOM>
    XRA    A
 R    <STA    RANDOM+2>
;
    LXI    H,TPA
 R    <SHLD    LOADDR>

; This high memory address and above, including CCP, must be
; protected from being overlaid by loaded program
PROTECT:
;
LOADLOOP:            ;Load that sucker.
 R    <LHLD    LENX>        ;See if done yet.
    MOV    A,L
    ORA    H
 R    <JZ    LOADED>
    DCX    H
 R    <SHLD    LENX>
;
 R    <LHLD    LOADDR>     ;Increment for next time
    MOV    D,H
    MOV    E,L
    LXI    B,80H
    DAD    B
 R    <SHLD    LOADDR>
    CPM    DMA        ;but use old value (DE)
;
 R    <LXI    D,LBRFIL>
    CPM    RRD        ;Read the sector
    ORA    A        ;Ok?
 R    <JNZ    ERR>        ;No, bail out.
;
 R    <LHLD    RANDOM>     ;Increment random record field
    INX    H
 R    <SHLD    RANDOM>
;
 R    <JMP    LOADLOOP>    ;Until done.
;
ERR:
    MVI    A,( JMP )    ;Prevent execution of bad code
    STA    TPA
 R    <LXI    H,ERRX>
    SHLD    TPA+1
 R    <JMP    LOADED>        ;Execute dummy program instead
ERRX:
     LXI    H,BOOT        ;One more time, but this time
    SHLD    TPA+1        ;Jump to BOOT
;
 R    <LXI    D,LDMSG>
    CPM    MSG
 R    <LXI    D,SUBFILE>    ;Abort SUBMIT if in progress
    CPM    DEL
LOADED:
 R    <LDA    ENTUSR>
    MOV    E,A
    CPM    USR        ;Restore USR number from setup.
    CPM    DMA,TBUFF    ;Restore DMA adrs for user pgm
    CPM    CON,LF        ;Turn up a new line on console
    JMP    TPA
;
LDMSG:
    DB    'BAD LOAD$'
INDEX    DW    0
LENX    DW    0
ENTUSR    DB    0
SUBFILE:
    DB    1,'$$$     SUB',0,0,0,0
    ;If used, this FCB will clobber the following one.
    ;but it's only used on a fatal error, anyway.
LBRFIL:
    DS    32        ;Name placed here at setup
    DB    0        ;Normal FCB plus...
OVERLAY SET    $        ;(Nothing past here but DS's)
RANDOM    DS    3        ;...Random access bytes
MAXMEM    DS    2
LOADDR    DS    2
;*************************************************
;End of segment to be relocated.
    IF    OVERLAY EQ 0
OVERLAY SET    $
    ENDIF
;
PAGES    EQU    ($-@BASE+0FFH)/256+8
;
SEGLEN    EQU    OVERLAY-@BASE
    ORG    @BASE+SEGLEN
    PAGE
;    Build the relocation information into a
; bit table immediately following.
;
@X    SET    0
@BITCNT SET    0
@RLD    SET    ??R1
@NXTRLD SET    2
    RGRND    %@RLBL+1    ;define one more label
;
    REPT    SEGLEN+8
    IF    @BITCNT>@RLD
    NXTRLD    %@NXTRLD    ;next value
    ENDIF
    IF    @BITCNT=@RLD
@X    SET    @X OR 1     ;mark a bit
    ENDIF
@BITCNT SET    @BITCNT + 1
    IF    @BITCNT MOD 8 = 0
    DB    @X
@X    SET    0    ;clear hold variable for more
    ELSE
@X    SET    @X SHL 1    ;not 8 yet. move over.
    ENDIF
    ENDM
;
    DB    0
HOLD:    DB    0,0        ;0 length, null terminator
    DS    128-2        ;rest of HOLD area
MEMBER:
    DS    16
;
    END    CCPIN