*COMDECK PMASSEM
         NAM   PMSTAR 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                      *
** NAME        PMSTAR                                                  *
*                                                                      *
** ACTION      START REMOTE NPU DUMP/LOAD PROCESSOR                    *
*                                                                      *
** OVERVIEW -  PROVIDES THE INTITIAL JUMP FOR THE REMOTE NPU           *
*              DUMP/LOAD PROCESSOR.                                    *
*                                                                      *
** INPUT -     NONE                                                    *
*                                                                      *
** CALLING PROGRAMS -                                                  *
*              NONE                                                    *
*                                                                      *
** OUTPUT -    CONTROL GIVEN TO DUMP/LOAD PROCESSOR                    *
*                                                                      *
** EXTERNAL SUBROUTINES -                                              *
*              NONE                                                    *
*                                                                      *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*              PMSTAR                                               * 
         EXT     MAIN 
         RTJ     MAIN 
         EXT     PMREENT
         RTJ     PMREENT
         END
         NAM     PMCMD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME     -  PMCMD
* 
** OVERVIEW -  COMMAND IS ISSUED TO THE MLIA                          * 
*                                                                     * 
** INPUT    -  P+1       - COMMAND BYTE ADDRESS                       * 
*              P+2       - PARAMETER BYTE ADDRESS                     * 
*                                                                     * 
** OUTPUT   -  NONE                                                   * 
*              P+3       - RETURN ADDRESS                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
         ENT     PMCMD
P1CMD    NUM     0
* 
ZERO      NUM    0            MAKE CELL EQUAL TO ZERO.
* 
PMCMD    NOP
         LDQ*    (PMCMD)      -         PARAMETER ADDRESS 
          LDA*   (ZERO),Q    GET COMMAND BYTES. 
         STA*    P1CMD
         RAO*    PMCMD        -         GET PARAMETER 
         LDQ*    (PMCMD)
         RAO*    PMCMD        -         RETURN ADDRESS
          LDA*   (ZERO),Q    GET RETURN ADDRESS.
         LDQ*    P1CMD        -         RESTORE COMMAND 
*IF DEF,DEBUG 
**--------------------------------**
** T E S T  C O D E  O N L Y      **
**--------------------------------**
          EXT    TRUNK
          EXT    QREGS
          EXT    AREGS
          EXT    IFUNC
          EXT    OFUNC
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**------------------------------**
** E N D  O F  T E S T          **
**------------------------------**
*ENDIF
         SIO                  -         SEND TO MLIA
         JMP*    (PMCMD)
         END
         NAM     PMINP
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME        PMINP                                                  * 
*                                                                     * 
** OVERVIEW -  INPUT IS REQUESTED FROM THE MLIA                       * 
*                                                                     * 
** INPUT    -  P+1       - COMMAND BYTE                               * 
*                                                                     * 
** OUTPUT   -  P+2       - ADDRESS OF DATA RETURNED FROM MLIA         * 
*              P+3       - RETURN ADDRESS                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
         ENT     PMINP
* 
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO. 
* 
PMINP    NOP
         LDQ*    (PMINP)      -         PARAMETER ADDRESS 
          LDA*   (ZERO),Q    GET COMMAND BYTES. 
         RAO*    PMINP        -         RETURN ADDRESS
         XFA     Q            -         COMMAND 
         ENA     0
         SIO                  -         REQUEST DATA FROM MLIA
*IF DEF,DEBUG 
**------------------------------**
** T E S T  C O D E  O N L Y    **
**------------------------------**
          EXT    TRUNK
          EXT    QREGS
          EXT    AREGS
          EXT    IFUNC
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    IFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
         LDQ*    (PMINP)      -         PARAMETER ADDRESS 
          STA*   (ZERO),Q    RETURN MLIA CIB ADDRESS. 
         RAO*    PMINP
         JMP*    (PMINP)      -         EXIT
         END
         NAM     PMOUT
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME     -  PMOUT                                                  * 
*                                                                     * 
** OVERVIEW -  SEND DATA AND SUPERVISORY BYTES TO MLIA                * 
*                                                                     * 
** INPUT    -  P+1       ADDRESS OF CLA ADDRESSS                      * 
*              P+2       ADDRESS OF DATA CHAR                         * 
*                                                                     * 
** OUTPUT   -  CHARACTER SENT TO MLIA                                 * 
*              P+3       RETURN                                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
         ENT     PMOUT
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO
* 
P1CHRO   NUM     $CC00        -         CHARACTER OVERHEAD
P1ADRO   NUM     $0F00        -         CLA ADDRESS OVERHEAD
P1DATA   NUM     $0508        -         DATA COMMAND
P1CLA    NUM     0            -         CLA ADDRESS BYTE
P1CHR    NUM     0            -         CHARACTER BYTE
* 
PMOUT    NOP
         LDQ*    (PMOUT)      -         CLA ADDRESS 
          LDA*   (ZERO),Q    CLA ADDRESS. 
         ADD*    P1ADRO       -         ADD OVERHEAD BITS 
         STA*    P1CLA
* 
         RAO*    PMOUT        -         DATA CHARACTER
         LDQ*    (PMOUT)
          LDA*   (ZERO),Q    GET DATA BYTES.
         ADD*    P1CHRO       -         ADD OVERHEAD BITS 
         STA*    P1CHR
         RAO*    PMOUT
* 
         LDQ*    P1DATA       -         SEND CLA ADDRESS
         LDA*    P1CLA
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          EXT    TRUNK
          EXT    QREGS
          EXT    AREGS
          EXT    OFUNC
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
         SIO
* 
         LDQ*    P1DATA       -         SEND CHARACTER
         LDA*    P1CHR
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**   E N D  O F  T E S T      **
**----------------------------**
*ENDIF
         SIO
* 
         JMP*    (PMOUT)      -         EXIT
         END
         NAM     PMSUPR 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME     -  PMSUPR                                                 * 
*                                                                     * 
** OVERVIEW -  THE SUPERVISORY FRAME IS SENT TO THE CLA               * 
*                                                                     * 
** INPUT    -  P+1       ADDRESS OF CLA ADDRESS                       * 
*              P+2       ADDRESS OF SUPERVISORY CHARACTERS            * 
*                                                                     * 
** OUTPUT   -  THE SUPERVISORY FRAME IS SENT WITH THE PROPER          * 
*              OVERHEAD BITS                                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
         ENT     PMSUPR 
* 
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO. 
* 
P1DATA   NUM     $0508        -        DATA COMMAND 
P1SUP1   NUM     $0D00        -         FIRST SUPERVISORY OVERHEAD
P1SUP2   NUM     $CD00        -         SECOND (LAST) OVERHEAD
P1ADRO   NUM     $0F00        -         CLA ADDRESS OVERHEAD
P1CLA    NUM     0            -         CLA ADDRESS 
P1SUPR   NUM     0            -         SUPERVISION BYTES 
P1S1     NUM     0            -         SUPERVISION ONE 
P1S2     NUM     0            -         SUPERVISION TWO 
  
PMSUPR   NOP
         LDQ*    (PMSUPR)     -         GET CLA ADDRESS 
          LDA*   (ZERO),Q    GET CLA ADDRESS. 
         ADD*    P1ADRO       -         ADD OVERHEAD
         STA*    P1CLA
         RAO*    PMSUPR 
* 
         LDQ*    (PMSUPR)     -         GET SUPERVISION CHARACTERS
          LDA*   (ZERO),Q    LOAD SUPERVISION BYTES.
         STA*    P1SUPR 
         RAO*    PMSUPR 
* 
         LDQ     P1DATA       -         DATA COMMAND
         LDA     P1CLA        -         CLA ADDRESS 
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          EXT    TRUNK
          EXT    AREGS
          EXT    QREGS
          EXT    IFUNC
          EXT    OFUNC
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
         SIO
* 
         LFA*    P1SUPR,15,8  -         GET FIRST SUPERVISORY CHARACTER 
         ADD*    P1SUP1       -         FIRST SUPERVISORY OVERHEAD
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
         SIO
* 
         LFA*    P1SUPR,7,8   -         SECOND SUPERVISORY CHARACTER
         ADD*    P1SUP2 
*IF DEF,DEBUG 
**----------------------------**
**  T E S T  C O D E  O N L Y **
**----------------------------**
          RTJ    TRUNK
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
         SIO
* 
         JMP*    (PMSUPR)     -         EXIT
         END
         NAM     PMREWIND 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME     -  PMREWIND                                               * 
*                                                                     * 
** OVERVIEW -  REWIND CASSETTE                                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
         ENT     PMREWIND 
P1REWIND NUM     $680         -         REWIND COMMAND
P1EQUC   NUM     $381         -         EQUIPMENT CODE OF CASSETTE
PMREWIND NOP
         LDQ*    P1EQUC 
PMR1     INP     PMR3-*                READ CASSETTE STATUS.
         AND     =N$3 
         EOR     =N$1 
         SAZ     PMR2         -         SKIP IF NOT BUSY
         JMP*    PMR3 
* 
PMR2     LDA*    P1REWIND     -         ISSUE REWIND
         OUT     1
         JMP*    (PMREWIND)            EXIT 
PMR3     JMP*    (PMREWIND)            EXIT 
         JMP*    PMR1                  TRY AGAIN, DEVICE THERE. 
         END
*IF DEF,DEBUG 
         NAM     TEST 
**   **  ************************************** 
**   **  ******************************** ** ** 
**   **                                   ** ** 
**   **  T E S T   C O D E   O N L Y      ** ** 
**   **                                   ** ** 
**   ** TEST FUNCTION COMMANDS TO         ** ** 
**   ** THE  COUPLER AND TRUNKS           ** ** 
**   **                                   ** ** 
**   **  WILL BE COMMANDS AND FUNCTIONS   ** ** 
**   **  DISPALY, SHOWING WHAT COUPLER    ** ** 
**   **  AND  WHAT THE Q  AND  A REGISTER ** ** 
**   **  EQUAL...                         ** ** 
**   **                                   ** ** 
**   **  COUPLER XX  Q=YYYY  A=ZZZ I/0    ** ** 
**   **                                   ** ** 
**   **  TRUNK XX  Q=YYYY  A=ZZZZ I/O     ** ** 
**   **                                   ** ** 
**   ** ********************************* ** ** 
**   ** *************************************** 
          ENT    QREGS
          ENT    AREGS
          ENT    COUPLR 
          ENT    TRUNK
          ENT    IFUNC
          ENT    OFUNC
          EXT    C0INDEX
          EXT    M0TRUNK
COUPLR    NOP    0               ENTRY POINT FOR COUPLR FUNCTION
          RTJ*   SAVE             SAVE A Q I
          RTJ*   INIT             SET POINTERS TO START 
          RTJ    COUP             SET COUPLER MESSAGE 
          RTJ*   RTNNX            SAVE POINTERS FOR NEXT. 
          JMP*   (COUPLR)         RETURN TO CALLER
          SPC    3
QREGS     NOP    0                ENTRY FOR DISPLAYING Q
          RTJ*   SAVE 
          RTJ*   INITNX           SET POINTERS TO CONTINUE. 
          LDQ*   QQ               SET FOR Q DISPLAY 
          RTJ    AQOUT            FORMAT Q FOR DISPLAY
          RTJ*   RTNNX            SAVE POINTERS FOR NEXT. 
          JMP*   (QREGS)          RETURN TO CALLER
          SPC    3
AREGS     NOP    0                ENRTY POINT TO DISPLAY A
          RTJ*   SAVE 
          RTJ*   INITNX           SAVE POINTERS FOR NEXT. 
          LDA*   AA               SET FOR A-REG DISPLAY 
          RTJ    AQOUT            GO FORMATA-REG FOR DISPLAY
          RTJ*   RTNNX            SET POINTERS FOR NEXT.
          JMP*   (AREGS)          RETURN TO CALLER. 
          SPC    3
TRUNK     NOP    0                ENTRY POINT FOR TRUNK FUNCTIONS 
          RTJ*   SAVE 
          RTJ*   INIT             SET POINTERS TO START 
          RTJ    TRNK             GO FORMAT FOR TRUNK FUNCTIONS 
          RTJ*   RTNNX            SET POINTERS FOR NEXT.
          JMP*   (TRUNK)          RETURN TO CLLER 
          EJT 
          SPC    3
IFUNC     NOP    0
          RTJ*   SAVE             SAVE REGISTERS. 
          RTJ*   INITNX           SET POINTERS TO PROCESS.
          LDA    =$2049           SHOW FUNCTION AS INPUT. 
          RTJ    IOFUNC           SAVE FUNCTION IN BUFFER.
          RTJ*   WRITE            GO OUTPUT BUFFER TO DISPLAY.
          RTJ*   RTNNX            SET REGISTERS FOR RETURN. 
          JMP*   (IFUNC)          RETURN TO CALLER. 
          SPC    3
OFUNC     NOP    0
          RTJ*   SAVE             SAVE REGISTERS. 
          RTJ*   INITNX           SET POINTERS TO PROCESS.
          LDA    =$204F           SHOW FUNCTION AS OUTPUT.
          RTJ*   IOFUNC           STORE IN OUTPUT BUFFER. 
          RTJ*   WRITE            GO OUTPUT BUFFER
          RTJ*   RTNNX            SET REGISTERS FOR RETURN. 
          JMP*   (OFUNC)          RETUNR TO CALLER. 
          EJT 
WRITE     NOP    0                DISPLAY MESSAGE 
          LDQ*   EQUIP            GET EQUIPMENT NUMBER
          LDA    =$100            WITE FUNCTION FOR CONTROL 
          NOP    0
          OUT    -1               OUTPUT WRITE FUNCTION 
          INQ    -1               CLEAR DIRECTIVE BIT 
          ENA    0
          STA-   I                SET INDEX FOR DATAT FETCH 
WRTA      LDA*   (DATA),I         DATAT FOR OUTPUT
          SAZ    WRTB              OUTPUT COMPLETED EXIT
          ALS    8
          AND    =$FF             SAVE UPPER HALF FOR OUTPUT
          NOP    0
          OUT    -1               OUTPUT CHARACTER. 
          LDA*   (DATA),I         GET DATA
          RAO-   I                INCREASE INDEX
          AND    =$FF             SAVE LOWER CHARACTER
          NOP    0
          OUT    -1               OUTPUT CHARACTER
          JMP*   WRTA             REPEAT OUTPUT 
WRTB      LDQ*   EQUIP            GET EQUIPMENT NUMBER. 
          INP    -1               GET STATUS
          AND    =$2              SAVE BUSY BIT 
          SAZ    WRTC             UNIT NOT BUSY 
          JMP*   WRTB             WAIT TILL NOT BUSY
          SPC    3
WRTC      ENA    1                CLEAR CONTROLER 
          LDQ*   EQUIP            GET EQUIPMENT NUMBER
          OUT    -1               OUTPUT CLEAR FUNCTION 
          JMP*   (WRITE)          RETURN TO CALLER
          EJT 
SAVE      NOP    0                SAVE A,Q,I AND SET CELLS
          STA*   AA               SAVE A
          STQ*   QQ               SAVE Q
          LDA-   I                GET I 
          STA*   II               SAVE I
          JMP*   (SAVE)           RETURN TO CALLER. 
          SPC    3
INIT      NOP    0
          LDA    =XDATA1
          STA*   DATA 
          CLR    A
          STA-   I
          LDA    =$0D0A 
          STA*   (DATA),I 
          RAO-   I
          LDA    =$2020 
          STA*   (DATA),I 
          RAO-   I
          STA*   (DATA),I 
          RAO-   I
          LDA-   I
          STA*   TEMPD
          JMP*   (INIT) 
          SPC    3
INITNX    NOP    0
          LDA*   TEMPD
          STA-   I
          ENA    -2 
          STA*   TEMP2
          ENA    0
          STA*   TEMPD
          TRA    Q
          JMP*   (INITNX) 
          SPC    3
RTNNX     NOP    0
          LDA-   I
          STA*   TEMPD
          LDA*   II 
          STA-   I
          LDA*   AA 
          LDQ*   QQ 
          JMP*   (RTNNX)
          SPC    3
IOFUNC    NOP    0
          STA*   (DATA),I 
          RAO-   I
          ENA    0
          STA*   (DATA),I 
          JMP*   (IOFUNC) 
          SPC    3
TEMPD     NUM    0
TEMP2     NUM    0
II        NUM    0
AA        NUM    0
QQ        NUM    0
EQUIP     NUM    $91              EQUIPMENT NUMBER. 
DATA      NUM    0
          BZS    DATA1(20)        BUFFER AREA 
          EJT 
COUP      NOP    0                ENTRY FOR COUPLER FORMAT
          LDA    =$434F           CODES FOR ( C O ) 
          STA*   (DATA),I         SAVE OUTPUT DATA
          RAO-   I                UPDATE INDEX
          LDA    =$5550           CODES FOR ( U P ) 
          STA*   (DATA),I         SAVE DATA 
          RAO-   I
          LDA    =$4C45           CODES FOR ( L E ) 
          STA*   (DATA),I         SAVE DATA 
          RAO-   I
          LDA    =$523D           CODES FOR ( R = ) 
          STA*   (DATA),I 
          RAO-   I
          LDA    C0INDEX          COUPLER IDENT 
          ADD    =$3030 
          STA*   (DATA),I         SAVE DATA 
          RAO-   I
          LDA    =$2020 
          STA*   (DATA),I 
          RAO-   I
          JMP*   (COUP) 
          EJT 
TRNK      NOP    0                ENRTY FOR TRUNK DISPLAY 
          LDA    =$5452 
          STA*   (DATA),I         SAVE FOR DISPLAY
          RAO-   I                UPDATE INDEX
          LDA    =$554E 
          STA*   (DATA),I         SAVE
          RAO-   I
          LDA    =$4B3D 
          STA*   (DATA),I         SAVE
          RAO-   I
          LDA    M0TRUNK          TRUNK IDENT 
          ADD    =$3030           CONVERT TO ASCII. 
          STA*   (DATA),I 
          RAO-   I
          LDA    =$2020           CODES FOR ( GR,LF ) 
          STA*   (DATA),I 
          RAO-   I
          JMP*   (TRNK)           RETURNTO CALLER 
          EJT 
AQOUT     NOP    0                ENTRY FOR AQ DISPLAY
          SQZ    AQOU11           DISPLAY A REGISTER
          LDA    =$513D           FOR Q DISPLAY 
AQOUT1    STA*   (DATA),I         SAVE FOR DISPLAY
          RAO-   I                UPDATE INDEX
AQOU10    JMP*   AQOU12 
AQOU11    TRA    Q                FOR A DISPLAY 
          LDA    =$413D           CODES TO DISPLAY A
          JMP*   AQOUT1           GO STORE CHARACTER
          SPC    3
AQOU12    ENA    0                CLEAR A 
          LLS    4                SHIFT QA REGISTER 
          INA    -$A              CHECK IF NUMBER HEX 
          SAM    AQOU15           NUMBER
          INA    $41              ITS A LETTER HEX
AQOU14    ALS    8                SHIFT TO CORRECT POSITION 
          STA*   TEMPD            SAVE FOR LATER
          JMP*   AQOU20 
          SPC    3
AQOU15    INA    $3A              HEX NUMBER
          JMP*   AQOU14           GO PROCESS CHAR 
          SPC    3
AQOU20    CLR    A
          LLS    4                GET NEXT
          INA    -$A
          SAM    AQOU23 
          INA    $41              CONVERT TO ASCII
AQOU22    ADD*   TEMPD            ADD FRIST CHAR
          STA*   (DATA),I         SAVE FOR DISPLAY
          JMP*   AQOU30 
          SPC    3
AQOU23    INA    $3A              CONVERT TO ASCII
          JMP*   AQOU22 
          SPC    3
AQOU30    RAO-   I                UPDATE INDEX
          ENA    0                CLEAR A 
          STA*   TEMPD
          RAO*   TEMP2
          LDA*   TEMP2            CHECK IF ALL DONE 
          SAZ    AQOU32           COMPLETE OUTPUT AREA
          JMP*   AQOU12           CONTINUE TO CONVERT TO ASCII
          SPC    3
AQOU32    LDA    =$2020           CODES FOR  ( CR,LF )
          STA*   (DATA),I         PUT IN DISPLAY AREA 
          RAO-   I
          JMP*   (AQOUT)          RETURN TO CALLER. 
          END 
*ENDIF
          NAM    CPBITS 
* 
*********************************************************************** 
*                                                                     * 
**        NAME   C P B I T S                                          * 
*                                                                     * 
*                                                                     * 
** ACTION:                                                            * 
*         CLEAR PROTECT BITS IN BUUFFER AREA.                         * 
*         SET PROTECT BITS FOR SAM PROGRAM                            * 
*         SAVE OLD PAGE REGISTER.                                     * 
*                                                                     * 
*                                                                     * 
** INPUTS.                                                            * 
*         NONE.                                                       * 
*                                                                     * 
*                                                                     * 
** CALLING PROGRAM.                                                   * 
*                                                                     * 
*         PMINIT.                                                     * 
*                                                                     * 
*                                                                     * 
** OUTPUTS.                                                           * 
*         PAGE REGISTER.                                              * 
*                                                                     * 
*                                                                     * 
** EXTERNAL SUBROUTINES.                                              * 
*                                                                     * 
*         NONE.                                                       * 
*                                                                     * 
*                                                                     * 
*********************************************************************** 
* 
          ENT    CPBITS 
          EXT    CQCIB        START ADDRESS OF SAM. 
          EXT    PBSTPM       END ADDRESS OF SAM. 
* 
* 
SRGREG    NUM    $4020       SAVE REGISTER FOR DEBUG
CLREND    NUM    $4175        BUFFER AREA CLEAR/P/B.
SBPEND    NUM    0            ENDING ADDRESS OF SAM 
DPZER     NUM    $4000        PAGE REGISTER STORE AREA. 
* 
CPBITS    NOP    0           ENTRY POINT TO PROGRAM.
          APM    0           DISABLE PAGE MODE. 
          STA*   (SRGREG)    SAVE A-REGISTER
          RAO*   SRGREG 
          STQ*   (SRGREG)    SAVE Q-REGISTER
          RAO*   SRGREG 
          TRM    A
          STA*   (SRGREG)    SAVE M-REGISTER
          RAO*   SRGREG 
          LDA-   I
          STA*   (SRGREG)    SAVE-I-REGISTER
          RAO*   SRGREG 
          SR1    (SRGREG)    SAVE REGISTER-1
          RAO*   SRGREG 
          SR2    (SRGREG)    SAVE REGISTER-2
          RAO*   SRGREG 
          SR3    (SRGREG)    SAVE REGISTER-3
          RAO*   SRGREG 
          SR4    (SRGREG)    SAVE REGISTER-4
          LDA    =XCQCIB
          ADD    =N$175 
          STA*   CLREND 
          LDA    =XPBSTPM     END ADDRESS OF SAM
          INA    $15
          STA*   SBPEND       SAVE ENDING ADDRESS 
          LDQ    =XCQCIB      START ADDRESS OF SAM. 
CPB01     CPB 
          TRQ    A           INCREMENT Q REG. 
          INA    1
          TRA    Q
          SUB*   CLREND      CHECK FOR END
          SAZ    CPB02       GO SET BITS
          JMP*   CPB01       NO, CONTINUE.
* 
CPB02     LDQ    CLREND 
CPB03     SPB 
          TRQ    A          INCREMENT Q 
          INA    1
          TRA    Q
          SUB*   SBPEND 
          SAZ    CPB04      GO READ PAGE REGISTER.
          JMP*   CPB03      CONTINUE TO S-P-B.
* 
CPB04     ENQ    $1F         31 PAGE REGISTERS. 
CPB05     TRQ    A
          ALS    11          SET PAGE REGISTER ADDRESS. 
          RPR    A           READ PAGE REGISTER.
          STA*   (DPZER),Q   SAVE CONTENTS OF PAGE REG. 
          DQP    *-CPB05     LOOP TILL COMPLETED. 
          JMP*   (CPBITS)    EXIT, RETURN TO CALLER.
          END 
*IF -DEF,NOCST
          NAM    CSTAPE 
* * * * * * * * * * *                             * * * * * * * * * * * 
*                                                                     * 
** NAME       -   CSTAPE                                              * 
*                                                                     * 
** OVERVIEW   -   BUILD SYSTEM AUTOSTART MODULE ( S A M ) ON TO       * 
*                 A SAM CASSETTE LOAD TAPE.                           * 
*                                                                     * 
*                 THE SAM CASSETTE LOAD TAPE HAS TWO RECORDS.         * 
*                 FORMAT OF RECORDS.                                  * 
*                                                                     * 
*                 -- R E C O R D  O N E  --                           * 
*                      FUCNTION CONTROL REGISTER SETTING ( 3       ). * 
*                      A CASSETTE TAPE DRIVER TO READ AND FORMAT      * 
*                      THE SAM PROGRAM.                               * 
*                                                                     * 
*                 -- R E C O R D  T W O --                            * 
*                      SAM PROGRAM FOLLOWED BY TWO EOF  FILE MARKS    * 
*                                                                     * 
** INPUT     -    SAMS PROGRAM IS LOADED BY A CYBER COMPUTER          * 
*                 WITH THE AID OF A PP FUNCTIONING THE COUPLER        * 
*                 OF A LOCAL  N P U.                                  * 
*                                                                     * 
** OUTPUT     -   THE NPU THEN HAS THE ABILITY TO GENERATE            * 
*                 ONE OR MORE SAM CASSETTE REMOTE LOAD TAPES.         * 
*                                                                     * 
* * * * * * * * * * *                           * * * * * * * * * * * * 
          SPC    2
          ENT    CSTAPE 
          ENT    BOOT1B      BEGIN OF BOOT-STRAP-AREA.
          ENT    BOOT1E      END   OF BOOT-STRAP-AREA.
* 
**        E X T E R N A L S.
* 
          SPC    1
          EXT    PMINIT      ENTRY POINT ADDR TO SAM-P. 
          EXT    CQCIB      STARTING ADDRESS OF SAM-P.
          EXT    PBSTPM      +15 = ENDING ADDRESS OF SAMP.
* 
* 
**        J U M P   T A B L E   TO   P R O C E S S   C H A R. 
* 
          SPC    2
BLDJMP    JMP*   BLZERO      CONVERT 1ST CHARACTER 4-BIT 8-BIT/ASC. 
          JMP*   BLONE       CONVERT 2ND CHARACTER. 
          JMP*   BLTWO       CONVERT 3TH CHARACTER. 
          JMP*   BLTHRE      CONVERT 4TH CHARACTER. 
* 
          SPC    2
* 
**  C O N V E R S I O N   T A B L E   4 - B I T . 
* 
          SPC    2
BLDTBL    NUM    $30B1,$B233 CONVERSION FOR 0,1,2 AND 3.
          NUM    $B435,$36B7 CONVERSION FOR 4,5,6 AND 7.
          NUM    $B839,$4142 CONVERSION FOR 8,9,A AND B.
          NUM    $C344,$C5C6 CONVERSION FOR C,D,E AND F.
* 
          SPC    2
* 
**     E N T R Y   P O I N T  T O   B U I L D   S A M - P 
* 
          SPC    2
CSTAPE    NOP 
          LDA    =XPBSTPM    ENDING PROGRAM FOR SAM-P.
          INA    $15
          STA*   SAM2EN      ENDING ADDRESS FOR BUILDING SAM. 
          LDA    =XBOOTSR    ENTRY POINT TO EXECUTE SAM-P.
          STA*   BOTSTR 
          LDA    =XCQCIB    STARTING ADDRESS OF SAM-P.
          STA*   SAM2BE 
BLDAR0    STA*   TEMPPT      SAVE FOR LATER USE.
          CLR    A
          STA*   TEMPIX      INDEX TO PROCESS 4-BIT OF ADDRESS. 
BLDAR1    LDA*   TEMPPT      GET 16-BIT BEGIN ADDRESS.
          ALS    4           SHIFT UPER 4-BITS TO LOWER POSITION. 
          STA*   TEMPPT      SAVE SHIFT ADDRESS.
          AND    =N$F        SAVE LOWER 4-BITS ONLY.
          RTJ*   BLCHAR      CONVERT 4-BIT TO 8-BIT CHARACTER.
          LDQ*   TEMPIX      SET Q TO INDEX POINTER.
          JMP*   BLDJMP,Q    GO PROCESS ASC/CHAR. 
* 
**        G E T   A S C / C H A R .  F O R   4 - B I T  H E X . 
* 
          SPC   2 
BLCHAR    NOP 
          ALS    15 
          STA*   TEMPTS      SAVE HIGH ORDER BIT FOR TEST.
          AND    =N$7        SAVE INDEX POINTER TO TABLE. 
          TRA    Q           SET INDEX POINTER. 
          LDA*   BLDTBL,Q     LOAD CONVERT CHARACTER. 
          LDQ*   TEMPTS      TEST IF UPPER OR LOWER CHAR. 
          SQM    BLCHR1      IF MIMUS LOWER CHARACTER.
          AND    =N$FF00     SAVE UPPER CHARACTER.
          ALS    8           SHIFT TO LOWER POSITION. 
          JMP*   (BLCHAR)    RETURN TO CALLER.
* 
BLCHR1    AND    =N$FF       SAVE LOWER CHARACTER.
          JMP*   (BLCHAR)    RETURN TO CALLER.
* 
**        P R O C E S S   1 S T   A C S  /  C  H A R  . 
* 
          SPC    2
BLZERO    ALS    8           SHIFT TO HIGH ORDER. 
          STA*   TEMPCH      STORE IN TEMP-CHAR-CELL. 
          RAO*   TEMPIX      POSITION INDEX.
          JMP*   BLDAR1      GO PROCESS NEXT CHARACTER. 
* 
**        P R O C E S S   2 N D   A S C  /  C H A R . 
* 
          SPC    2
BLONE     ADD*   TEMPCH      ADD TO UPPER CHARACTER.
          STA*   (BOTSTR)    STORE IN BOOTHSTRAP. 
          RAO*   BOTSTR      ADVANCE BOOTHSTRAP POINTER.
          RAO*   TEMPIX      ADVANCE INDEX POINTER. 
          JMP*   BLDAR1      GO PROCESS NEXT CHARACTER. 
* 
**        P R O C E S S   3 R D   A S C  /  C H A R . 
* 
          SPC    2
BLTWO     ALS    8           SHIFT TO UPPER POSITION. 
          STA*   TEMPCH      SAVE CHARACTER.
          RAO*   TEMPIX      ADVANCE INDEX POINTER. 
          JMP*   BLDAR1      GO PROCESS NEXT CHARACTER. 
* 
**        P R O C E S S   4 T H   A S C  /  C H A R . 
* 
          SPC    2
BLTHRE    ADD*   TEMPCH      ADD UPPER CHARACTER. 
          STA*   (BOTSTR)    STORE IN BOOTHSTRAP. 
          RAO*   TEMPTM      ADD ONE TO TIME COUNTER. 
          LDA+   TEMPTM 
          INA    -2          CHECK IF COMPLETED.
          SAM    BLTHR1       NO CONTINUE TO BUILD POINTERS.
          SAZ    BLTHR2       CONTINUE TO BULID POINTERS. 
          INA    -1           CHECK IF START BOOTH LOADED.
          SAZ    BLTHR0       GO STORE BOOT START ADDRESS.
* 
          JMP*   BLDS0       RETURN TO CALLER.
**
* 
BLTHR0    LDA*   =XBOOTRS+1  BOOT STRAP STARTING ADDRESS. 
          JMP*   BLTHR3       CONVERT BOOT START ADDRESS
* 
BLTHR1    LDA    =XBOOTST    GET POINTER TO BOOTHSTRAP. 
          STA+   BOTSTR      SAVE FOR LATER USE.
          LDA    =XPMINIT    GET ENTRY POINT TO SAMP. 
          JMP*   BLDAR0      GO PROCESS ENTRY POINT TO SAMP.
* 
* 
BLTHR2   LDA*   =XBOOT1B+6    BOOT STARP STORE ADDRESS. 
BLTHR3   STA*   BOTSTR        SAVE POINTER
         LDA*   =XCQCIB 
         SUB    =N$A0         GET BOOT STARP ADDRESS. 
         JMP*   BLDAR0        GO CONVERT ADDRESS. 
* 
**
* 
          SPC    2
* 
**               C  O  N  S  T  A  N  T  S
* 
          SPC    2
DEVCOM    NUM    $381         -        Q SETTING TO FUNCTION DEVICE 
DEVRWC    NUM    $680         -        FUNCTION TO REWIND CASSETTE
DEVWTC    NUM    $500         -        FUNCTION TO WRITE FILE MARK
DEVSWC    NUM    $580         -        START DEVICE MOTION
SAM2BE    NUM    $170 
SAM2EN    NUM    $0E00
SAMIND    NUM    $0 
          SPC    3
* 
**        B U I L D   S A M  W O R K I N G   C E L L S
* 
          SPC    2
          BZS    SAMERR(1)
          BZS    SAMEND(1)   END OF OUTPUT FILE 
          BZS    SAMSTA(1)    -        DEVICE STATUS RESERVED CELL
          BZS    SAMCNT(1)    -        COUNTER FOR NUMBER OF WRITES.
          BZS    TEMPIX(1)   INDEX TO PROCESS 4-BIT ADDRESS.
          BZS    TEMPPT(1)   POINTER TO 16-BIT ADDRESS. 
          BZS    TEMPCH(1)   TEMPORARY STORGE FOR ASC/CHAR. 
          BZS    TEMPTM(1)   COUNTER FOR NUMBER OF TIMES. 
          BZS    TEMPTS(1)   CELL TO TEST UPPER OR LOWER CHAR.
          BZS    BOTSTR(1)   CELL POINTER TO STORE IN BOOTHSTRAP. 
          SPC    2
* 
**        W R I T E   S A M - P   O N    T A P E  . 
* 
BLDS0     CLR    A           INITIALIZE START CELLS.
          STA*   SAMERR      CLEAR ERROR CELL.
BLDS00    STA*   SAMSTA      CLEAR STATUS WORD
          STA*   SAMCNT      CLEAR COUNTER CELL.
          LDQ*   DEVCOM      SET Q TO COMMAND FUNCTION. 
          ENA    1           CLEAR CONTROLLER.
          OUT    -1          OUTPUT FUNCTION. 
BLDS01    ENA    0           CLEAR A FOR INPUT. 
          INP    -1          INPUT CASSETTE STATUS. 
          STA*   SAMSTA      SAVE CASSETTE STATUS.
          ENA    7
          AND*   SAMSTA      SAVE READY,BUSY AND WRITE BITS.
          INA    -4          CHECK IF WRITE ENABLE. 
          SAP    BLDS03      YES,  GO TO NEXT STEP. 
          JMP*   BLDS01      NO,  WAIT TILL WRITE GOES READY. 
* 
BLDS03    INA    -1          CHECK UNIT READY.
          SAZ    BLDS1       YES,  GO TO NEXT STEP. 
          JMP*   BLDS01      NO,  GO TAKE STATUS AGAIN. 
          SPC    2
* 
**     C H E C K    L O A D   P O I N T   B I T . 
* 
          SPC    2
BLDS1     LDA*   SAMSTA      GET DEVICE STATUS. 
          ALS    5           SHIFT LOAD POINT BIT TO HIGH ORDER.
          SAM    BLDS2       TAPE AT LOAD POINT, CONTINUE.
          LDA*   DEVRWC      TAPE REWIND FUNCTION CODE. 
          OUT    -1          OUTPUT REWIND FUNCTION.
          NOP 
BLDS12    INP    -1          INPUT DEVICE STATUS. 
          ALS    11          CHECK END OF OPERATION BIT.
          SAM    BLDS2       FUNCTION COMPLETED 
          JMP*   BLDS12      WAIT TIL DEVICE NOT BUSY.
          SPC    2
* 
**     S E T U P   T O   W R I T E   1 S T   R E C O R D .
* 
          SPC    2
BLDS2     LDA    =XBOOT1B    1ST WORD ADDRESS OF RECORD ONE.
          XFA    I           SAVE IN I FOR INDEX POINTER. 
          LDA    =XBOOT1E    LAST WORD ADDRESS OF RECORD ONE. 
          STA*   SAMEND      SAVE FOR LATER COMPARE TEST. 
BLDS22    LDQ*   DEVCOM      SET Q FOR COMMAND FUNCTION.
          LDA*   DEVSWC      TAPE WRITE MOTION COMMAND. 
          OUT    -1          OUTPUT WRITE COMMAND.
          SPC    2
* 
**     O U T P U T   D A T A   T O   C A S S E T T E  . 
* 
          SPC     2 
BLDS3     INQ    -1          SET DEVICE COMMAND FOR DATA. 
BLDS30    LDA*   (SAMIND),I  GET OUTPUT WORD. 
          ALS    8           SET A TO CORRECT CHARACTER.
          AND    =$FF        SAVE LOWER 8-BITS. 
          OUT    -1          OUTPUT CHARACTER.
          INQ    1           SET Q TO FUNCTION COMMAND. 
BLDS32    NOP 
          INP    -1          TAPE STATUS. 
          ALS    12          CHECK DATA REQUEST BIT 
          SAM    BLDS33      GO OUTPUT DATA.
          JMP*   BLDS32      WAIT TILL DATA REQUEST UP. 
* 
BLDS33    INQ    -1          SET Q FOR DATA OUTPUT. 
          LDA*   (SAMIND),I  GET OUTPUT.
          AND    =$FF        SAVE LOWER HALFOF WORD.
          OUT    -1 
* 
BLDS34    RAO-   I           INCREASE INDEX POINTER BY ONE. 
          XFI    A
          SUB*   SAMEND      TEST OUTPUT COMPLETE.
          SAZ    BLDS4       YES, GO TO NEXT STEP.
          JMP*   BLDS30      NO,  CONTINUE TO OUTPUT. 
          SPC    2
* 
*     C H E C K   I F  W R I T E   O   K
* 
          SPC    2
BLDS4     LDQ*   DEVCOM      TAPE FUNCTION COMMAND. 
          INP    -1          INPUT TAPE STATUS. 
          STA*   SAMSTA      SAVE TAPE STATUS.
          ALS    11          CHECK E.O.P. BIT 
          SAM    BLDS40 
          JMP*   BLDS4       WAIT TILL E.O.F. UP. 
* 
BLDS40    AND    =$1
          SAN    BLDS46      GO CHECK ERROR TYPE. 
          JMP*   BLDS49      NO ERROR CONTINUE. 
          SPC    2
* 
**     W R I T E   E R R O R   T R Y   A G A I N .
* 
          SPC    2
BLDS46    RAO*   SAMERR      INCREASE ERROR COUNTER.
          LDA*   SAMERR 
          INA    -10         CHECK ERROR CNT IF 10. 
          SAZ    BLDERR      TRY WRITING SAMP AGAIN.
          CLR    A
          JMP*   BLDS00      TRY WRITE AGAIN. 
          SPC    2
* 
**     E R R O R   E Q U A L  T E N  .
* 
          SPC    2
BLDERR    LDA*   SAMSTA      DISPLAY TAPE STATUS. 
          JMP*   BLDERR      HUNG CSTAPE PROGRAM. 
          SPC    2
* 
**     C H E C K   O U T P U T   C O M P L E T E .
* 
          SPC    2
BLDS49    RAO*   SAMCNT 
          LDA*   SAMCNT 
          INA    -1          CHECK IF BOTH RECORDS COMPLETED. 
          SAN    BLDS5       YES,  GO TO NEXT STEP. 
          SPC    2
* 
**     S E T U P  T O  W R I T E  2 N D  R E C O R D. 
* 
          SPC    2
          LDA*   SAM2BE      FIRST WORD ADDR. OF 2ND RECORD.
          XFA    I           INDEX POINTER TO DATA. 
          LDA*   SAM2EN      LAST WORD ADDR. OF 2ND RECORD. 
          STA*   SAMEND      SAVE FOR COMPLETION TEST.
          JMP*   BLDS22      GO OUTPUT 2ND RECORD.
          SPC    2
* 
**     W R I T E   T W O   F I L E  M A R K S . 
* 
          SPC    2
BLDS5     CLR    A
          STA*   SAMCNT      CLEAR OUTPUT COUNTER.
          LDQ*   DEVCOM      Q = COMMAND FUNCTION TO DEVICE.
BLDS52    LDA*   DEVWTC      FUNCTION TO WRITE TAPE MARK. 
          OUT    -1          OUTPUT FUNCTION. 
          NOP 
BLDS53    INP    -1          STATUS TAPE
          ALS    11          CHECK E.O.P. BIT.
          SAM    BLDS54      CONTINUE E.O.P. SET. 
          JMP*   BLDS53      WAIT TILL E.O.P. SETS. 
* 
BLDS54    RAO*   SAMCNT      ADD ONE TO OUTPUT COUNTER. 
          LDA*   SAMCNT      CHECK FOR TWO TAPE MARKS.
          INA    -2 
          SAZ    BLDS60      YES,  GO TO NEXT STEP. 
          JMP*   BLDS52      NO,  GO WRITE TAPE MARK. 
         SPC     2
* 
**     S A M - P    B U I L D    R E W I N D   T A P E. 
* 
          SPC    2
BLDS60    LDA*    DEVRWC     REWIND TAPE. 
          OUT     -1         OUTPUT FUNCTION .
          NOP 
BLDS67    INP    -1          STATUS DEVICE. 
          ALS    15          CHECK NOT READY BIT. 
          SAP    BLDS68      DEVICE DROP READY. 
          JMP*   BLDS67      NO,  WAIT TILL READY DROPS.
BLDS68    JMP*   BLDS0       GO BUILD CASSETTE TAPE.
          EJT 
BOOT1B    NUM    $4BB7,$B130,$30B8,$3030,$3047,$4B4B,$B430,$3030
          NUM    $47CC,$C5B8,$B4B2,$47CC,$30B8,$B4B4,$47CC,$36B8
          NUM    $B4B2,$47CC,$C3B8,$33C5,$47CC,$36B8,$33C6,$47CC
          NUM    $3041,$30B1,$47CC,$3042,$3030,$47CC,$3033,$C6C5
          NUM    $47CC,$3042,$3030,$47CC,$30B2,$C6C5,$47CC,$4130
          NUM    $3030,$47CC,$3030,$3033,$47CC,$4230,$3030,$47CC
          NUM    $3030,$30B1,$47CC,$30B1,$30B1,$47CC,$B1B8,$C639
          NUM    $47CC,$C3B8,$3336,$47CC,$3042,$3030,$47CC,$3033
          NUM    $C6C5,$47CC,$3044,$C6C5,$47CC,$30B8,$B4B4,$47CC
          NUM    $30B2,$30B7,$47CC,$30C6,$C3B8,$47CC,$3042,$3030
          NUM    $47CC,$30B2,$C6C5,$47CC,$36C3,$B241,$47CC,$44B8
          NUM    $B239,$47CC,$B1B8,$C6B8,$47CC,$3042,$3030,$47CC
          NUM    $3044,$30B1,$47CC,$3042,$3030,$47CC,$30B2,$C6C5
          NUM    $47CC,$30C6,$C342,$47CC,$30B1,$33B2,$47CC,$3044
          NUM    $C6C5,$47CC,$B1B8,$C630,$47CC,$30C6,$C3C3,$47CC
          NUM    $30B1,$33B4,$47CC,$30C6,$C344,$47CC,$30B1,$33B1
          NUM    $47CC,$B1B8,$C5B7,$47CC,$B1C3,$B1B7,$47CC,$C3B8
          NUM    $B141,$47CC,$39B8,$B141,$47CC,$30B1,$B1B2,$47CC
          NUM    $3041,$3044,$47CC,$B1B8,$C6C6,$47CC,$44B8,$B135
          NUM    $47CC,$C3B8,$B1B7,$47CC,$3042,$3030,$47CC,$3033
          NUM    $C6C5,$47CC,$30B2,$C6C5,$47CC,$30C6,$C342,$47CC
          NUM    $30B1,$33B1,$47CC,$B1B8,$C6C3,$47CC,$C3B8,$B1B1
          NUM    $47CC,$3042,$3030,$47CC,$30B1,$33B1,$47CC,$30C6
          NUM    $C342,$47CC,$30B2,$C6C5,$47CC,$3042,$3030,$47CC
          NUM    $3033,$C6C5,$47CC,$B1B8,$C6C3,$47CC,$B1B8,$C330
          NUM    $47CC
BOOTST    NUM    $B4C5,$30C6,$47CC
BOOTSR    NUM    $B430,$4130,$47CC,$3033
          NUM    $B8B1,$47CC,$3030,$3030,$47CC,$3030,$3030,$47CC
          NUM    $3030,$3030,$47CC,$30B7,$B830,$47CC,$3036,$B830
          NUM    $47CC,$30B4,$B830,$47CC,$3030,$3030,$3047
BOOTRS    NUM    $4B4B,$B430,$3030,$47CA,$B130,$474B,$4B33,$B1B2
          NUM    $3030,$3030,$30C0
BOOT1E    NUM    $FFFF
          END 
          NAM    BSTAPE 
* * * * * * * * * * *                             * * * * * * * * * * * 
*                                                                     * 
** NAME       -   BSTAPE                                              * 
*                                                                     * 
** OVERVIEW   -   BUILD SYSTEM AUTOSTART MODULE ( S A M ) ON TO       * 
*                 A SAM CASSETTE LOAD TAPE.                           * 
*                                                                     * 
*                 THE SAM CASSETTE LOAD TAPE HAS TWO RECORDS.         * 
*                 FORMAT OF RECORDS.                                  * 
*                                                                     * 
*                 -- R E C O R D  O N E  --                           * 
*                      FUCNTION CONTROL REGISTER SETTING ( 3       ). * 
*                      A CASSETTE TAPE DRIVER TO READ AND FORMAT      * 
*                      THE SAM PROGRAM.                               * 
*                                                                     * 
*                 -- R E C O R D  T W O --                            * 
*                      SAM PROGRAM FOLLOWED BY TWO EOF  FILE MARKS    * 
*                                                                     * 
** INPUT     -    SAMS PROGRAM IS LOADED BY A CYBER COMPUTER          * 
*                 WITH THE AID OF A PP FUNCTIONING THE COUPLER        * 
*                 OF A LOCAL  N P U.                                  * 
*                                                                     * 
** OUTPUT     -   THE NPU THEN HAS THE ABILITY TO GENERATE            * 
*                 ONE OR MORE SAM CASSETTE REMOTE LOAD TAPES.         * 
*                                                                     * 
* * * * * * * * * * *                           * * * * * * * * * * * * 
          SPC    2
          ENT    BSTAPE 
* 
**        E X T E R N A L S.
* 
          SPC    1
          EXT    PMINIT      ENTRY POINT ADDR TO SAM-P. 
          EXT    CQCIB      STARTING ADDRESS OF SAM-P.
          EXT    PBSTPM      +15 = ENDING ADDRESS OF SAMP.
          EXT    BOOT1B      BEGIN OF BOOT-STRAP-AREA.
          EXT    BOOT1E      END   OF BOOT-STRAP-AREA.
          EXT    BSTS        SAVE TRAP AREA 
          EXT    BSTS62      XEDIT,ADDRESS AFTER SAM/D CUT. 
* 
          SPC    2
* 
**     E N T R Y   P O I N T  T O   B U I L D   S A M - P 
* 
          SPC    2
BSTAPE    NOP 
          RTJ    BSTS 
          JMP*   BSTS0
* 
          SPC    2
* 
**               C  O  N  S  T  A  N  T  S
* 
          SPC    2
DEVCOM    NUM    $381         -        Q SETTING TO FUNCTION DEVICE 
DEVRWC    NUM    $680         -        FUNCTION TO REWIND CASSETTE
DEVWTC    NUM    $500         -        FUNCTION TO WRITE FILE MARK
DEVSWC    NUM    $580         -        START DEVICE MOTION
SAMIND    NUM    $0 
          SPC    3
* 
**        B U I L D   S A M  W O R K I N G   C E L L S
* 
          SPC    2
          BZS    SAMERR(1)
          BZS    SAMEND(1)   END OF OUTPUT FILE 
          BZS    SAMSTA(1)    -        DEVICE STATUS RESERVED CELL
          BZS    SAMCNT(1)    -        COUNTER FOR NUMBER OF WRITES.
          SPC    2
* 
**        W R I T E   S A M - P   O N    T A P E  . 
* 
BSTS0     CLR    A           INITIALIZE START CELLS.
          STA*   SAMERR      CLEAR ERROR CELL.
BSTS00    STA*   SAMSTA      CLEAR STATUS WORD
          STA*   SAMCNT      CLEAR COUNTER CELL.
          LDQ*   DEVCOM      SET Q TO COMMAND FUNCTION. 
          ENA    1           CLEAR CONTROLLER.
          OUT   BSTREJ-*+1             CLEAR CONTROLLER 
BSTS01    ENA    0           CLEAR A FOR INPUT. 
          INP   BSTREJ-*+1             INPUT STATUS 
          STA*   SAMSTA      SAVE CASSETTE STATUS.
          ENA    7
          AND*   SAMSTA      SAVE READY,BUSY AND WRITE BITS.
          INA    -4          CHECK IF WRITE ENABLE. 
          SAP    BSTS03      YES,  GO TO NEXT STEP. 
BSTREJ    NOP 
BSTS02    JMP    BSTS62      NO SAM-D REQUIRED, LOAD SAM. 
* 
BSTS03    INA    -1          CHECK UNIT READY.
          SAZ    BSTS1       YES,  GO TO NEXT STEP. 
          JMP*   BSTS01      NO,  GO TAKE STATUS AGAIN. 
          SPC    2
* 
**     C H E C K    L O A D   P O I N T   B I T . 
* 
          SPC    2
BSTS1     LDA*   SAMSTA      GET DEVICE STATUS. 
          ALS    5           SHIFT LOAD POINT BIT TO HIGH ORDER.
          SAM    BSTS2       TAPE AT LOAD POINT, CONTINUE.
          LDA*   DEVRWC      TAPE REWIND FUNCTION CODE. 
          OUT   BSTREJ-*+1             REWIND TAPE
          NOP 
BSTS12    INP   BSTREJ-*+1             WAIT TAPE READY
          ALS    11          CHECK END OF OPERATION BIT.
          SAM    BSTS2       FUNCTION COMPLETED 
          JMP*   BSTS12      WAIT TIL DEVICE NOT BUSY.
          SPC    2
* 
**     S E T U P   T O   W R I T E   1 S T   R E C O R D .
* 
          SPC    2
BSTS2     LDA    =XBOOT1B    1ST WORD ADDRESS OF RECORD ONE.
          XFA    I           SAVE IN I FOR INDEX POINTER. 
          LDA    =XBOOT1E    LAST WORD ADDRESS OF RECORD ONE. 
          STA*   SAMEND      SAVE FOR LATER COMPARE TEST. 
BSTS22    LDQ*   DEVCOM      SET Q FOR COMMAND FUNCTION.
          LDA*   DEVSWC      TAPE WRITE MOTION COMMAND. 
          IIN 
          OUT    -1          OUTPUT WRITE COMMAND.
          SPC    2
* 
**     O U T P U T   D A T A   T O   C A S S E T T E  . 
* 
          SPC     2 
BSTS3     INQ    -1          SET DEVICE COMMAND FOR DATA. 
BSTS30    LDA*   (SAMIND),I  GET OUTPUT WORD. 
          IIN 
          ALS    8           SET A TO CORRECT CHARACTER.
          AND    =$FF        SAVE LOWER 8-BITS. 
          OUT    -1          OUTPUT CHARACTER.
          EIN 
          INQ    1           SET Q TO FUNCTION COMMAND. 
BSTS32    NOP 
          INP    -1          TAPE STATUS. 
          ALS    12          CHECK DATA REQUEST BIT 
          SAM    BSTS33      GO OUTPUT DATA.
          JMP*   BSTS32      WAIT TILL DATA REQUEST UP. 
* 
BSTS33    INQ    -1          SET Q FOR DATA OUTPUT. 
          LDA*   (SAMIND),I  GET OUTPUT.
          AND    =$FF        SAVE LOWER HALFOF WORD.
          IIN 
          OUT    -1 
* 
          EIN 
BSTS34    RAO-   I           INCREASE INDEX POINTER BY ONE. 
          XFI    A
          SUB*   SAMEND      TEST OUTPUT COMPLETE.
          SAZ    BSTS4       YES, GO TO NEXT STEP.
          JMP*   BSTS30      NO,  CONTINUE TO OUTPUT. 
          SPC    2
* 
*     C H E C K   I F  W R I T E   O   K
* 
          SPC    2
BSTS4     LDQ*   DEVCOM      TAPE FUNCTION COMMAND. 
          INP    -1          INPUT TAPE STATUS. 
          STA*   SAMSTA      SAVE TAPE STATUS.
          ALS    11          CHECK E.O.P. BIT 
          SAM    BSTS40 
          JMP*   BSTS4       WAIT TILL E.O.F. UP. 
* 
BSTS40    AND    =$1
          SAN    BSTS46      GO CHECK ERROR TYPE. 
          JMP*   BSTS49      NO ERROR CONTINUE. 
          SPC    2
* 
**     W R I T E   E R R O R   T R Y   A G A I N .
* 
          SPC    2
BSTS46    RAO*   SAMERR      INCREASE ERROR COUNTER.
          LDA*   SAMERR 
          INA    -10         CHECK ERROR CNT IF 10. 
          SAZ    BSTERR      TRY WRITING SAMP AGAIN.
          CLR    A
          JMP*   BSTS00      TRY WRITE AGAIN. 
          SPC    2
* 
**     E R R O R   E Q U A L  T E N  .
* 
          SPC    2
BSTERR    LDA*   SAMSTA      DISPLAY TAPE STATUS. 
          JMP*   BSTERR      HUNG BSTAPE PROGRAM. 
          SPC    2
* 
**     C H E C K   O U T P U T   C O M P L E T E .
* 
          SPC    2
BSTS49    RAO*   SAMCNT      ADD ON TO SAM RECORD COUNT.
          LDA*   SAMCNT      LOAD A WITH RECORD COUNT.
          INA    -1          CHECK IF BOTH RECORDS COMPLETED. 
          SAN    BSTS5       YES,  GO TO NEXT STEP. 
          SPC    2
* 
**     S E T U P  T O  W R I T E  2 N D  R E C O R D. 
* 
          SPC    2
          LDA    =N$40A0     FIRST WORD ADDR. OF 2ND RECORD.
          XFA    I           INDEX POINTER TO DATA. 
          LDA    =X$50FF     LAST WORD ADDR. OF 2ND RECORD. 
          STA*   SAMEND      SAVE FOR COMPLETION TEST.
          JMP*   BSTS22      GO OUTPUT 2ND RECORD.
          SPC    2
* 
**     W R I T E   T W O   F I L E  M A R K S . 
* 
          SPC    2
BSTS5     CLR    A
          STA*   SAMCNT      CLEAR TEST COUNTER.
          LDQ*   DEVCOM      Q = COMMAND FUNCTION FOR DEVICE. 
BSTS52    LDA*   DEVWTC      FUNCTION TO WRITE TAPE MARK. 
          OUT    -1          OUTPUT FUNCTION. 
          NOP 
BSTS53    INP    -1          STATUS TAPE
          ALS    11          CHECK E.O.P. BIT.
          SAM    BSTS54      CONTINUE E.O.P. SET. 
          JMP*   BSTS53      WAIT TILL E.O.P. SETS. 
* 
BSTS54    RAO*   SAMCNT      ADD ONT TO OUTPUT COUNT. 
          LDA*   SAMCNT      CHECK FOR TWO TAPE MARKS.
          INA    -2 
          SAZ    BSTS60      YES,  GO TO NEXT STEP. 
          JMP*   BSTS52      NO,  GO WRITE TAPE MARK. 
         SPC     2
* 
**     S A M - P    B U I L D    R E W I N D   T A P E. 
* 
          SPC    2
BSTS60    LDA*   DEVRWC      REWIND CASSETTE TAPE.
          OUT     -1         OUTPUT FUNCTION .
          NOP 
          JMP    BSTS62 
          EJT 
          END 
          NAM    BLDCST 
          SPC    2
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
* *  - N A M E -        B L D C S T 
* 
* *  - O V E R V I E W  SUBROUTINE TO HELP BUILD A SAM-D. 
* 
*                       ITS FUNCTION ARE AS FOLLOWS.... 
* 
*                       SAVE, AND RESTORE, TRAP AREAS 
*                       FOR COUPLERS 1 AND 2, CASSETTE
*                       TAPE AND THE REAL TIME CLOCK. 
* 
*                       STORE NEW ENTRY POINTS FOR
*                       NEW INTERRUPT ROUTINES, AND 
*                       SERVICE THE NEW INTERRUPTS
*                       THAT OCCUR. 
* 
* *  - I N P U T -      LOADED BY A CYBER WITH
*                       THE AID OF A PPU FUNCTIONING
*                       THE COUPLER OF A LOCAL NPU. 
* 
* * - O U T P U T -     HELPS TO GENERATE A SAM-D 
*                       CASSETTE TAPE.  WITH THE AID FROM A 
*                       PROGRAM CALLED,  - B S T A P E  - 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    2
          ENT    BSTS 
          ENT    BSTS62 
          SPC    2
          EXT    PMINIT     ENTRY TO START THE CCP LOAD.
          SPC    2
BSTS      NOP    0           ENTRY POINT TO BSTS PROGRAM
          RTJ    BSTS67      SAVEYTOPIOF TRAPUCOUPLERS RTC. 
          LDA+   =$5400      RETURN JUMP INSTRUCTION
          STA+   $115        COUPLERS TRAP AREA.
          STA+   $119        COUPLERS TRAP AREA.
          STA+   $121        REAL TIME CLOCK TRAP AREA
          LDA+   =XBSTLN5    COUPLERS PROCESSOR ENTRY POINT.
          STA+   $116        LINE(5) COUPLER 2
          STA+   $11A        LINE (6) COUPLER 1 
          LDA+   =XBSTLN8    LINE(8) INTERRUPT PROCESSOR ENTRY. 
          STA+   $122        REAL TIME CLOCK TRAP AREA WD(3). 
          LDA+   =$80        PART OF EQUIPMENT NUMBER FOR CP(2).
          STA+   $117        SAVE IN TRAP AREA. 
          ENA    0
          STA+   $11B        SAVE IN COUPLER (1) TRAP AREA
          LDQ+   =$648       FUNCTION TO WRITE NPU STATUS WRD CP(2) 
          ENA    1           1 = IDLE LOOP FOR PPU. 
          SIO 
          LDQ+   =$6C8       FUNCTION TO WRITE NPU STATUS WRD CP(1) 
          SIO 
          LDA+   =$0160      INTERRUPT BITS FOR COUPLERS AND RTC. 
          TRA    M           SET THE INTERRUPTS MASK BITS.
          RTJ*   PMSCLR      CLEAR INTERRUPTS ON REAL TIME CLOCK. 
          RTJ*   PMSSTR      START REAL TIME CLOCK. 
          EIN 
          JMP*   (BSTS)      RETURN TO CALLER.
          SPC    2
BSTS62    IIN 
BSTS63    LDA*   (OGTRAP)    RESTORE TRAP AREA THEN EXIT. 
          STA*   (OSTRAP) 
          RAO*   OGTRAP 
          RAO*   OSTRAP 
          LDA*   OCTRAP      CHECK IF STORE IS COMPLETED. 
          INA    -1 
          STA*   OCTRAP      RESTORE NEW COUNT. 
          SAZ    BSTS64      STORE COMPLETE, EXIT.
          JMP*   BSTS63      GET NEXT TRAP AREA.
BSTS64    JMP+   PMINIT      GO START CCP LOAD. 
          SPC    2
OSTRAP    NUM    $114 
OGTRAP    NUM    $4FD0
OCTRAP    NUM    $F 
          SPC    2
BSTS67    NOP    0           SAVE RETURN ADDRESS
BSTS68    LDA*   (IGTRAP)    SAVE TRAP ADDRESSES. THEN EXIT.
          STA*   (ISTRAP) 
          RAO*   IGTRAP 
          RAO*   ISTRAP 
          LDA*   ICTRAP      CHECK IF STORE COMPLETED.
          INA    -1 
          STA*   ICTRAP      RESTORE NEW STORE COUNT. 
          SAZ    BSTS69      IF COMPLETE, THEN EXIT.
          JMP*   BSTS68      GO STORE NEXT TRAP AREA
BSTS69    JMP*   (BSTS67)    EXIT TO START SAM PROGRAM. 
          SPC    2
IGTRAP    NUM    $114 
ISTRAP    NUM    $4FD0
ICTRAP    NUM    $F 
          SPC    2
* 
* * *     C O U P L E R S   I N T E R R U P T    H A N D L E R
* 
          SPC    2
BSTLN5    NOP    0           COUPLERS INTERRUPT HANDLER 
          STA*   BSSAVA      SAVE THE A REGISTER. 
          STA*   BSSAVQ      SAVE THE Q REGISTER. 
          LDQ+   =$0600      COUPLER ONE EQUIPMENT NUMBER.
          ADQ*   (BSTLN5)    ADD BIT 7  IF COUPLER 2
          INQ    $50         Q = FUNCTION TO INPUT COUPLERS STATUS. 
          SIO 
          STA*   BSTCST      SAVE COUPLERS STATUS.
          ALS    6           CHECK IF NPU STATUS WORD INPUTTED. 
          SAP    BSTN51      NO, GO CHECK IF ORDER WORD SET.
* 
* * *  N P U    S T A T U S   W O R D   W A S   I N P U T T E D.
* 
          SPC    2
          INQ    -7          SET Q TO OUTPUT IDLE BIT  (1)
          ENA    1           IDLE BIT EQUALS A 1
          SIO 
          INQ    7           RESET Q FUNCTION 
* 
* * *   C H E C K   I F   O R D E R   W O R D    B I T   S E T .
* 
          SPC    2
BSTN51    LDA*   BSTCST      GET COUPLERS STATUS BITS IN A. 
          ALS    7           CHECK IF ORDER WORD LOADED.
          SAP    BSTN52      ORDER WORD NOT LOADED, CONTINUE. 
* 
* * *  O R D E R   W O R D   L O A D E D  ,   R E A D   I T.
* 
          SPC    2
          INQ    $10         Q = FUNCTION TO INPUT ORDER WORD.
          SIO 
* 
* * *    E X I T   F R O M   I N T E R R U P T S    P R O C E S S O R . 
* 
          SPC    2
BSTN52    LDA*   (BSTLN5)    GET COUPLERS I.D.
          LDQ*   BSSAVQ      RESTORE THE Q REGISTE. 
          SAZ    BSTN53      ZERO = I.D. OF COUPLER ONE.
* 
* * *   C O U P L E R   2   I N T E R R U P T E D   E X I T  $ 0 E 1 8
* 
          SPC    2
          LDA*   BSSAVA      RESTORE THE A REGISTER BEFORE EXIT.
          NUM    $0E14       EXIT INTERRUPT STATE INSTRUCTION.
* 
* * *  C O U P L E R   1   I N T E R R U P T E D    E X I T  $ 0 E 1 B
* 
          SPC    2
BSTN53    LDA*   BSSAVA      RESTORE THE A REGISTER.
          NUM    $0E18       EXIT INTERRUPT STATE INSTRUCTION.
          SPC    2
          BZS    BSSAVA(1)   CELL TO SAVE THE A REGISTER. 
          BZS    BSSAVQ(1)   CELL TO SAVE THE Q REGISTER. 
          BZS    BSTCST(1)   CELL TO SAVE THE COUPLER STATUS. 
          EJT 
* 
**        A U T O    D A T A    T R A N S F E R   T A B L E 
* 
**                  R T C    A D T    T A B L E 
* 
          SPC    2
ADTCLK    NUM    $80F0       CLOCK ADT-TABLE FUNCTION 
ADTCNT    NUM    $0          CLOCK COUNTER CELL 
ADTTIC    NUM    $30         TICKS PER INTERRUPTS (100MS) 
          NUM    $0          NOT USE - NEEDED FOR ADT FUNCTION
* 
**        E N D    O F    A D T   T A B L E 
* 
* 
          SPC    2
* * *   L I N E  8  I N T E R R U P T  P R O G R A M   ( R T C ) . .
* 
          SPC    2
BSTLN8    NOP    0           ENTRY POINT FOR REAL TIME CLOCK INTERRUPT. 
          STA*   BSTSVA      SAVE REGISTER ( A )
          STQ*   BSTSVQ      SAVE REGISTER ( Q )
          RTJ*   PMSCLR      CLEAR REAL TIME CLOCK INTERRUPT. 
          LDA*   RTCCNT      REAL TIME CLOCK , ONE SECOND COUNTER.
          SAZ    BSTL82      ONE SECOND TIME OUT SEND IDLE BIT. 
          INA    -1          DECREAMENT ONE FORM 1-SEC COUNTER. 
          STA*   RTCCNT      SAVE ONE SECOND COUNTER CELL.
BSTL81    RTJ*   PMSSTR      START REAL TIME CLOCK. 
          LDA*   BSTSVA      RESTORE REGISTER ( A ).
          LDQ*   BSTSVQ     RESTORE REGISTER (.Q ). 
          NUM    =$0E20      EXIT LINE ( 8 ) INTERRUPT STATE INST.
          SPC    2
          BZS    BSTSVA(1)   REGISTER TO SAVE ( A ) 
          BZS    BSTSVQ(1)   REGISTER TO SAVE ( Q ).
RTCCNT    NUM    $30         ONE SECOND COUNTER CELL
          SPC    2
* 
* * *   O N E   S E C O N D   U P .   S E N D   I D L E   B I T . 
* 
          SPC    2
BSTL82    LDQ+   =$0650      FUNCTION FOR COUPLER ONE STATUS. 
          CLR    A           CLEAR REGISTER ( A ).
          SIO 
          ALS    13          CHECK IF PPU INPUT THE NPU STATUS WORD.
          SAM    BSTL83      NEG = DID NOT READ STATUS WORD YET.
          SPC    2
* 
* * *   P P U  I N P U T   T H E   N P U    S T A T U S   W R D  .
* 
* * *     S E T   I D L E    B I T   I N    S T A T U S    W R D .
* 
          INQ    -7          SET Q  TO LOAD NPU STATUS WORD.
          ENA    1            IDLE BIT IS A ( 1 ) 
          SIO 
* 
* * *  C H E C K   N E X T   C O U P L E R
* 
          SPC    2
BSTL83    LDQ+   =$06D0      Q = FUNCTION TO INPUT COUPLER STATUS.
          CLR    A           CLEAR REGISTER ( A ).
          SIO 
          ALS    13          NPU STATUS WORD BIT
          SAM    BSTL84      NEG = NPU STATUS WORD STILL LOADED.
          SPC    2
* 
* * *   N P U   S T A T U S   W O R D   E M P T Y  .
* 
* * *      R E S E T   T H E   I D L E   B I T .
* 
          SPC    2
          INQ    -7          Q = FUNCTION TO LOAD NPU STATUS WORD.
          ENA    1           IDLE BIT IS A ( 1 ). 
          SIO 
          SPC    2
* 
* * *    N P U   S T A T U S   W O R D   N O T  E M P T Y . 
* 
* * *  R E S E T  T H E  1 S E C .  C O U N T E R   C E L L . 
* 
          SPC    2
BSTL84    ENA    $30         30 INTERRUPTS = ONE SECOND IN TIME.
          STA*   RTCCNT      RESET 1-SEC COUNTER CELL.
          JMP*   BSTL81      RESET REGISETRS A AND Q , THEN EXIT. 
          SPC    2
* 
* * *  S T A R T   R E A L   T I M E   C L O C K  P R O G R A M  .
* 
          SPC    2
PMSSTR    NOP    0           START REAL TIME CLOCK. 
          ENA    0
          STA*   ADTCNT      RESET CLOCK COUNTER TO ZERO
          LDQ+   =$8008      Q SETTING FOR ADT/DMI INSTRUCTION
          LDA*   =XADTCLK    POINTER TO CLOCK ADT TABLE 
          DMI    0           DEFINE CLOCK INTERRUPTS. 
          LDQ+   =$00F3      ENABLE REAL-TIME-CLOCK ACTION
          NOP 
          OUT    -1          REJECT ADDRESS IS MINUS ONE
          JMP*   (PMSSTR)    RETURN TO CALLING ROUTINE
          SPC    2
* 
* * *   C L E A R   R E A L   T I M E   C L O C K  I N T E R R P U T .
* 
          SPC    2
PMSCLR    NOP    0           ENTRY POINT TO CLEAR RTC 
          LDQ+   =$00F0      RTC EQUIP/FUNCTION 
          NOP    0           NEEDED FOR OUTPUT REJECTS
          OUT    -1          CLEAR INTERRUPTS ON RCT. 
          JMP*   (PMSCLR)    RETURN TO CALLING ROUTINE
          END    BLDCST 
*ENDIF
         NAM     PMWTNW 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME       PMWTNW                                                  * 
*                                                                     * 
** ACTION   OUTPUT COUPLERS NPU STATUS WORD.                          * 
*                                                                     * 
** OVERVIEW -  THIS ROUTINE ISSUES FUNCTION COMMANDS TO               * 
*              THE COUPLER, THE FIRST PARAMETER CONTAINS              * 
*              THE NPU STATUS OR MAR,    THE SECOND PARAMETER         * 
*              CONTAINS THE NPU FUNCTION COMMAND.                     * 
*                                                                     * 
** INPUT -     MPPARM MPCMD                                           * 
*                                                                     * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PMCMON PMPCSR PMIOHD PMPSOW PMPPKTO PMIRTO             * 
*                                                                     * 
*                                                                     * 
*                                                                     * 
** OUTPUT -    NONE                                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINE -                                              * 
*              B0WAIT 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMWTNW 
          EXT    MPPINT 
          EXT    MCPCON 
          EXT    B0WAIT 
* 
R3SVE     NUM    0                          R3 SAVE 
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO
WCOUNT    NUM    $7FFF                      TIME DELAY COUNT
* 
          EQU    MNCICS($50)
          EQU    MNSIAS(4)
          EQU    MNSNRO(3)
* 
PMWTNW    NOP 
          LDQ*   (PMWTNW)                    ADDRESS OF MPPARM
          LDA*   (ZERO),Q                    STATUS OR MAR IN A-REG.
          RAO*   PMWTNW                      POSITION TO MPCMD WORD 
          LDQ*   (PMWTNW)                    COUPLER FUNCTION ADDR. 
          LDQ*   (ZERO),Q                    GET COUPLER FUNCTION.
          RAO*   PMWTNW                      POISTION TO RETURN ADDR. 
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          EXT    COUPLR 
          EXT    QREGS
          EXT    AREGS
          EXT    OFUNC
TESTPT    RTJ    COUPLR 
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**----------------------------**
**  E N D  O F  T E S T       **
**----------------------------**
*ENDIF
          INA    -MNSNRO                     CHECK IF REJECT CODE.
          SAZ    PMWTN0                      YES, CHECK COUPLER STATUS. 
          INA    MNSNRO                      NO,  OUTPUT RESPONSE CODE
          SIO                                ISSUE SIO
PMWT11    JMP*   (PMWTNW)                    RETURN TO CALLING PROG.
* 
PMWTN0    RTJ*   WTNPRD                      BUILD COUPLER FUNCTION.
PMWTN4    ENA    MNSNRO                      REJECT OUTPUT
          INQ    -8                          FUNCTION LOAD NPUS WORD. 
          SIO                                OUTPUT NPUS CODE.
PMWTN1    RTJ*   WTNPRD                      GO GET STATUS
* 
PMWTN2    LDA+   MPPINT                      CHECK TYPE.
          INA    -1 
          SAZ    PMWTN3                      1 = SET NPU STATUS = 4.
          JMP*   PMWT11                      EXIT.
* 
PMWTN3    INQ     -8                         SET  FUNCTION STATUS OUTPUT. 
          ENA    MNSIAS                      ENTER A WITH 4 
          SIO                                GO DUE OUTPUT. 
          JMP*   (PMWTNW)                    EXIT 
* 
**
* 
WTNPRD    NOP    0                           RETURN ADDERSS 
          SR3*   R3SVE                       SAVE REGISTER 3
          LR3*   WCOUNT                      SET LOOP COUNTER 
          LDQ+   MCPCON                      BUILD COUPLLER FUNCTION
          INQ    MNCICS 
WTNP1     SIO                                GO GET STATUS
          ALS    13                          CHECK NPU STATUS READ
          SAP    WTNP2                       YES,JUMP TO RETURN.
          D3P    3                           NO,CONTINUE UNTIL CNT/OUT
          LR3*   R3SVE                       RESTORE R3.
          CLR    A                           ERROR EXIT NEXT COPULER/TRUNK
          STA+   B0WAIT 
          JMP*   (PMWTNW)                    EXIT.
WTNP2     LR3*   R3SVE                       RESTORE R3 
          JMP*   (WTNPRD)                    NORMAL RETURN. 
          END 
          NAM    PMRDCS 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME        PMRDCS                                                 * 
*                                                                     * 
** ACTION    INPUTS COUPLER STATUS REGISTER                           * 
*                                                                     * 
** OVERVIEW -  THIS ROUTINE INPUTS THE COUPLER STATUS                 * 
*              REGISTER FROM THE COUPLER.                             * 
*                                                                     * 
** INPUT -     MPCMD - COUPLERS FUNCTION COMMAND.                     * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PMPPKTO PMPCSR PMPSOW                                  * 
*                                                                     * 
** OUTPUT -    MPPARM - CONTAINS OF COUPLERS STATUS REGISTER.         * 
*                                                                     * 
** EXTERNAL SUBROUTINE -                                              * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMRDCS 
* 
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO. 
* 
PMRDCS    NOP 
          LDQ*   (PMRDCS)      ADDRESS OF COUPLERS FUNCTION 
          LDQ*   (ZERO),Q      GET C0UPLER FUNCTI0N.
          RAO*   PMRDCS        POSITION FOR COUPLER STATUS. 
          SIO 
*IF DEF,DEBUG 
**----------------------------**
** T E S T  C O D E  O N L Y  **
**----------------------------**
          EXT    COUPLR 
          EXT    QREGS
          EXT    AREGS
          EXT    IFUNC
          RTJ    COUPLR 
          RTJ    QREGS
          RTJ    AREGS
          RTJ    IFUNC
**----------------------------**
** E N D   O F  T E S T       **
**----------------------------**
*ENDIF
          LDQ*   (PMRDCS)      ADDRESS TO RETURN STATUS.
          STA*   (ZERO),Q      STORE CSR IN MPPARM
          RAO*   PMRDCS        POSITION FOR RETURN
          JMP   (PMRDCS)       RETURN TO CALLING PROG.
          END 
          NAM    PMSVMSG
*         ************************************************************
*         *                                                          *
*         *   PMSVMSG - SAVE CURRENT SERVICE MESSAGE AND             *
*         *                                                          *
*         *      STATUS CELLS OF SAM-P LOADING CCP-PROGRAMS.         *
*         *                                                          *
*         *      IF SAM SHOULD FAIL WHILE LOADING THE CCP            *
*         *                                                          *
*         *      THIS INFORMATION WILL BE HELPFULL FOR               *
*         *                                                          *
*         *      DEBUGGING THE SAM-P PROGRAMS.....                   *
*         *                                                          *
*         ************************************************************
          SPC    2
          ENT    PMSVMSG
          SPC    2
GETWRD    NUM    0           LOCATION OF WORD TO READ FROM MEMORY 
SVWRD     NUM    0           LOCATION OF WORD TO STORE IN MEMORY
SVI       NUM    0           LOCATION TO SAVE THE I-REGISTER
TTSW      NUM    0           TEST SWITCH FOR STORING WORDS
          SPC    2
TOEXIT    LDA*   SVI         RELOAD THE I-REGISTER, THEN EXIT 
          STA-   I
          JMP*   (PMSVMSG)   RETURN TO CALLER 
          SPC    1
PMSVMSG   NOP 
          LDA-   I           SAVE I-REGISTER
          STA*   SVI
          RAO*   TTSW        SET SWITCH CELL TO = 1 
          ENA    $F          SERVICE MESSAGE IS 9 WORDS LONG
          STA-   I           REGISTER I IS FOR INST ( D I P ) 
          LDA+   =$4FE0      LOCATION TO STORE SER/MEG. 
          LDQ+   =$41A0      LOCATION TO READ SER/MSG 
NEXT      STA*   SVWRD       RESET STORE MESSAGE CELL 
          STQ*   GETWRD      RESET READ MESSAGE CELL
          ENQ    0           RESET INDEX POINTER
AGAIN     LDA*   (GETWRD),Q  MOVE SERVICE MESSAGE 
          STA*   (SVWRD),Q   STORE WORD 
          INQ    1           BUMP INDEX 
          DIP    3           CHECK FOR COMPLETATIONS OF MOVE
          SPC    2
          LDA*   TTSW        TEST IF MOVE IS DONE 
          SAN    NEXT1       NO, SET FOR NEXT MOVE
          JMP*   TOEXIT      YES,  RETURN TO CALLER 
          SPC    2
NEXT1     INA    -1 
          STA*   TTSW        RESTORE TTSW TEST SWITCH 
          ENA    $F          NEXT MOVE F WORDS. 
          STA-   I           RESET TEST REGISTER ( I )
          LDA+   =$4FF0      STORE ADDRESS. 
          LDQ+   =$4214      READ ADDRESS 
          JMP*   NEXT        GO MOVE WORDS
          END 
          NAM    PMINTH 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
**  N A M E   -    P M I N T H                                        * 
*                                                                     * 
**  A C T I O N    C O U P L E R   I N T E R R U P T S                * 
*                                                                     * 
*                                                                     * 
*                                                                     * 
** OVERVIEW  -   THIS ROUTINE HANDLES TWO KINDS OF INTERRUPTS:        * 
*                                                                     * 
*                                                                     * 
*                  1. ORDERWORD LOADED                                * 
*                  2. INPUT/OUTPUT COMPLETED                          * 
*                                                                     * 
*                                                                     * 
** INPUT     -   PMSTAT EXTERNAL TO PASCAL ROUTINES                   * 
*                                                                     * 
*                  PMSTAT = INTERRUPTS PROCESSING STATE               * 
*                                                                     * 
*                                                                     * 
** CALLING PROGRAMS                                                   * 
*                                                                     * 
*                NONE                                                 * 
*                                                                     + 
*                  THIS ROUTINE IS ENTER BY INTERRUPTS.               * 
*                  LINE 5 INTERRUPT  COUPLER NO.2                     * 
*                  LINE 6 INTERRUPT  COUPLER NO.1                     * 
*                                                                     * 
** OUTPUT    -   PMSTAT  =  INTERRUPTS PROCESSING STATE  CODE         * 
*            -   B0WAIT  =  TEST SWITCH  0=DONE,1=PROCESSING          * 
*                                                                     * 
** EXTERNAL  -   SUBROUTINE  (PASCAL WRITTEN PROGRAMS)                * 
*                                                                     * 
*                  PMPSOW   PROCESS ORDER WORD                        * 
*                  PMIOHD   PROCESS INPUT OUTPUT                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          EJT 
* 
**  N P U   C O U P L E R   C O M M A N D S . . . . 
* 
          SPC    2
          EQU    MNCOBL($58) OUTPUT BUFFER LENGTH...
          EQU    MNCICS($50) INPUT COUPLER STATUS...
          EQU    MNCIOW($60) INPUT ORDER WORD...
          EQU    MNCONS($48) OUTPUT NPU STATUS... 
          EQU    MNCOMA($6C) OUTPUT MEMORY ADDRESS... 
          EQU    MNCIMA($10) INPUT MEMORY ADDRESS...
          EQU    MNCINS($40) INPUT NPU STATUS...
* 
** E N D   C O U P L E R   C O M M A N D S . . .
* 
          SPC    2
* 
**  C O U P L E R   P R O G R A M    S T A T E   I N T E R R U P T
* 
          EQU    MSTCDN(00)  COUPLER IS DOWN... 
          EQU    MSTWNR(01)  WAIT FOR N.S. WORD RESPONSE... 
          EQU    MSTPOW(02)  PROCESS ORDER WORD...
          EQU    MSTWOW(03)  WAIT FOR ORDER WORD LOAD...
          EQU    MSTWLD(04)  WAIT FOR LOADING OR DUMPING... 
          EQU    MSTLWN(05)  LOADING WAIT FOR N.S.-WORD RESPONSE... 
          EQU    MSTWOP(06)  WAIT FOR OUTPUT... 
          EQU    MSTPOP(07)  PROCESS OUTPUT...
          EQU    MSTWIP($8)  WAIT FOR INPUT...
          EQU    MSTIPO($9)  INPUT PROCESS... 
          EQU    MSTIWN($A)  INPUT WAIT FOR N.S. WORD RESPONSE... 
          EQU    MSTLPO($B)  LOADING PROCESS ORDER WORD...
* 
**  E N D   O F   C O U P L E R    I N T E R R U P T   S T A T E
* 
          SPC    2
* 
**   C O U P L E R   S T A T U S   R E G I S T E R  B I T S 
* 
          SPC    2
          EQU    MCSNSL($0004)    NPU STATUS WORD LOADED... 
          EQU    MCSMAL($0008)    MEMORY ADDRESS REGISTER LOADED... 
          EQU    MCSTXC($0020)    PPU COMPLETED I/O OPERATION...
          EQU    MCSTTP($0080)    PPU SET CHANNEL INACTIVE... 
          EQU    MCSOWL($0100)    PPU WRITEN ORDER WORD...
          EQU    MCSNSR($0002)    PPU READ NPU ORDER WORD...
          EQU    MCSTMO($0400)    TIMOUT... 
          EQU    MCSCAZ($4000)    COUPLER FOUND ZERO IN CHAIN...
          SPC    1
* 
**  E N D   C O U P L E R   S T A T U S   R E G I S T E R 
* 
          EJT 
* 
**  T I M E O U T   T A B L E    C O N S T A N T S... 
**  A N D   E X T E R N A  L  T A B L E  E N T R Y... 
* 
          SPC    2
          EXT    MTTMRTAB         BASE ADDRESS OF TIMEOUT TABLE 
          SPC    2
          EQU    S0MMER(9)        NOT AN 8K SYSTEM. 
          EQU    MTPPKCLK(10)     1  SECOND DELAY COUNT.
          EQU    MTPPDCLK(100)    10 SECOND DELAY COUNT 
          EQU    MTPPUDED(2)      INDEX TO TIMEOUT TABLE
          EQU    MTPPUKA(5)       INDEX TO TIMEOUT TABLE
          EQU    MPBFLN(127)      C I B  BUFFER SIZE. 
* 
** E N D   T I M E O U T   E X T   E Q U
* 
          SPC    2
* 
**  E X T E R N A L  T O  P R O G R A M  P M I N T H
* 
          SPC    2
          EXT    B0ERROR          SERVICE MESSAGE FLAG. 
          EXT    B0WAIT           PROCESSING FLAG 1=BUSY
          EXT    BSREGS           AREA TO SAVE INTERRUPT REGISTER 
          EXT    MCPCON           COUPLER CONNECTION PORT NUMBER
          EXT    PMIOHD           PASCAL PROGRAM TO PROCESSI/O
          EXT    PMPSOW           PASCAL PROGRAM PROCESS ORDER WORD 
          EXT    MPSTAT           COUPLER INTERRUPT STATE 
          EXT    MPSTUS           COUPLER STATUS BITS 
          EXT    MPPARM           COUPLER ORDER WORD
          EXT    MPPINT           UPLINE FLAG 
          SPC    1
* 
**   E N D  O F  E X T E R N A L S
* 
          EJT 
          ENT    PMINTH 
          SPC    2
* 
* 
PMINTH    NOP    0                PMINTH ENTRY POINT
          SRG+   BSREGS           SAVE INTERRUPTS REGISTERS.
          CLR    A
          TRA    M                CLEAR MASK REGISTER.
          LDQ+   MPSTAT           GET INTERRUPT STATE CONDITION.
          JMP*   PMINDX,Q         GO PROCESS STATE CONDITION. 
          SPC    2
* 
**  I T E R R U P T S   S T A T E  J U M P  T A B L E 
* 
          SPC    2
PMINDX    JMP*   PMIN10           STATE = MSTCDN
          JMP*   PMIN30           STATE = MSTWNR
          JMP*   PMIN10           STATE = MSTPOW
          JMP*   PMIN30           STATE = MSTWOW
          JMP*   PMIN30           STATE = MSTWLD
          JMP*   PMIN30           STATE = MSTLWN
          JMP*   PMIN30           STATE = MSTWOP
          JMP*   PMIN10           STATE = MSTPOP
          JMP*   PMIN30           STATE = MSTWIP
          JMP*   PMIN10           STATE = MSTIPO
          JMP*   PMIN10           STATE = MSTIWN
* 
**  E N D   O F  S T A T E   J U M P   T A B L E . .
* 
          SPC    3
PMIN10    CLR    A                  STATE=MSTLPO CLEAR BOWAIT 
          STA+   B0WAIT 
PMIN20    LRG+   BSREGS           RESTORE INTERRUPTS REGISTERS
          JMP*   (PMINTH)         DO A EXIT INTERRUPT STATE INSTRUCTION.
          SPC    3
PMIN30    LDQ+   MCPCON           LOAD Q WITH EQUIPMENT NUMBER
          INQ    MNCICS           ADD FUNCTION COMMAND
          SIO 
*IF DEF,DEBUG 
**---------------------------** 
** T E S T  C O D E  O N L Y ** 
**---------------------------** 
          EXT    COUPLR 
          EXT    QREGS
          EXT    AREGS
          EXT    IFUNC
          EXT    OFUNC
          RTJ    COUPLR 
          RTJ    QREGS
          RTJ    AREGS
          RTJ    IFUNC
**---------------------------** 
** E N D  O F  T E S T       ** 
**---------------------------** 
*ENDIF
          STA+   MPSTUS           SAVE COUPLERS STATUS
          ALS    10                CHECK MCSOWL (BIT8)
          SAM    PMIN40           NOT PPU WRITE ORDER WORD
          LDQ+   MCPCON           INPUT O W COMMAND 
          INQ    MNCIOW 
          SIO 
*IF DEF,DEBUG 
**-------------------------------** 
** T E S T   C O D E     O N L Y ** 
**------------------------------**
          RTJ    COUPLR 
          RTJ    QREGS
          RTJ    AREGS
          RTJ    IFUNC
**------------------------------**
** T E S T   C O D E  O N L Y   **
**------------------------------**
*ENDIF
          STA+   MPPARM           STORE ORDER WORD. 
          JMP*   PMIN50           PROCESS PPU WRITE ORDER WORD
          SPC    1
PMIN40    LDA+   MPSTAT           GET COUPLER STATE WORD
          INA    -MSTWOP          CHECK IF WAITING FOR OUTPUT 
          SAN    PMIN42           NO,GO CHECK NEXT STATE
          RTJ+   PMIOHD           GO PROCESS OUTPUT 
          JMP*   PMIN20           PREPARE TO EXIT FROM INTERRUPT PROGRAM
          SPC    3
PMIN42    INA    -2               CHECK WATING INPUT(MSTWIP 8 ) 
          SAZ    PMIN44           YES, RESET TIMEOUT COUNTERS.
          JMP*   PMIN20           NO, PREPARE TO EXIT,CHANGE STATE
          SPC    2
PMIN44    STA+   MPPINT           CLEAR UPLINE FLAG.
          ENA    MSTWLD           SET STATETO (MSTWLD 4)
          STA+   MPSTAT           UPDATE STATE INTERRUPT CELL.
          ENA    MTPPKCLK         1  SECOND TIMER COUNT 
          ENQ    MTPPUKA-1        INDEX INTO TIMEOUT TABLE
          STA+   MTTMRTAB,Q         START KEEP ALIVE TIMER. 
          ENQ    MTPPUDED-1       INDEX INTO TIMEOUT TABLE
          ENA    MTPPDCLK         10 SECOND TIMER CNT.
          STA+   MTTMRTAB,Q         START PPU DEAD TIMER. 
          LDA    B0ERROR           SERVICE MESSAGE FLAG.
          INA    -S0MMER           CHECK IF 8K MM SYSTEM. 
          SAN    PMIN46            SYSTEM OK CONTINUE.
          NUM    $18FF             HUNG SYSTEM NOT 8K OF MM.
PMIN46    JMP*   PMIN20           PREPARE TO EXIT.
          SPC    2
PMIN50    LDA+   MPSTAT           GET COUPLER INTERRUPT STATE 
          INA    -MSTWNR          CHECK STATE (MSTWRN 1)
          SAN    PMIN51           N0 CHECK IF (MSTWOW 3)
          JMP*   PMIN58           YES,PROCESS (MSTWNR 1) STATE
          SPC    1
PMIN51    INA    -2               CHECK STATE (MSTWNR 3)
          SAN    PMIN52           COUPLER STATE NOT EQUAL 
          JMP*   PMIN58           STATE EQUALS (MSTWNR 3) 
          SPC    2
PMIN52    INA    -1               CHECK STATE (MSTWLD 4)
          SAN    PMIN53           NOT EQUAL TO MSTWLD 
          JMP*   PMIN60           STATE EQUALS MSTWLD.
PMIN53    INA    -1 
          SAN    PMIN54 
          JMP*   PMIN60           STATE EQUAL TO MSTWLD.
          SPC    2
PMIN54    INA    -3               CHECK STATE (MSTWIP 8)
          SAZ    PMIN56           STATE EQUALS MSTWIP,PROCESS 
PMIN55    JMP*   PMIN20           PREPARE TO EXIT MSTWIP
          SPC    2
PMIN56    ENA    MSTIPO           SET STATE (MSTIPO 9)
          STA+   MPSTAT           UPDATE MPSTAT STATE CELL. 
          RTJ+   PMPSOW           GO PROCESS ORDER WORD 
          JMP*   PMIN20             PREPARE TO EXIT 
          SPC    2
PMIN58    LDQ+   MCPCON             COUPLER EQUIPMENT NUMBER
          INQ    MNCOBL             ADD FUNCTION LINK COMMAND 
          ENA    MPBFLN             SIZE OF LINK BUFFER 
          SIO                       GO OUTPUT COMMAND 
*IF DEF,DEBUG 
**---------------------------** 
** T E S T  C O D E  O N L Y ** 
**---------------------------** 
          RTJ    COUPLR 
          RTJ    QREGS
          RTJ    AREGS
          RTJ    OFUNC
**---------------------------** 
** E N D  O F  T E S T       ** 
**---------------------------** 
*ENDIF
          ENA    MSTPOW             SET STATE TO (MSTSOW 2) 
          STA+   MPSTAT             UPDATE STATE INTERRUPT CELL 
          RTJ+   PMPSOW             GO PROCESS ORDER WORD 
          JMP*   PMIN20             RETURN TO CALLLER 
          SPC    2
PMIN60    ENA    MSTLPO             SET STATE (MSTLPO 11) 
          STA+   MPSTAT             UPDATE STATE INTERRUPT CELL 
          RTJ+   PMPSOW             GO PROCESS ORDER WORD 
          JMP*   PMIN20             RETURN TO CALLER
          END    PMINTH 
          NAM    PMODDI 
************************************************************************
*                                                                      *
** NAME -      PMODDI                                                  *
*                                                                      *
** OVERVIEW -  THE OUTPUT DATA DEMAND (ODD) INTERRUPT IS PROCESSED     *
*              FROM THE CLA. IF OUTPUT IS ACTIVE, CHARACTERS ARE       *
*              SENT TO THE CLA SEQUENTIALLY. WHEN THE LAST CHARACTER   *
*              IS SENT, THE CLA IS TURNED OFF AND THE OUTPUT IS SET    *
*              INACTIVE.                                               *
*                                                                      *
** INPUT -     O1BUFF         ADDRESS OF OUTPUT BUFFER                 *
*              O1CLA          ADDRESS OF TRUNK                         *
*              O1ACTIVE       OUTPUT ACTIVE FLAG                       *
*              O1LENGTH       NUMBER OF CHARACTERS IN THIS OUTPUT      *
*              O1COUNT        CURREEN CHARACTER TO SEND                *
*                                                                      *
*                                                                      *
************************************************************************
          SPC    3
          ENT    PMODDI 
          EXT    O1BUFF 
          EXT    O1CLA
          EXT    O1ACTIVE 
          EXT    O1LENGTH 
          EXT    O1COUNT
          EXT    C0INDEX     **++  T E S T  C O D E  O N L Y .
          EXT    MTTMRTAB    R T C  BASE POINTER TO TABLE.
          EXT    BSREGS      POINTER TO SAVE REGISTERS FO INTERRUPT.
          EXT    M0TRUNK     CLA CURRENT ADDRESS. 
          EXT    B0WAIT 
          EXT    B0ERROR
* 
          EQU    MTODD(7)    ODD TIMEOUT ENTER TO  R C T  TABLE.
* 
T1ODD     NUM    $4          ODD TIMEOUT
MLODD     NUM    $0500       ODD REQUEST TO MLIA. 
P1CHRO    NUM    $CC00       CHARACTER OVERHEAD BITS FOR MLIA.
P1ADRO    NUM    $0F00       CLA OVERHEAD ADDRESS BITS. 
P1DATA    NUM    $0508       DATA COMMAND FUNCTION TO MLIA. 
P1CHR     NUM    0           STORAGE FOR CHARACTER BYTE.
C1OLAST   NUM    $0D8B,$CD2F   SENDING LAST CHARACTER FRAME.
C1OOFF    NUM    $0D8A,$CD20    CLEAR MLIA OON FUNCTION.
BUFF      NUM    0           CONTENT OF POINTER O1BUFF. 
P1CHO     NUM    $0C00
SAVEA     NUM     0 
SAVEQ     NUM     0 
          SPC    2
* 
**                O D D   E N T R Y  P O I N T   F O R
* 
**                  O D D   I N T E R R U P T . 
* 
PMODDI    STA*    SAVEA      SAVE A AND Q REGISTERS.
          STQ*    SAVEQ 
          LDA*   T1ODD       RESET R T C  TIMEOUT FOR ODD.
          ENQ    MTODD-1     POINTER TO  R T C  TABLE FOR ODD.
          STA    MTTMRTAB,Q  STORE IN  R T C  TABLE.
          LDQ*   MLODD       ODD REQUEST. 
          ENA    0           CLEAR A, TO GET CLA ADDRESS. 
          SIO                PUT CLA ADDRESS IN A.
          SUB    M0TRUNK     COMPARE WITH CURRENT CLA ADDRESS.
          SAZ    PMOD1       CLA EQUAL, CONTINUE. 
          JMP*   PMO5        EXIT,WRONG CLA.
* 
PMOD1     LDA    O1ACTIVE    CHECK IF TRUNK ACTIVE. 
          SAP    PMOD2       TRUNK IS ACTIVE, PROCESS INTERRUPT.
          JMP*   PMO5        TRUNK IS NOT ACTIVE, EXIT. 
          SPC    2
* 
**               T R U N K  I S  A C T I V E  P R O C E S S 
* 
**                       I N T E R R U P T .
* 
          SPC    2
PMOD2     LDA    O1BUFF      GET DATA BUFFER POINTER. 
          STA*   BUFF        SAVE POINTER FOR LATER.
          LDA    O1COUNT     CURRENT OUTPUT POINTER.
          SUB    O1LENGTH    COMPARE WITH OUTPUT SIZE.
          SAM    PMO1        SKIP, IF NOT LAST CHARACTER. 
          SAZ    PMOD3       IF ZERO, SEND LAST CHARACTER.
          JMP*   PMO3        JUMP IF LAST CHARACTER WAS SENT. 
* 
PMOD3     JMP*   PMO2        JUMP TO SEND LAST CHARACTER. 
          SPC    2
* 
**         S E N T  D A T A  A N D  S U P E R V I S O R Y 
* 
**               B Y T E S  T O  M L I A .
* 
          SPC    2
PMO1      LDQ    O1COUNT     ADJUST CURRENT OUTPUT POINTER. 
          INQ    -1          FOR UPPER OR LOWER BYTE. 
          ENA    0           CLEAR A-REG, FOR NEW BYTE. 
          LCA*   (BUFF),Q    LOAD NEW CHARACTER BYTE. 
          ADD*   P1CHRO      ADD OVERHEAR BITS. 
          STA*   P1CHR       SAVE NEW BYTE FOR OUTPUT LATER.
          LDA    O1CLA       GET CLA ADDRESS.DRESS
          ADD*   P1ADRO      ADD OVERHEAD BITS FOR MLIA.
          LDQ*   P1DATA      LOAD Q-REG. WITH DATA COMMAND. 
          SIO                OUTPUT CLA ADDRESS TO MLIA.
          LDA*   P1CHR       LOAD DATA AND OVERHEAD FOR MLIA. 
          SIO                OUTPUT DATA WORD TO MLIA.
          JMP*   PMO4        JUMP TO EXIT FROM ROUTINE. 
          SPC    2
* 
**        S E N D  D A T A  A N D  S U P E R V I S O R Y
* 
**        B Y T E S  F O R  L A S T  C H A R A C T E R
* 
**               F R A M E  T O  M L I A .
* 
          SPC    2
PMO2      LDQ*   P1DATA      LOAD Q WITH DATA COMMAND.
          LDA    O1CLA       LOAD  A-REG. WITH CLA ADDRESS. 
          ADD*   P1ADRO      ADD OVERHEAD BITES.
          SIO                OUTPUT CLA ADDRESS TO MLIA.
          LDQ    O1COUNT     ADJUST CURRENT<OUTPUT POINTER. 
          INQ    -1          FOR UPPER OR LOWER CHARACTER BYTE. 
          ENA    0           CLEAR A FOR NEW CHARACTER BYTE.
          LCA*   (BUFF),Q    GET LAST DATA CHARACTER BYTE.
          ADD*    P1CHRO
          LDQ*   P1DATA      SET Q WITH DATA COMMAND. 
          SIO                OUTPUT LAST DATA BYTE TO MLIA. 
          LDA    O1CLA
          ADD*   P1ADRO 
          SIO 
          LDA*   C1OLAST     1ST SUPERVISION OVERHEAD AND CHAR. 
          SIO                SEND BYTES TO MLIA.
          LDA*   C1OLAST+1   2ND SUPERVISION OVERHEAD AND CHAR. 
          SIO                SEND BYTES TO MLIA.
          JMP*   PMO4        JUMP TO EXIT FROM ROUTINE. 
          SPC    2
* 
**        S E N D  S U P E R V I S I O N  C H A R A C T E R  A N D
* 
**        O V E R H E A D  B Y T E S  F O R  L A S T  C H A R A C T E R 
* 
**               F R A M E  T O  M L I A. 
* 
          SPC    2
PMO3      LDQ*   P1DATA      SET Q-REG. WITH DATA COMMAND.
          LDA    O1CLA       GET CLA ADDRESS. 
          ADD*   P1ADRO      ADD OVERHEAD BITS. 
          SIO                SEND BYTES TO MLIA.
          LDA*   C1OOFF      GET BYTES TO CLEAR OON.
          SIO                SEND BYTES TO MLIA.
          LDA*   C1OOFF+1    GET 2ND BYTES TO CLEAR OON.
          SIO                SEND BYTES TO MLIA.
          ENA    0           CLEAR CONTROLLING CELLS FOR COMPLETE.
          ENQ    MTODD-1     ENTRY TO  R T C  TABLE.
          STA    MTTMRTAB,Q  CLEAR ODD TIMEOUT COUNTER. 
          STA    C0INDEX     **++ T E S T  C O D E  O N L Y 
          STA    O1ACTIVE    CLEAR OUTPUT ACTIVE CELL.
          STA    B0WAIT      CLEAR TIMEOUT WAIT CELL. 
          SPC    2
* 
**        I N C R E A S E  O U T P U T  C O U N T E R  F O R
* 
**        N E X T  B Y T E  P O I N T E R  T O  S E N D 
* 
**          M L I A  O N  N E XT  I N T E R R U P T . 
* 
          SPC    2
PMO4      LDA    O1COUNT     INCREASE OUTPUT COUNTER BY 1.
          INA    1
          STA    O1COUNT     STORE NEXT CHARACTER TO SEND 
          SPC    2
* 
**        E X I T  B Y  W A Y  OF  T R A P  A R E A.
* 
          SPC    2
PMO5      LDA*    SAVEA      RELOAD A AND Q REGISTERS.
          LDQ*    SAVEQ 
          EXI    48          EXIT FROM INTERRUPT TRAP AREA. 
          END    PMODDI 
          NAM    PMTMRS 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                      *
** N A M E .     PMTMRS.                                               *
*                                                                      *
** A C T I O N . THE SAM TIMER INTERRUPT HANDLER IS RESPONSIBLE        *
*                FOR UPDATING THE TIMER TABLE AND GIVING CONTROL       *
*                TO THE TIMER EXPIRRATION ROUTINE FOR A TIMER THAT     *
*                EXPIRES.                                              *
*                                                                      *
*                EACH TIME THIS ROUTINE GETS CONTROL EVERY TIMER       *
*                IN THE TABLE IS CHECK                                 *
*                                                                      *
** I N P U T .   TIMER TABLE.  (MTTMRTAB)                              *
*                                                                      *
** C A L L I N G  P R O G R A M .                                      *
*                NONE -  THIS ROUTINE IS ENTER DUE TO INTERRUPT.       *
*                                                                      *
** O U T P U T . THE TIMER TABLE IS UPDATED                            *
*                                                                      *
** E X T E R N A L   S U B R O U T I N E   C A L L E D                 *
*                                                                      *
*                PMNSTO, PMLRTO, PMPPDTO, PMDSRTO, PMPPKTO,            *
*                PMIRTO, PMODDTO - ARE CALLER BY A RETURN JUMP.        *
*                                                                      *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMTMRS 
          SPC    2
          EXT    PMSCLI 
          EXT    ACTINT 
          EXT    MTTMRTAB 
          EXT    MTDISP 
          EXT    BSREGT 
          EXT    PMSCLK 
          SPC    1
          BSS    PMTIND(1)
          BSS    PMTRTJ(1)
          SPC    3
PMTMRS    NOP    0
          SRG+   BSREGT           SAVE INTERRUPTS REGISTERS.
          LDA    ACTINT           NEW MASK BITS 
          EIN     0           ENABLE SYSTEM INTERRUPTS. 
          TRA    M                RESET MASK REGISTER.
          RTJ    PMSCLI           GO CLEAR RTC INTERRUPT. 
          ENA    0
          STA*   PMTIND           INITIALIZE INDEX TABLE. 
          SPC    1
PMTM01    LDQ*   PMTIND           INDEX TO TIMER TABLE. 
          IIN    0                DISABLE SYSTEM INTERRUPTS.
          LDA+   MTTMRTAB,Q       LOAD TIMER TABLE ENTRY. 
          SAZ    PMTM03           IF ZERO,BY PASS ENTRY.
          INA    -1               DECREAMENT TIMER TABLE ENTRY. 
PMTM02    STA    MTTMRTAB,Q       RESTORE TIMER ENTRY.
          SAZ    PMTM04           IF ZERO, JUMP TO TIMER ROUTINE. 
PMTM03    EIN    0                ENABLE SYSTEM INTERRUPTS. 
          INQ    -7          CHECK IF SCAN COMPLETE.
          SQZ    PMTM05           YES, EXIT FROM ROUTINE. 
          RAO*   PMTIND            NO,  CONTINUE TABLE SCAN.
          JMP*   PMTM01           JUMP TO CONTINUE. 
          SPC    1
PMTM04    LDA+   MTDISP,Q         GET RETURN ADDRESS FOR RTJ. 
          STA*   PMTRTJ           SAVE RTC SUBROUTINE ADDR. 
          RTJ*   (PMTRTJ)         RTJ TO RCT SUBROUTINE.
          LDQ*   PMTIND           RELOAD INDEX TO Q REGISTER. 
          JMP*   PMTM03           CONTINUE TO SCAN TIMER TABLE. 
          SPC    1
PMTM05    RTJ    PMSCLK           GO RESET RTC
          LRG+   BSREGT           RESTORE INTERRUPT REGISTERS.
          IIN    0           DISABLE SYSTEM INTERRUPTS. 
          JMP*   (PMTMRS)         EXIT FROM TIMER CHECK ROUTINE.
          END    PMTMRS 
          NAM    PMLDMT 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME        PMLDMT                                                 * 
*                                                                     * 
** ACTION   PMLDMT LOADS MICRO MEMORY WITH DEAD MAN TIMER RESET.      * 
*                                                                     * 
** OVERVIEW -  PMLDMT LOADS MICRO MEMORY WITH DEAD MAN TIMER RESET    * 
*              CODE.                                                  * 
*                                                                     * 
** INPUT -     NONE                                                   * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PMINIT                                                 * 
*                                                                     * 
** OUTPUT -    MICRO MEMORY LOADED WITH DMT RESET CODE                * 
*                                                                     * 
** EXTERNAL SUBROUTINE -                                              * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMLDMT 
          EXT    B1DMTA 
B1DMTB    ADC    B1DMTA 
P1DMTC    NUM    $5717,$000F     MICRO MEMORY 
          NUM    $571F,$4B00       RESET
          NUM    $5FDB,$0700         CODE 
          NUM    $98D8,$503E
          EQU    P1DMTS(*-P1DMTC) 
          EQU    P1DMTL(P1DMTS/2) 
* 
PMLDMT    NOP 
          ENQ    P1DMTL                      LENGTH OF TIMER RESET
          LR2    =XP1DMTC                    POINTER TO DMT CODE. 
          LDA*   B1DMTB                      POINTER TO MICRO LOAD ADDR 
          ALS    1
          XFA    1
          LMM    0                           LOAD DMT RESET 
          JMP*   (PMLDMT) 
          END    PMLDMT 
          NAM    PMDMT
* * * *  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                                                                      *
**        NAME     PMDMT                                               *
*                                                                      *
**        ACTION   PMDMT START MICRO MEMORY WITH                       *
*                  DEAD MAN TIMES RESET.                               *
*                                                                      *
*                                                                      *
**        OVERVIEW   PMDMT  RESETS THE DEAD MAN TIMER.                 *
*                                                                      *
*                                                                      *
**        INPUT      NONE.                                             *
*                                                                      *
*                                                                      *
**        CALL PROGRAMS.      PMWAIT.                                  *
*                                                                      *
*                                                                      *
**        OUTPUT    RESET TIMER.                                       *
*                                                                      *
*                                                                      *
**        EXTERNAL SUBROUTINE.     NONE.                               *
*                                                                      *
*                                                                      *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *
          SPC    3
          ENT    PMDMT
          EXT    B1DMTA 
B1DMTB    ADC    B1DMTA 
          SPC    3
PMDMT     NOP 
          LDQ*   B1DMTB                      PTR TO MICRO START DMT.
          EMS    Q                           EMS TO MICRO RESET DMT 
          JMP*   (PMDMT)                     RETURN TO CALLING PROG.
          END    PMDMT
          NAM    PMSCLK 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME        PMSCLK                                                 * 
*                                                                     * 
** ACTION      SET UP REAI TIME CLOCK INTERRUPT                       * 
*                                                                     * 
** OVERVIEW -  SET UP ADT TABLE FOR REAL TIME CLOCK                   * 
*              AND DOES A DMI INSTRUCTION.                            * 
*                                                                     * 
** INPUT -     NONE                                                   * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PMINIT                                                 * 
*                                                                     * 
** OUTPUT -    REAL TIME CLOCK ACTIVATED                              * 
*                                                                     * 
** EXTERNAL SUBROUTINE -                                              * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMSCLK 
* 
P1RTC     NUM    $00F3                       RTC EQUIPMENT CODE 
P1CL8     NUM    $8008                       LINE 8 CLOCK INTERRUPT 
P1CLKADT  NUM    $80F0                       CLOCK ADT TABLE
P1CLKCT   NUM    0                           CLOCK COUNTER
          NUM    30                          TICKS PER INTERRUPT 100 MS 
          NUM    0                           NOT USED/ NEEDED FOR ADT.
PMSCLK    NOP 
          ENA 
          STA*   P1CLKCT                     RESET CLOCK COUNTR TO ZERO 
          LDQ*   P1CL8                       Q SETTING FOR ADT/DMI. 
          LDA*   =XP1CLKADT                  POINTER TO ADT TABLE.
          DMI    0                           DEFINE CLOCK INTERRUPT 
          LDQ*   P1RTC                       ENABLE REAL TIME CLOCK 
          NOP 
          OUT    -1                          OUTPUT TO START CLOCK. 
          JMP*   (PMSCLK)                    RETURN TO CALLING PROG.
* 
**        PMSCLK
* 
          ENT    PMSCLI 
* 
PMSCLI    NOP    0                           ENTRY POINT CLR/RTM/INT. 
          LDQ*   P1RTC                       RTC EQUIPMENT FUNCTION.
          INQ    -3 
          NOP    0                           REQUIRE FOR OUT INSTR. 
          OUT    -1                          CLEAR OLD INTERRUPT. 
          JMP*   (PMSCLI)                    RETURN TO CALLER.
          END 
          NAM    PMMASK 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME        PMMASK                                                 * 
*                                                                     * 
** ACTION        SET UP INTERRUPT BITS IN MASK REGISTER               * 
*                                                                     * 
** OVERVIEW -  THIS ROUTINE SETS THE INTERRUPT MASK BITS.             * 
*                                                                     * 
** INPUT -     MPMASK - CONTAINS INTERRUPT MASK BITS                  * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PMINIT PMROUT                                          * 
*                                                                     * 
** OUTPUT -    INTERRUPT MASK REGISTER  LOADED                        * 
*                                                                     * 
** EXTERNAL SUBROUTINE -                                              * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
          SPC    3
          ENT    PMMASK 
* 
PMMASK    NOP 
          LDQ*   (PMMASK)                    PARAMETER ADDRESS
          LDA+   0,Q                         GET MASK TO A REGISTER 
          TRA    M                           INTERRUPT MASK 
          RAO*   PMMASK                      POSITION RETURN ADDRESS
          JMP*   (PMMASK)                    RETURN TO CALLING PROG.
          END 
         NAM     PMENTRY
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME     -  PMENTRY                                                * 
*              PMREENT                                                * 
*              PMINTRP                                                * 
*              PMFAIL                                                 * 
*                                                                     * 
*           SET UP INTERRUPTS                                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                             * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THE LOADED PROGRAM IS ENTERED AT CORE LOCATION ZERO.   * 
*              WHEN IT RETURNS, IF IT DOES, THE INTERRUPT JUMPS EOR   * 
*              THE DEAD MAN BOOT ARE RESTORED                         * 
*                                                                     * 
** INPUT -      NONE                                                  * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*               PMINIT                                                * 
*                                                                     * 
** OUTPUT -     NONE                                                  * 
*                                                                     * 
** EXTERNAL REFERENCE -                                               * 
*               NONE                                                  * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
         SPC     3
* 
          EXT     I1MSG 
          EXT     I1ACTIVE
         EXT     PMTMRS 
         EXT     PMRSTM 
         EXT     PMTMON 
         EXT     B0ERROR
         EXT     PMODDI 
         EXT     PMLFI
         EXT     PMINTH 
         EXT   LKVER
         EXT   LKLEV
         EXT   LKCYC
         ENT   CCPVER 
         ENT   CCPLEV 
         ENT   CCPCYC 
CCPVER   ADC   LKVER          - SETS THE VERSION
CCPLEV   ADC   LKLEV          - SETS THE LEVEL
CCPCYC   ADC   LKCYC          - SETS THE CYCLE
         ENT     PMINTRP
         ENT     PMENTRY
         ENT     PMREENT
B6JUMP   NUM     $5400
B1JUMP    NUM     $1400      INST. JMP TO PROG. 
RTNCP1   NUM     $0E18
RTNCP2   NUM     $0E14
RTNCLK   NUM     $0E20
RTNODD   NUM     $0E30
RTNLFI   NUM     $0E34
PMENTRY  NOP
* 
         SRG     BSREGS 
          LDA*   B6JUMP      - LOAD A WITH 5400 
          STA-   2           - SET LOC2 TO RTJ (5400).
          LDA-   =XPMREENT   - LOAD A WITH THE REENTRY ADDRESS
          STA-   3           - SET LOC 3 TO REENTRY ADDRESS.
         JMP+    0
* 
PMREENT  NOP     0            -         RE-ENTRY TO DEAD MAN BOOT 
         IIN     0
         STA     B0ERROER 
         RTJ*    PMINTRP      -         RE-BUILD INTERRUPTS 
         LRG     BSREGS 
         JMP*    (PMENTRY)    -         EXIT
* 
PMINTRP  NOP
         LDA*  B6JUMP        - LOAD A WITH 5400 
          STA-   2           - RESTORES LOC2 TO RTJ (5400). 
          STA+    $119        LINE 6 INTTERUPT TRAP 
          STA+    $115        LINE 5 INTTERUPT TRAP 
          STA+    $121        CLOCK INTTERUPT  TRAP 
          STA+    $135        LINE FRAME INTERRUPT TRAP 
         LDA*  =XPMREENT     -LOADS A WITH THE REENTRY ADDRESS
          STA-   3           - RESTORE LOC3 TO REENTRY ADDRESS. 
         LDA+    =XPMINTH    COUPLERS INTERRUTP PROCESSOR.
         STA+    $11A        INTRRUPTS LINE6 PROCESSOR ADDR.
         LDA*    RTNCP1      LINE6 EXCAPE CODE ($0E18)
         STA+    $11B        LINE6 ESCAPE CODE ($0E18)
         LDA+    =XPMINTH    COUPLERS INTERRUPT PROCESSOR.
         STA+    $116        INTERRUPTS LINE5 PROCESSOR ADDR. 
         LDA*    RTNCP2      LINE5 EXCAPE CODE ($0E14)
         STA+    $117        SAVE LINE5 EXCAPE CODE.
         LDA     =XPMTMRS     CLOCK INTERRUPT HANDLER 
         STA+    $122 
         LDA*    RTNCLK      LINE8 EXCAPE CODE ($0E20)
         STA+    $123        STORE EXCAPE IN LINE8 TRAP AREA
* 
            LDA*    B1JUMP      SET TRAP TO JUMP TP PROC. 
         STA+    $131 
         LDA     =XPMODDI     -         ODD INTERRUPT 
         STA+    $132 
* 
         LDA     =XPMLFI      -         LINE FRAME INTERRUPT
         STA+    $136 
         LDA*    RTNLFI      LINE13 EXCAPE CODE ($0E34) 
         STA+    $137        STORE EXCAPE IN LINE13 TRAP AREA 
* 
         JMP*    (PMINTRP)    -         EXIT
         EXT     MAIN 
         EXT     I0OLRIM
         ENT     PMFAIL 
PMFAIL   NOP
          IIN     0 
          LDA+    =N$3100 
          TRA     M 
          ENA     0 
          STA+    I1MSG 
          STA+    I1ACTIVE
         RTJ     PMRSTM 
           LDQ     =XPMTMON 
         INQ     -1 
         STQ*    PMFAIL 
         JMP*    (PMFAIL) 
* 
         BZS     BSAVE(10)
BSREGS   ADC     BSAVE-10 
         END
          NAM    PBPUTPAGE
******************************
*                            *
*        PBPUTPAGE           *
*    WRITE PAGE REGISTER     *
*                            *
******************************
************************************************************************
*                                                                      *
**OVERVIEW- PBPUTPAGE WRITES A SPECIFIED PAGE REGISTER TO EITHER       *
*           PAGE REGISTER BANK.                                        *
*                                                                      *
**INPUT- THE FIRST PARAMETER CONTAINS THE PAGE REGISTER TO WRITE       *
*        (0-31) AND THE PAGE REGISTER BANK TO USE (LEFTMOST BIT        *
*        SET MEANS BANK 1, NOT SET MEANS BANK).  THE SECOND            *
*        PARAMETER CONTAINS THE 9-BIT VALUE TO BE LOADED.              *
*                                                                      *
**OUTPUT- PAGE REGISTER LOADED.                                        *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
************************************************************************
          ENT PBPUTPAGE 
ZERO      NUM    0           MAKE CELL EQUAL TO ZERO. 
* 
PBPUTP   NOP   0
         LDQ*  (PBPUTP) 
         LDA*   (ZERO),Q    GET PAGE NUMBER.
         ALS   11        MOVE TO UPPER 5 BITS 
         STA*  LOCAL     SAVE IT
         RAO*  PBPUTP    BUMP PAST PARAMETER
         LDQ*  (PBPUTP) 
         LDA*   (ZERO),Q    GET VALUE TO LOAD.
         AND   =N$1FF    LEAVE BITS 0-8 
         ORA*  LOCAL     OR IN PAGE REGISTER AND BANK 
         WPR   A         WRITE PAGE REGISTER
         RAO*  PBPUTP    BUMP PAST PARAMETER
         JMP*  (PBPUTP) 
LOCAL    NUM    0 
         END
          NAM    PBSTPMODE
******************************
*                            *
*        PBSTPMODE           *
*     SET PAGE MODE          *
*                            *
******************************
************************************************************************
*                                                                      *
**OVERVIEW- PBSTPMODE SETS THE PAGE MODE TO EITHER ABSOLUTE (NO        *
*           PAGING), PAGE MODE 0 (USE BANK 0 PAGE REGISTERS) OR        *
*           PAGE MODE 1 (USE BANK 1 PAGE REGISTERS).                   *
*                                                                      *
**INPUT- ONE PARAMETER CONTAINING THE PAGE MODE TO SET AS FOLLOWS:     *
*                                                                      *
*               0    PAGE MODE 0                                       *
*               1    PAGE MODE 1                                       *
*               2    ABSOLUTE                                          *
*                                                                      *
**OUTPUT- PROPER PAGE MODE SET.                                        *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
************************************************************************
         ENT   PBSTPMODE
* 
PBSTPM   NOP   0
         LDQ*  (PBSTPM) 
         LDA   0,Q       GET PAGE MODE PARAMETER
         RAO*  PBSTPM 
         SAZ   PMDE0     0 = PAGE MODE 0
         INA   -1 
         SAZ   PMDE1     1 = PAGE MODE 1
         APM   0         SET ABSOLUTE PAGE MODE 
         JMP*  OUT
PMDE0    PM0   0         SET PAGE MODE 0
         JMP*  OUT
PMDE1    PM1   0         SET PAGE MODE 1
OUT      JMP*  (PBSTPM) 
         END
