CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol068/unspol33.asm

Assembly Source File | 1984-04-29 | 20.2 KB | 945 lines

     TITLE 'UNSPOOL Disk to device background process'
;
VERSION    EQU    3$3    ;Version number
;
;Author:
;    Gary P. Novosielski
;
;NOTE:    This source file requires MAC for assembly.
; Due to the complexity of operations performed by
; the macros which generate the relocation table, the
; assembly process will be significantly longer than
; normal for a program of this size.  Be prepared for
; a long period of no disk activity on each pass before
; pressing the panic button.
;
;Revisions:        (in LIFO order)
;3.3    82-01-22
;       Optional Formfeed simulation for printers
;       which do not recognize the formfeed character.
;       Set SIMFF to TRUE for this option.  LPPP
;       (lines per physical page - normally 66)
;       added for calculation of  # of linefeeds.
;       PAGDEF can be set to TRUE to default PAG.
;       In that case the PAG command parameter will
;       turn paging OFF.   END can be used instead of
;    OFF, because I can never remember OFF.  (Jon Tara)
;
;3.2    81-12-29
;    Optional printer paging added. Feature is
;    invoked by typing "UNSPOOL FN.FT PAG".
;    In both cases formfeeds in the file will
;    be passed to the output device.
;    Note that paging is available only
;    under default conditions (C. Strom)
;
;3.1    81-12-06
;    Disable DIRECT BIOS call for DISK writes.
;    Too many application programs which use
;    direct BIOS calls to access the disk assume
;    that they have sole control of drive/track/
;    sector selection. This could be a potential
;    disaster.  See documentation.
;
;3.0    81-11-12
;    New release.  Relpaces 2.3.
;Version 3
;    Now continues to run during direct BIOS input.
;    The device name "off" has been implemented as
;    a method of cancelling an already running
;    UNSPOOL.  It causes a BDOS function 0 reset.
;    Function 0 reset now trapped.  Prompts operator
;    with option to cancel.  Optional tab expansion
;    support at assembly time. Disk reset (login)
;    occurs during simulated warm-boot.  Various
;    cosmetic and source revisions.
;Version 2
;    Copy BIOS table so application programs will
;    still have BIOS access by using word at BOOT+1.
;    Preserve USER and IOBYTE values as of startup.
;

FALSE    EQU    0
TRUE    EQU    NOT FALSE
?    EQU    -1

;
; User-settable assembly options
;
EXPAND    SET    TRUE    ;True to expand tabs
    IF    EXPAND
PHYSBS    SET    TRUE    ;True to recognize backspace
    ENDIF
SIMFF    SET    TRUE    ; Simulate formfeeds with multiple linefeeds.
PAGDEF    SET    TRUE    ; Default PAGing to on.
LPP    SET    60    ; Lines per PRINTED page.
LPPP    SET    66    ; Lines per PHYSICAL page.

;
; BDOS Functions:
;
@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
;
;System equates:
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'
EOF    SET    CTRL AND 'Z'
NVECTS    EQU    16;        ;Number of BIOS vectors
FCBLEN    EQU    33        ;Length of input FCB
;
;The flag SAVECCP should be made true if
;the program segment should load below the CCP.
;If false the segment will load in the extreme
;top of the Transient Program Area, overlaying
;the Console Command Processor.
;
SAVECCP    SET    TRUE    ;MUST remain true for UNSPOOL
OVERLAY    SET    FALSE    ;(initially)
; Macro Definitions
;
;     Perform a standard BIOS function:
CPM    MACRO    FUNC,OPERAND
    IF    NOT NUL OPERAND
    LXI    D,OPERAND
    ENDIF    ;not nul operand
    IF    NOT NUL FUNC
    MVI    C,@&FUNC
    ENDIF    ;not nul func
    CALL    BDOS
    ENDM
;
;    Generate a label of the form ??Rnn to tag an
;    address requiring relocation:
RTAG    MACRO    LBL,VAL
??R&LBL EQU    VAL
    ENDM
;
;    Flag <INST> as a relocatable instruction
;    <INST> is of the form: <MNE    OP1[,OP2]>
R    MACRO    INST
@RLBL    SET    @RLBL+1
    RTAG    %@RLBL,%2+$-@BASE
    INST-@BASE
    ENDM
;
; During bit map construction, get the next R-tagged
; address value:
NXTRLD    MACRO    NN
@RLD    SET    ??R&NN
@NXTRLD    SET    @NXTRLD + 1
    ENDM
;
;
; Enter here from Console Command Processor (CCP)
;
CCPIN    ORG    TPA
    JMP    INTRO
;
SIGNON:
    DB    'UNSPOOL',TAB,TAB,TAB
    DB    'Ver '
    DB    (VERSION/10)+'0'
    DB    '.'
    DB    (VERSION MOD 10)+'0'
    IF    EXPAND
    DB    '/T'
    ENDIF    ;expand
    IF    PAGDEF
    DB    '/P'
    ENDIF
    IF    NOT SIMFF
    DB    '/F'
    ENDIF
    DB    '$'
;
INTRO:
    CPM    MSG,SIGNON
    CALL    SETUP        ;initialize.
    LXI    H,BDOS+2    ;find top of memory
    MOV    A,M        ;page address
                ;Form destination...
    SUI    PAGES        ;...address in
    MOV    D,A        ;DE pair.
    MVI    E,0
    PUSH    D        ;save on stack
    LXI    H,@BASE        ;source address
    LXI    B,SEGLEN
;
MOVLOOP:
;Move (HL) to (DE) for (BC) bytes
    MOV    A,B
    ORA    C        ;test for (BC) = 0
    JZ    MOVDONE
    DCX    B        ;count down
    MOV    A,M        ;move a byte
    STAX    D
    INX    D        ;bump the pointers
    INX    H
    JMP    MOVLOOP
;
MOVDONE:
;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        ;Top-of-stack is CCP return
SETUP:
;First, check environment to see if BIOS vectors
;are accessible.
    LDA    BOOT        ;Location BOOT should
    CPI    ( JMP )        ;have a JMP instruction
    JNZ    VECTERR
    LHLD    BOOT+1        ;Location one points
    MVI    C,NVECTS    ;to the table of jumps
                ;which we move into
                ;the code.
    LXI    D,BIOSV
    XCHG
VLOOP:
    LDAX    D
    CMP    M        ;another JMP?
    JNZ    VECTERR
    INX    D
    INX    H
    LDAX    D
    MOV    M,A
    INX    D
    INX    H
    LDAX    D
    MOV    M,A
    INX    H
    INX    D
    DCR    C
    JNZ    VLOOP
; Save old vectors and CCP return address
;Patch up new vectors as required.
    LHLD    BOOT+1
    SHLD    OLDBOOT;    Save the BOOT vector
;
    LXI    H,2;        Retrieve the CCP
    DAD    SP;        return address from
    MOV    A,M;        down the stack a ways.
    INX    H
    MOV    H,M
    MOV    L,A
    SHLD    CCPRET+1;    Save the CCP re-entry
;                point.
;
    LHLD    BDOS+1
    SHLD    GOBDOS+1;    Save the BDOS entry
;                point.
;
    LHLD    CONIN+1;    Save the direct call
    SHLD    REALCON+1;    to console input.
SETUPDEV:
    LXI    D,TFCB2+1
    LDAX    D
    CPI    ' '
    JZ    SETUPFIL
;
    LXI    H,LSTLIT
    MVI    B,4
    CALL    SCOMP
    JZ    SETUPFIL;    Use default
;
    LXI    D,TFCB2+1
    LXI    H,PUNLIT
    MVI    B,4
    CALL    SCOMP
    JNZ    CKPAG
    MVI    A,@PUN
    STA    DEVICE
    JMP    SETUPFIL
;
CKPAG:
    LXI    D,TFCB2+1
    LXI    H,PAGLIT
    MVI    B,4
    CALL    SCOMP
    JNZ    CKSYS
    LDA    PAGFLG        ; Get initial default value.
    XRI    0FFH            ; Flip it.
    STA    PAGFLG        ; Store new value.
    JMP    SETUPFIL
;
CKSYS:
    LXI    D,TFCB2+1
    LXI    H,OFFLIT
    MVI    B,4
    CALL    SCOMP
    JZ    RESET
    LXI    D,TFCB2+1    ; Also check END cause I can never
    LXI    H,ENDLIT    ;  remember ... uh ... uh ..
    MVI    B,4        ;  oh yea - OFF. (JT)
    CALL    SCOMP
    JNZ    DEVERR        ; Didn't match anything - error.
RESET:
    CPM    SYS        ;Request system reset
SETUPFIL:
    LDA    TFCB1
    ORA    A
    JNZ    OPENIT
;The drive has been defaulted.  Make it explicit
;in case the default drive is changed while the
;file is being unspooled.
    CPM    CUR;    Returns A: as 00
    INR    A;    Open needs A: as 01
    STA    TFCB1
OPENIT:
    CPM    OPN,TFCB1
    INR    A
    JNZ    COPYFCB
;Error.  Can't open input file.
    LXI    H,TBUFF
    MOV    A,M
    ADD    L
    MOV    L,A
    ADC    H
    SUB    L
    MOV    H,A
    INX    H
    MVI    M,'?'
    INX    H
    MVI    M,'$'
    CPM    CON,CR
    CPM    CON,LF
    CPM    MSG,TBUFF+1
    POP    H;    Adjust stack
    RET;        Exit to CCP
;
COPYFCB:
    LXI    H,TFCB1
    LXI    D,FCB
    MVI    C,FCBLEN
COPY1    MOV    A,M
    STAX    D
    INX    H
    INX    D
    DCR    C
    JNZ    COPY1
;
SETUPUSR:
;    Save user number in effect at time of entry
    CPM    USR,?
    STA    ENTUSR
;
SETUPIOB:
;    Save IOBYTE in effect at time of entry
    CPM    RIO
    STA    ENTIOB
;
    RET
;
SCOMP:
    LDAX    D
    CMP    M
    RNZ
    INX    D
    INX    H
    DCR    B
    JNZ    SCOMP
    RET
;
DEVERR:
    CPM    MSG,DEVERRMSG
    POP    H;    Adjust stack
    RET;        Exit to CCP
VECTERR:
    CPM    MSG,VCTERRMSG
    JMP    BOOT    ;try re-booting.
;
LSTLIT:
    DB    'LST '        ;Note trailing blank
ENDLIT:
    DB    'END '
PUNLIT:
    DB    'PUN '        ;Note trailing blank
OFFLIT:
    DB    'OFF '        ;Note trailing blank
PAGLIT:
    DB    'PAG '        ;Note trailing blank
DEVERRMSG:
    DB    CR,LF,'Invalid device.$'
VCTERRMSG:
    DB    CR,LF,'Error in system table.  '
    DB    'Attempting re-boot.$'
    PAGE
;Align location counter to next page 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.
; For readability, the macro name "R" is placed in
; column 2.  The preceding blank must be present to
; distinguish it from a label.
;*************************************************
BDOSV:
;During operation, this location will point
;to INTERCEPT and will be jumped to by BDOS.
;It must be at the lowest location
;in the protected segment of code.
 R    <JMP    ONESHOT>    ;complete installation
BIOSV:
    REPT    NVECTS
    JMP    ?
    ENDM
CONSTAT    EQU    BIOSV+(1*3)
CONIN    EQU    BIOSV+(2*3)
WRITE    EQU    BIOSV+(13*3)
LSTSTAT    EQU    BIOSV+(14*3)
;
INTERCEPT:
;This routine intercepts all BDOS calls.
    MOV    A,C;        Get function
    CPI    @SYS;        Is it a system reset?
 R    <JZ    SYSREQ>
    CPI    @KEY;    Is it single key input?
 R    <JZ    WAITING>
    CPI    @INP;    or buffered input?
 R    <JNZ    CKDMA>
WAITING:
;Wait for actual keypress before honoring input
;request.  Unspool characters in the meantime.
 R    <LDA    ACTIVE>
    ORA    A;    See if finished.
 R    <CNZ    PROCESS>;    Note that A <> 0
 R    <JMP    GOBDOS>;    Honor the input request
;
CKDMA    CPI    @DMA;    If the DMA address is being
        ;    changed, we have to know.
 R    <JNZ    GOBDOS>
    XCHG
 R    <SHLD    DMAHOLD>
    XCHG
;
GOBDOS    JMP    ?;        Patched on entry
        ;    points to "real" BDOS routine.
;
TRAPCON:
;    The application has done a direct BIOS call for
;console input.  We can be confident that this was not
;as a result of a BDOS operation, since BDOS knows
;nothing about our local jump table.  Thus we will not
;need to be concerned with the non-reentrancy of BDOS.
;
 R    <LDA    ACTIVE>
    ORA    A;        See if active.
    MVI    A,0;        Flag BIOS-type request.
 R    <CNZ    PROCESS>;    Unspool a while if so.
REALCON:
    JMP    ?;        Patched during setup.
;
TRAPWRT:
;    The application has attempted a direct BIOS
;    disk write.  This is too dangerous to be
;    allowed, since the programmer may have made
;    rash assumptions about the track or sector
;    which are currently selected.
 R    <LXI    D,OPEXCPT>
     MVI    C,@MSG
 R    <CALL    GOBDOS>;    Give the bad news.
     JMP    BOOT;        Abort the application
OPEXCPT:
    DB    CR,LF
    DB    'Invalid operation attempted under'
    DB    ' UNSPOOL.',CR,LF,'Program aborted.'
    DB    '$'
PROCESS:
;The application program is now waiting for a key
;to be input.  We will use this opportunity to print
;some characters to the device until a key is
;actually pressed.
 R    <STA    ITYPE>    ;The A register tells type
;            of input request.
    LXI    H,0
    DAD    SP
 R    <LXI    SP,LCLSTACK>
    PUSH    H;    Save old SP
    PUSH    B
    PUSH    D;    Save entry parameters
    MVI    C,@RIO;    Save old IOBYTE
 R    <CALL    GOBDOS>
 R    <STA    IOBHOLD>
PROC1:
 R    <CALL    CKKEY>;    Check for keypress.
 R    <JNZ    PROCEXIT>
 R    <LDA    DEVICE>        ;Check device being used
    CPI    @LST
 R    <JNZ    PROC2>        ;If it is LST:
 R    <CALL    LSTSTAT>
    ORA    A
 R    <JZ    PROC1>        ;Loop if not ready
;
PROC2:
    IF    EXPAND
 R    <LDA    TABFLAG>;    In a tab sequence?
     ORA    A
 R    <JZ    NITAB>
 R    <LXI    H,LINEPOS>
    MVI    A,7
    ANA    M;    Check if more blanks needed
 R    <JNZ    SPCOUT>
 R    <STA    TABFLAG>;    Clear the flag
 R    <JMP    PROC1>
NITAB:                ; "Not in Tab"
    ENDIF    ;EXPAND

    IF    SIMFF        ; Simulating form-feeds.
 R    <LDA    FFFLG>        ; In a form-feed sequence?
    ORA    A
 R    <JZ    NIFF>        ; Skip if no.
 R    <LXI    H,NBLINS>
    DCR    M        ; Decrement # of linefeeds remaining.
    MVI    A,LF        ; (Preload LF char)
 R    <JNZ    OUTCHR>        ; Output another line-feed.
    XRA    A
 R    <STA    FFFLG>        ; Clear the flag.
 R    <JMP    PROC1>
NIFF:                ; "Not in form feed"
    ENDIF    ; SIMFF

 R    <LXI    H,BUFFER>
    MOV    A,M
    ORA    A
 R    <CM    FILLBUFF>
 R    <JC    ENDFILE>
    INR    A
    MOV    M,A
    MOV    C,A
    MVI    B,0
    DAD    B;    Point to the buffered char.
    MOV    A,M
    CPI    EOF
 R    <JZ    ENDFILE>

    IF    EXPAND
 R    <LXI    H,LINEPOS>;    Print head position.
    CPI    TAB;        Is this a tab?
 R    <JNZ    NOTTAB>        ; Skip if not.
 R    <STA    TABFLAG>;    Set the flag
SPCOUT:
    MVI    A,' '
 R    <JMP    PROC5>
;
NOTTAB:
    IF    PHYSBS
    CPI    BS;        Backspace?
 R    <JNZ    PROC3>
    DCR    M;        Back up 1 column
 R    <JMP    PROC9>
PROC3:
    ENDIF    ;PHYSBS

    CPI    CR;        End of line?
 R    <JNZ    PROC4>
    MVI    M,0;        Reset column count.
 R    <JMP    PROC9>
PROC4:
    CPI    ' ';        Other ctrl char?
 R    <JC    PROC9>        ; Dont increase column count.
PROC5:
    INR    M        ; Increase column count.
    ENDIF    ;EXPAND
PROC9:
;
    PUSH    PSW
 R    <LDA    PAGFLG>;    Paging enabled?
    ORA    A
 R    <JZ    OUTCHR1>;    No, so jump
    POP    PSW;        Yes, so process
    CPI    FF;        Char a formfeed?
 R    <JZ    PG>;        Yes, so process it
    CPI    LF;        Char a lineFEED?
 R    <JZ    LFPROC>;    Yes, so process it
 R    <JMP    OUTCHR>;    Else just output char
LFPROC:
 R    <LDA    LINCNT>;    Get line counter
    INR    A;        Bump it
    CPI    LPP;        Reached limit?
 R    <JZ    PG>;        Yup, so issue formfeed
 R    <STA    LINCNT>;    Nope, so...
    MVI    A,LF;        ...increment the counter and...
 R    <JMP    OUTCHR>;    ...output the linefeed
;
PG:
    IF    SIMFF
 R    <LDA    LINCNT>        ; Get # of lines already printed.
    ORA    A        ; If we're already at the top of a page,
 R    <JZ    PROC1>        ;  forget it.
    MOV    B,A
    MVI    A,LPPP        ; Lines per physical page.
    SUB    B        ; Compute # of LFs to output.
 R    <STA    NBLINS>        ; Store # of LFs.
    XRA    A        ; Zero the counter.
 R    <STA    LINCNT>
    DCR    A        ; Make an "FF"
 R    <STA    FFFLG>        ; Set the formfeed flag.
    MVI    A,LF        ; Output the first linefeed.
 R    <JMP    OUTCHR>
    ELSE
    XRA    A
 R    <STA    LINCNT>;    zero the counter
    MVI    A,FF;        issue a formfeed
 R    <JMP    OUTCHR>
    ENDIF
OUTCHR1:
    POP    PSW
OUTCHR:
;
    MOV    E,A
    PUSH    D    ;SAVE CHARACTER
;Set the IOBYTE as it was when UNSPOOL was
;started.
 R    <LDA    ENTIOB>
    MOV    E,A
    MVI    C,@SIO
 R    <CALL    GOBDOS>
    POP    D    ;RESTORE CHARACTER
    MVI    C,@LST;        Default
DEVICE    EQU    $-1;        Device code patch
 R    <CALL    GOBDOS>
 R    <LDA    IOBHOLD>;    Restore active IOBYTE
    MOV    E,A
    MVI    C,@SIO
 R    <CALL    GOBDOS>
 R    <JMP    PROC1>
;

ENDFILE:
;    An EOF has been reached on the input file.
;Mark this program as inactive, and de-install on
;the next warm boot.
    XRA    A
 R    <STA    ACTIVE>
;
PROCEXIT:
    POP    D
    POP    B
    POP    H;    Restore SP
    SPHL
    RET
;
;
FILLBUFF:
;Fill the buffer from the file
    PUSH    H
    INX    H
    XCHG;        Buffer address to DE
     MVI    C,@DMA;    Set DMA address
 R    <CALL    GOBDOS>
    MVI    E,?
    MVI    C,@USR
 R    <CALL    GOBDOS>;    Get current user
 R    <STA    USRHOLD>;    Save it
 R    <LDA    ENTUSR>;    Change to user at entry
    MOV    E,A
    MVI    C,@USR
 R    <CALL    GOBDOS>
 R    <LXI    D,FCB>
    MVI    C,@FRD;        Read a sector
 R    <CALL    GOBDOS>
    PUSH    PSW;    Save read return code
 R    <LHLD    DMAHOLD>
    XCHG;        Restore DMA address
    MVI    C,@DMA;    to old value.
 R    <CALL    GOBDOS>
 R    <LDA    USRHOLD>
    MOV    E,A;    Restore User number
    MVI    C,@USR;    to old value
 R    <CALL    GOBDOS>
    POP    PSW;    Read return code
    POP    H;    Buffer pointer
    ORA    A;    How went the read?
    RZ;        Fine
    STC;        No good. Set CARRY for EOF
    RET
;
CKKEY:
;    Return zero flag if key not pressed
;Two types of status checking are done, depending
;on the way in which console input was requested.  If
;via BDOS, a BDOS call is used.  If via direct BIOS, a
;direct BIOS call is used.  This distinction in made
;necessary by the one-character input buffer which
;BDOS may fill during console output. (Yes output.)
;
 R    <LDA    ITYPE>;        Type of input which
    ORA    A;        was requested.
 R    <JZ    CKKEY0>
    MVI    C,@RDY;        Use BDOS if non-zero
 R    <CALL    GOBDOS>
    ORA    A
    RET
CKKEY0:
 R    <CALL    CONSTAT>;    Use BIOS otherwise
    ORA    A
    RET
;
SYSREQ:
;The application process has requested a warm-boot
;by invoking BDOS function 0.  Inquire whether the
;spool writer should be terminated.  If not, treat
;as a normal warm-boot request.
;
    LXI    SP,CCPIN;    Set up a valid stack
 R    <LDA    ACTIVE>;    If not active
    ORA    A;        then don't ask.
 R    <LXI    D,DONEMSG>
 R    <JZ    SYSRQ9>
 R    <LXI    D,CNCL?>
    MVI    C,@MSG
 R    <CALL    GOBDOS>
;
    CPM    KEY        ;Get reply
    ORI    'a'-'A'        ;Force lower case
    CPI    'n'        ;Note lower case n.
     JZ    BOOT
    CPI    'y'        ;Note lower case y.
    JNZ    BOOT        ;Default = No
;
;    Do a real BDOS function 0 which will terminate
;    the spool writer.
 R    <LXI    D,CNCLMSG>
SYSRQ9:
    MVI    C,@MSG        ;Inform the operator
 R    <CALL    GOBDOS>
;
    MVI    C,@SYS
 R    <JMP    GOBDOS>        ;Reset system
BOOTREQ:
;The application process has requested a reboot
;by jumping to location 0.  If we are no longer
;active, we will honor the request by executing
;the address found in the BOOT vector at entry.
;Otherwise return to CCP without rebooting.
    LXI    SP,CCPIN    ;set up a valid stack
 R    <LDA    ACTIVE>
    ORA    A
 R    <JNZ    NOTYET>
;Jump to old boot address as read from memory
;word 1 before we changed it.
 R    <LXI    D,DONEMSG>
    MVI    C,@MSG
 R    <CALL    GOBDOS>
 R    <LHLD    OLDBOOT>
    PCHL
;
NOTYET    LXI    H,TBUFF
 R    <SHLD    DMAHOLD>
    MVI    C,@LOG
 R    <CALL    GOBDOS>
 R    <LXI    D,ACTMSG>
    MVI    C,@MSG
 R    <CALL    GOBDOS>
 R    <LXI    H,INTERCEPT>
 R    <SHLD    BDOSV+1>
 R    <LXI    H,BDOSV>
    SHLD    BDOS+1
 R    <LXI    H,BOOTREQ>
 R    <SHLD    BIOSV+1>
 R    <LXI    H,BIOSV>
    SHLD    BOOT+1
CCPRET:
    JMP    ?;    Patched on startup
;
ACTMSG:    DB    CR,LF
    DB    'Unspooling in progress.'
    DB    '$'
DONEMSG:
    DB    CR,LF,'UNSPOOL Completed.'
    DB    '$'
CNCL?:
    DB    CR,LF,'Do you want to cancel UNSPOOL?'
    DB    CR,LF,'{Y|N} ?>'
    DB    '$'
CNCLMSG:
    DB    CR,LF,'UNSPOOL Cancelled.'
    DB    '$'
OLDBOOT    DW    ?
DMAHOLD    DW    TBUFF
ACTIVE    DB    TRUE
    IF    EXPAND
TABFLAG    DB    FALSE
LINEPOS    DB    0
    ENDIF    ;EXPAND
    IF    SIMFF
FFFLG    DB    FALSE
NBLINS    DB    0
    ENDIF
LINCNT    DB    0;        Linefeed counter
PAGFLG    DB    PAGDEF;        Paging flag (defaulted to PAGDEF)
USRHOLD    DB    ?
ENTUSR    DB    ?
IOBHOLD    DB    ?
ENTIOB    DB    ?
ITYPE    DB    ?
FCB    DS    FCBLEN
BUFFER    DB    ?
;
ONESHOT:
; This one-shot code patches the local jump table.
;It is then overlayed by the file buffer on the first
;read, so it takes up no extra memory.
 R    <LXI    H,TRAPCON>
 R    <SHLD    CONIN+1>
 R    <LXI    H,TRAPWRT>
 R    <SHLD    WRITE+1>
 R    <JMP    BOOTREQ>;    Start the program.
;
OVERLAY    SET    $    ;Bit table may start here
;            Nothing past here but DS's.
    DS    128-$+BUFFER
    DS    32;    LOCAL STACK AT LEAST 16 WORDS
;            PLUS WHATEVER'S LEFT OVER
    ORG    ($+0FFH) AND 0FF00H    ; Org to next page boundry.
LCLSTACK:
;*************************************************
;End of segment to be relocated.
    IF    SAVECCP
PAGES    EQU    ($-@BASE)/256+8;    CCP = 8 pages.
    ELSE
PAGES    EQU    ($-@BASE)/256
    ENDIF    ;saveccp
;
    IF    OVERLAY NE FALSE
    ;cause relocation map to slide down into
    ;unused DS area:
SEGLEN    EQU    OVERLAY-@BASE
    ORG    @BASE+SEGLEN
    ELSE
    ;relocation bit map starts here:
SEGLEN    EQU    $-@BASE
    ENDIF    ;overlay
    PAGE
;    Build the relocation information into a
; bit map following the code.
;
@X    SET    0
@BITCNT    SET    0
@RLD    SET    ??R1
@NXTRLD SET    2
    RTAG    %@RLBL+1,0FFFFH    ;define one more symbol
;
    REPT    SEGLEN+8
    IF    @BITCNT>@RLD
    NXTRLD    %@NXTRLD    ;;next value
    ENDIF
    IF    @BITCNT=@RLD
@X    SET    @X OR 1        ;;set low bit
    ENDIF
@BITCNT    SET    @BITCNT + 1
    IF    @BITCNT MOD 8 = 0
    DB    @X        ;;DEFINE THE BYTE
@X    SET    0    ;;clear hold variable for more
    ELSE
@X    SET    @X SHL 1    ;;not 8 yet. move over.
    ENDIF
    ENDM
;
    END    CCPIN