Retro1.org codex

PIO 
* /---   FILE TYPE = E
* /---   BLOCK      IDENT      00 000   81/09/09  03.09 
          IDENT  PIO,PIO
          TITLE  -PIO-       PLATO CIU INPUT/OUTPUT 
          TITLE  COMMENTS 
          COMMENT PLATO CIU INPUT/OUTPUT
* 
* 
          PERIPH
          SST 
* 
          LIST   F           LIST CONDITIONAL CODE ALSO 
* 
* /---   BLOCK      COMMENTS   00 000   81/04/28  14.22 
************************************************************
* 
* 
* 
*         10 ARGUMENTS ARE PASSED TO THIS PROGRAM - 
* 
* 
*         1.  ECS ADDRESS OF KEY REQUEST SWITCH/LIST
* 
*         2.  NUMBER OF SITES RECOGNIZED
* 
*         3.  RELATIVE ECS ADDRESS OF STATION KEY BUFFERS 
* 
*         4.  RELATIVE ECS ADDRESS OF FRAME COUNTER 
* 
*         5.  RELATIVE ECS ADDRESS OF FRAME LENGTH TABLE
* 
*         6.  RELATIVE ECS ADDRESS OF FRAME BUFFERS 
* 
*         7.  CM ADDRESS OF STATISTICS BUFFER 
* 
*         8.  UNUSED
* 
*         9.  MAXIMUM FRAME LENGTH
* 
*         10. PHYSICAL-LOGICAL SITE MAPPING INFO
* 
* 
* 
************************************************************
* /---   BLOCK      DEFINITION 00 000   82/10/26  13.31 
          TITLE  DEFINITIONS
* 
* 
* 
 
* 
*         DETERMINE OPERATING SYSTEM LEVEL THIS DECK
*         SHOULD BE ASSEMBLED FOR.  ASSEMBLE FOR THE OS 
*         NUMBER SPECIFIED IN THE ',ML', PARAMETER OF THE 
*         -COMPASS- OR -CSTC- CARD.  DEFAULT VALUE IS 518D. 
* 
 
*CALL     COMPMAC 
*CALL     COMSCPS 
*CALL     COMSSSD 
*CALL     PLAP501 
*CALL      PTEXT
*CALL     SYSCON
*CALL     PLASMPC 
*CALL     AIDTEXT 
* 
* 
************************************************************
* 
*         THE FOLLOWING PARAMETERS MUST CORRESPOND TO THE 
*         EQUIVALENT DEFINITIONS IN PLATO 
* 
*         FMASK   - FRAMSHF/FRAMSIZ 
*         KEYBSHF - NKEYSHF 
*         NPARAMS - LOADPIO 
*         STATLTH - PIOSTAT 
*         SCIMLTH - NPIOSC
*         BADLTH  - PIOSTAT 
*         FORINIP - FORINIP 
* 
 FMASK    EQU    177B        MASK FOR FRAME INDEX 
 KEYBSHF  EQU    1           SHIFT FOR KEY BUFFER DIMENSION 
 NPARAMS  EQU    10          NUMBER OF ARGUMENTS
 STATLTH  EQU    4           NUMBER OF CM STATISTICS WORDS
 SCIMLTH  EQU    2           NUMBER CM WRDS IN PIO/SCIM BUFF
 BADLTH   EQU    10          LENGTH OF BAD STATION LIST 
 XBADLTH  EQU    9           LENGTH OF LIST PASSED FROM SCIM
 FORINIP  EQU    2           FRAMAT INITIALIZATION FLAG 
* 
* 
************************************************************
* 
* 
 OFLIMIT  EQU    4           NUMBER OF STATION KEY BUFFER 
*                            OVERFLOWS ALLOWED BEFORE 
*                            BLOCKING STATION 
 PPBLTH   EQU    10          SIZE OF OUTPUT BUFFER
 KEYLTH   EQU    360         SIZE OF KEY INPUT BUFFER 
 
*         NTERMS = NUMBER OF REAL STATIONS (IPTEXT) 
 
* 
* 
************************************************************
* /---   BLOCK      DEFINITION 00 000   84/11/16  10.35 
* 
* 
*         LOW CORE DEFINITIONS
* 
* 
 D.T0     EQU    20B         DIRECT CELL WORK VARIABLES 
 D.T1     EQU    21B
 D.T2     EQU    22B
 D.T3     EQU    23B
 D.T4     EQU    24B
* 
 IOUT     EQU    25B
 NOUT     EQU    26B
 STATION  EQU    27B
 KEY      EQU    30B
 KEYII    EQU    31B
 KEYOI    EQU    32B
 A170     EQU    33B         (0 = 700 MACHINE, 1 = 800) 
* 
 NS       EQU    44B         NUMBER OF SITES FOR THIS CIU 
 
 CB       EQU    45B         CIU BIAS TO GET PLATO STATION
 
 FS       EQU    46B         FIRST LEGAL STATION
 
 D.RSAV   EQU    66B - 67B   SAVE AREA FOR R-REGISTER 
* 
************************************************************
* 
* 
*         ALL-STATIONS MESSAGE OUTPUT DEFINITIONS 
* 
* 
 BASE     EQU    D.T0 
 LENGTH   EQU    D.T1 
 ILOOP    EQU    D.T2 
 ADDRESS  EQU    D.T3 
 
 NN       EQU    4
 NCLASSES SET    1
          DUP    NN,1 
 NCLASSES SET    NCLASSES*2 
* 
* 
************************************************************
* 
* 
* 
*         -KEYSIN-
*         MACRO TO ACCEPT ALL PENDING KEYS FROM CIU 
* 
          PURGMAC KEYSIN
 KEYSIN   MACRO 
          LOCAL  A,B
          EJM    B,I=NIU
 A        CALL   KEYIN
          FJM    A,I=NIU
 B        BSS    0
          ENDM
* 
* 
* /---   BLOCK      MAIN LOOP  00 000   81/04/30  15.04 
          TITLE  MAIN LOOP
* 
* 
* 
          ORG    PPFW 
 PIO      CALL   INITIAL     INITIALIZATIONS
* 
* * *     SELECT THE CIU OUTPUT 
* * *            THIS IS ONLY NEEDED ONCE INITIALLY, AND
* * *            AFTER THE CIU HAS BEEN DE-SELECTED WITH A
* * *            7XXX FUNCTION. 
* * * 
* * *            IF THE CIU OUTPUT IS NOT SELECTED, THE 
* * *            FRAME COUNTER DOES NOT GET WRITTEN BACK, 
* * *            CAUSING THE FRAMER AND THE PPU TO GET OUT
* * *            OF STEP FOR A WHILE.  (SYMPTOM--15 SECONDS 
* * *            OF REPEATED OUTPUT.) 
* 
          LDM    CIUEQ       CHECK IF CIU AVAILABLE 
          ZJP    MAIN          JUMP IF NOT
 
          IJM    M50,O=NIU
          DCN    O=NIU       DEACTIVATE NIU OUTPUT CHANNEL
 
 M50      FNC    0,O=NIU     SELECT OUTPUT CONTROLLER 
          WAIT   INACTIVE,O=NIU,M120
* 
* 
*         WAIT TILL NIU IS READY FOR NEXT FRAME 
* 
 MAIN     CALL   PAUSE       CHECK FOR PAUSE OR ERROR 
          LDM    PINIT
          NJP    M102        CHECK INITIALIZATIONS COMPLETE 
          LOADCM PSTATS 
          CRD    D.T0        READ PPU STATUS WORD 
          LDD    D.T0+4 
          LPN    2           MASK OFF INITIALIZATION BIT
          ZJP    M102 
          LDN    1           MARK INITIALIZATIONS COMPLETE
          STM    PINIT
          DELAY  5000 
          CALL   ALLOUT,ONMSG     PRESS NEXT TO BEGIN 
          DELAY  5000 
* 
*         CHECK IF FRAMAT INITIALIZING
* 
 M102     SOM    FICNT       CHECK IF SHOULD READ ECS FLAG
          NJP    M104 
          LDN    5           RE-SET COUNTER 
          STM    FICNT
* 
 M1020    LDC    ECSBUFF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      COMPUTE ECS ADR OF INITIAL FLAG
          ADC    FORINIP
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA 
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDN    5
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
          CALL   READECS     READ FRAMAT INITIAL FLAG 
          LDM    ECSBUFF
          LPC    4000B       MASK OFF INITIALIZATION BIT
          ZJP    M104 
          CALL   MESSAG,(=16CPIO  WAIT FRAMAT)
          CALL   PAUSE       CHECK FOR STORAGE MOVE / ERROR 
          DELAY  5000        IDLE FOR A WHILE 
          CALL   MESSAG,=0
          UJP    M1020       WAIT FOR INITIALIZATIONS 
* 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.49 
* 
 M104     CALL   STATS       PROCESS STATISTICS 
          LDM    CIUEQ       CHECK IF CIU AVAILABLE 
          ZJP    SPEC          EXIT IF NOT
* 
*         ACCEPT PENDING KEYS FROM CIU AND PASS TO PLATO
* 
          LDM    NFRAME+4    CHECK FRAME COUNT - RE-SELECT
          LPC    77B         CIU INPUT EVERY 64 FRAMES
          NJP    M107 
          KEYSIN             INPUT KEY(S) FROM CIU
          IJM    M105,I=NIU  CHECK IF CHANNEL INACTIVE
          DCN    I=NIU       DE-ACTIVATE INPUT CHANNEL
          WAIT   INACTIVE,I=NIU,M124
* 
 M105     FNC    40B,I=NIU   SELECT INPUT CONTROLLER
          WAIT   INACTIVE,I=NIU,M124
          ACN    I=NIU       ACTIVATE NIU INPUT CHANNEL 
          WAIT   ACTIVE,I=NIU,M124
* 
 M107     LDN    10          PROCESS MAX OF 10 KEYS 
          STM    KOCNT
* 
 M108     KEYSIN             ACCEPT PENDING KEYS FROM CIU 
          LDD    KEYII       LOAD KEY BUFFER INPUT POINTER
          ZJP    M110 
          CALL   KEYOUT      OUTPUT NEXT KEY TO PLATO 
          SOM    KOCNT
          PJP    M108 
* 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.44 
* 
*         ATTEMPT TO SELECT CIU AND OUTPUT NO-OP
* 
 M110     IJM    M112,O=NIU 
          DCN    O=NIU       DEACTIVATE NIU OUTPUT CHANNEL
****
*         A -FNC  0,O=NIU- STATEMENT HAS BEEN REMOVED HERE, 
*         AS IT CAUSED THE NIU TO OVER-WRITE THE DATA 
*         IN ITS HOLD BUFFER, CAUSING PREVIOUS DATA TO BE 
*         OVER-WRITTEN FOR STATION 0. 
* 
*         IT IS THOUGHT THAT THE BIT PATTERN THAT WAS USED
*         FOR NOOP0 FROM 80/1/25 UNTIL THE 81/3/8 (5767B) 
*         WAS GENERATING SOME OVER-WRITES OF THE NIU BUFFER 
*         FOR STATION 0-3 ON CDC SYSTEMS, DUE TO REGISTERS
*         CHANGING AT THE SAME TIME THEY WERE BEING COPIED
*         IN THE NIU (SEE NOTES BY J. STIFLE, 'SEPT. 1980). 
* 
*         IT IS HOPED THAT REMOVING THE CAUSE OF THE OVER-
*         WRITES WILL ALLOW THOSE STATIONS TO FUNCTION
*         AGAIN.
*                            BOB RADER   3/8/81 
****
* 
* M111     FNC    0,O=NIU     SELECT OUTPUT CONTROLLER
*          IJM    M112,O=NIU
*          DELAY  10
*          IJM    M112,O=NIU
*          DCN    O=NIU       DISCONNECT IF NIU NOT READY 
*          UJP    MAIN
* 
 M112     ACN    O=NIU       ACTIVATE NIU OUTPUT CHANNEL
          LDN    1           SEND FIRST WORD OF A NO-OP TO
          OAM    NOOP0,O=NIU      STATION 0 
          EJM    M114,O=NIU  JUMP IF CIU READY FOR FRAME
          DELAY  15 
          EJM    M114,O=NIU 
          IJM    MAIN,O=NIU 
          DCN    O=NIU       DISCONNECT IF NOT READY
          UJP    MAIN 
* 
 M114     LDN    2           SEND REMAINING WORDS OF NO-OP
          OAM    NOOP0+1,O=NIU
          EJM    M200,O=NIU  JUMP IF NIU READY FOR FRAME
          DELAY  5
          EJM    M200,O=NIU 
          DELAY  15 
          EJM    M200,O=NIU 
          UJP    M120        ERROR IF NOT READY 
* 
* 
 M120     IJM    M121,O=NIU 
          DCN    O=NIU       DISCONNECT IF NIU NOT READY
* 
 M121     CALL   MESSAG,(=27CPIO  NO RESPONSE CIU OUTPUT) 
          AOM    OUTRESP
          UJP    MAIN 
* 
 M124     IJM    M125,I=NIU 
          DCN    I=NIU       DISCONNECT IF NIU NOT READY
* 
 M125     CALL   MESSAG,(=26CPIO  NO RESPONSE CIU INPUT)
          AOM    KYRESP 
          UJP    MAIN 
* 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.53 
* 
*         PROCESS FLOODING STATIONS LISTS AND READ LIST 
*         OF STATIONS IN MAINTENANCE MODE 
* 
* 
* 
 M200     SOM    BADCNT      CHECK IF SHOULD CLEAR BAD
          PJP    M205        STATION LIST 
          LDC    900
          STM    BADCNT      RE-SET COUNTER 
* 
* 
          LDC    SCIMLTH*5
          STD    D.T3        D.T3 = N OF PPU WRDS TO READ 
          LDC    SCIMBUF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      LOAD LOWER PART OF ECS RA
          ADM    SCIMADD+1   ADD LOWER PART OF ECS REL ADDR 
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    SCIMADD     ADD UPPER PART OF ECS REL ADDR 
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          CALL   READECS     READ SCIM COMMUNICATION BUFFER 
* 
          LDN    0
          STM    ITEST       ZERO N ENTRIES IN TEST LIST
          LDN    BADLTH*2    LOAD LENGTH OF TEST/COUNT LISTS
          STD    D.T0 
* 
 M201     SOD    D.T0        DECREMENT INDEX
          MJP    M202        JUMP WHEN END OF LIST REACHED
          LDN    0
          STM    TESTLST,D.T0   ZERO NEXT ENTRY IN TEST LIST
          STM    CNTLST,D.T0    ZERO NEXT ENTRY IN COUNT LST
          UJP    M201 
* 
* 
 M202     LDN    0
          STM    IBAD        CLEAR LENGTH OF LIST 
          LDC    BADLTH 
          STD    D.T0        INITIALIZE INDEX 
* 
 M203     SOD    D.T0        DECREMENT INDEX
          MJP    M205 
          LDN    0           CLEAR NEXT ENTRY IN BAD LIST 
          STM    BADLIST,D.T0 
          UJP    M203 
* 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.49 
* 
*         INCREMENT FRAME COUNTER AND WRITE TO ECS
* 
 M205     LDM    FBIAS
          STM    IBIAS       INITIALIZE BIAS TO THIS FRAME
          LDM    FBIAS+1
          STM    IBIAS+1
          LDM    NFRAME+4    LOAD FRAME COUNTER 
          LPC    FMASK       MASK OFF INDEX IN FRAME BUFFER 
          STM    IFRAME 
          NJP    M210        CHECK IF MUST RE-SET BIAS
          LDN    0
          STM    IBIAS       RE-SET BIAS TO NEXT FRAME
          STM    IBIAS+1
          STM    FBIAS
          LDM    FRAMLTH
          STM    FBIAS+1
          UJP    M215 
* 
 M210     LDM    FRAMLTH     ADVANCE POINTER TO NEXT FRAME
          RAM    FBIAS+1
          SHN    -12
          RAM    FBIAS
* 
 M215     LDN    4
          STD    D.T0        INITIALIZE BYTE INDEX
* 
 M220     AOM    NFRAME,D.T0      INCREMENT NEXT BYTE 
          SHN    -12
          ZJP    M225        CHECK FOR OVERFLOW TO NEXT BYTE
          SOD    D.T0 
          PJP    M220        END TEST 
* 
 M225     LDC    NFRAME 
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      COMPUTE ECS ADDR OF FRAME COUNT
          ADM    OUTPNT+1 
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA 
          ADM    OUTPNT 
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDN    5
          STD    D.T3        D.T3 = NUMBER WORDS TO WRITE 
          CALL   WRITECS     UPDATE FRAME COUNTER IN ECS
* 
* /---   BLOCK      MAIN LOOP  00 000   81/04/21  20.41 
* 
*         READ LENGTH OF CURRENT FRAME FROM ECS LENGTH TABLE
* 
          KEYSIN             ACCEPT ANY KEYS FROM CIU 
          LDC    ECSBUFF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    IFRAME      LOAD INDEX TO CURRENT FRAME
          ADM    ECRA+1      FORM LOWER PART OF ECS ADDRESS 
          ADM    OUTTAB+1 
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA        FORM UPPER PART OF ECS ADDRESS 
          ADM    OUTTAB 
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDN    5
          STD    D.T3        D.T3 = NUMBER OF WORDS TO READ 
          CALL   READECS     READ FROM FRAME LENGTH TABLE 
          NJP    M272        EXIT IF ECS PARITY ERROR 
          LDM    ECSBUFF+4
          STD    NOUT        SET LENGTH OF CURRENT FRAME
          LDC    -1          INITIALIZE LAST BUFFER FLAG
          STM    ILAST
          LDD    NOUT        NUMBER OF WORDS IN FRAME 
          NJP    M300        JUMP IF NOT AN EMPTY FRAME 
* 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.44 
* 
*         SPECIAL TREATMENT FOR EMPTY FRAME 
* 
 M272     BSS    0
          LDN    0
          STD    D.T0 
          STM    ILAST
          STD    IOUT 
          UJP    M325 
* /---   BLOCK      MAIN LOOP  00 000   84/11/15  10.47 
* 
*         READ AND OUTPUT NEXT PORTION OF FRAME 
* 
 M300     KEYSIN             ACCEPT ANY KEYS FROM CIU 
          LDC    PPBLTH 
          STD    D.T3        D.T3 = NUMBER CPU WORDS TO READ
          STD    IOUT 
          LDD    NOUT        GET NUMBER OF WORDS REMAINING
          SBM    PENDTST     PENDTST = PPBLTH 
          STD    NOUT 
          ZJP    M315 
          PJP    M320        JUMP IF NOT LAST BUFFER FULL 
* 
 M315     ADC    PPBLTH 
          STD    D.T3        D.T3 = NUMBER CPU WORDS TO READ
          STD    IOUT 
          STM    ILAST       SET FLAG FOR LAST BUFFER 
* 
* /---   BLOCK      MAIN LOOP  00 000   81/04/21  20.42 
* 
*         READ NEXT PORTION OF CURRENT FRAME FROM ECS 
* 
 M320     LDM    IBIAS+1     COMPUTE ECS ADDRESS
          ADM    ECRA+1      FORM LOWER PART OF ECS ADDRESS 
          ADM    OUTBUFF+1
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA        FORM UPPER PART OF ECS ADDRESS 
          ADM    OUTBUFF
          ADM    IBIAS
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDC    PPBUFF 
          STD    D.T0        D.T0 = ADDRESS OF PPU BUFFER 
          LDD    D.T3 
          RAM    IBIAS+1     INCREMENT BIAS IN FRAME BUFFER 
          SHN    -12
          RAM    IBIAS
          LDD    D.T3 
          SHN    2
          RAD    D.T3        D.T3 = NUM PPU WORDS TO READ 
          CALL   READECS
          KEYSIN             ACCEPT ANY KEYS FROM CIU 
          LDM    ILAST
          SHN    6
          MJP    M330        JUMP IF NOT LAST BUFFER
          SHN    -6 
          STD    D.T0 
          SHN    2           MULTIPLY BY 5 FOR PPU WORD CNT 
          RAD    D.T0 
* 
* * *     PUT EMPTY FRAME AT END TO SIGNAL END OF FRAME 
*         SEND IT TO UNUSED STATION.
* 
 M325     BSS    0
          LDC    2000B+1023  SET BIT AND STATION NUMBER 
          STM    PPBUFF+2,D.T0
          LDN    0
          STM    PPBUFF+1,D.T0
          LDC    4000B       SET START BIT
          STM    PPBUFF,D.T0
          AOD    IOUT        COUNT EXTRA FRAME
* 
* /---   BLOCK      MAIN LOOP  00 000   81/04/21  20.44 
* 
*         OUTPUT NEXT PORTION OF FRAME TO CIU 
* 
 M330     LDC    PPBUFF      INITIALIZE POINTER 
          STD    D.T0 
* 
 M350     SOD    IOUT        NUMBER OF WORDS LEFT IN BUFFER 
          MJP    M370        EXIT IF END OF BUFFER
          LDD    D.T0        POINTER TO NEXT TERMINAL WORD
          STM    M357+1      PLANT ADDRESS OF OUTPUT
          ADN    5
          STD    D.T0        ADVANCE POINTER
* 
          WAIT   EMPTY,O=NIU,M360 
* 
 M355     LDN    3           SET TO OUTPUT NEXT 3 WORDS 
 M357     OAM    **,O=NIU    OUTPUT NEXT TERMINAL WORD
          UJP    M350 
* 
* 
*         RE-SELECT CIU OUTPUT CONTROLLER IF TIME-OUT 
* 
 M360     IJM    M365,O=NIU 
          DCN    O=NIU       DEACTIVATE CIU OUTPUT CHANNEL
* 
 M365     FNC    0,O=NIU     SELECT OUTPUT CONTROLLER 
          WAIT   INACTIVE,O=NIU,M120
          ACN    O=NIU       ACTIVATE CIU OUTPUT CHANNEL
          UJP    M355 
* 
* 
*         CHECK IF AT END OF FRAME
* 
 M370     LDM    ILAST       LOAD LAST BUFFER FLAG
          SHN    6
          MJP    M300        CONTINUE IF NOT LAST BUFFER
          UJP    MAIN 
* /---   BLOCK      SPECIAL    00 000   84/11/15  10.47 
          TITLE  SPECIAL LOOP     INPUT OR OUTPUT OFF 
* 
* 
* 
 SPEC     DELAY  1000        IDLE FOR A WHILE 
          LDM    CIUEQ       CHECK IF CIU AVAILABLE 
          ZJP    I700          EXIT IF NOT
* 
*         ACCEPT PENDING KEYS FROM CIU AND PASS TO PLATO
* 
          AJM    I150,I=NIU  CHECK IF CHANNEL ACTIVE
          FNC    40B,I=NIU   SELECT INPUT CONTROLLER
          WAIT   INACTIVE,I=NIU,M124
          ACN    I=NIU       ACTIVATE NIU INPUT CHANNEL 
          WAIT   ACTIVE,I=NIU,M124
* 
 I150     LDN    20          PROCESS MAX OF 20 KEYS 
          STM    KOCNT
* 
 I160     KEYSIN             ACCEPT PENDING KEYS FROM CIU 
          LDD    KEYII       LOAD KEY BUFFER INPUT POINTER
          ZJP    I700 
          CALL   KEYOUT      OUTPUT NEXT KEY TO PLATO 
          SOM    KOCNT
          PJP    I160 
          UJP    I700 
* 
* /---   BLOCK      SPECIAL    00 000   84/11/15  10.47 
* 
*         INCREMENT FRAME COUNTER APROX EVERY 16 MILLS
* 
 I700     SOM    SFCNT       CHECK IF TIME TO UPDATE FRAME
          PJP    MAIN 
          LDN    15          RE-SET COUNTER 
          STM    SFCNT
          LDN    4
          STD    D.T0        INITIALIZE BYTE INDEX
* 
 I720     AOM    NFRAME,D.T0      INCREMENT NEXT BYTE 
          SHN    -12
          ZJP    I725        CHECK FOR OVERFLOW TO NEXT BYTE
          SOD    D.T0 
          PJP    I720        END TEST 
* 
 I725     LDC    NFRAME 
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      COMPUTE ECS ADDR OF FRAME COUNT
          ADM    OUTPNT+1 
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA 
          ADM    OUTPNT 
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDN    5
          STD    D.T3        D.T3 = NUMBER WORDS TO WRITE 
          CALL   WRITECS     UPDATE FRAME COUNTER IN ECS
          UJP    MAIN 
* 
* 
 IFP$     EQU    1           FOR COMPGFP
 EJT$     EQU    1           ASSEMBLE ROUTINE .CEA
*CALL     COMPGFP 
 IFP      HERE
* /---   BLOCK      KEYIN      00 000   81/09/08  01.28 
          TITLE  -KEYIN-     READ NEXT KEY TO KEY BUFFER
* 
* 
* 
*         -KEYIN- 
*         READS NEXT KEY (2 PPU WORDS) FROM CIU TO BUFFER 
*         CALLED BY -KEYSIN- MACRO
* 
* 
 KEYIN    SUBR
          AJM    KY100,I=NIU      CHECK IF CHANNEL ACTIVE 
          FNC    40B,I=NIU   SELECT INPUT CONTROLLER
          WAIT   INACTIVE,I=NIU,KY860 
          ACN    I=NIU       ACTIVATE CIU INPUT CHANNEL 
* 
 KY100    EJM    KEYINX,I=NIU    IF NO KEY READY YET
          IAN    I=NIU       INPUT STATION DATA WORD@ 
          STD    D.T0 
          SHN    6           POSITION STATION WORD BIT
          PJP    KY850       EXIT IF CIU OUT OF STEP
          WAIT   FULL,I=NIU,KY860    WAIT FOR KEY DATA WORD 
          IAN    I=NIU       INPUT KEY DATA WORD
          STD    D.T1 
          LDD    KEYII       LOAD INDEX IN KEY BUFFER 
          STD    D.T3 
          ADN    2           ADVANCE INDEX
          STD    KEYII
          SBM    MXKBIDX     CHECK AGAINST MAXIMUM
          MJN    KY110
          LDD    KEYII
          STM    MXKBIDX
 KY110    LDD    KEYII
          SBM    KENDTST     CHECK FOR BUFFER OVERFLOW
          PJP    KY870
          LDD    D.T0        LOAD FIRST WORD OF KEY 
          LPC    3777B       REMOVE TOP BIT 
          STM    KEYBUFF,D.T3 
          LDD    D.T1        LOAD SECOND WORD OF KEY
          STM    KEYBUFF+1,D.T3 
          LJM    KEYINX 
* /---   BLOCK      KEYIN      00 000   81/08/06  22.29 
* 
 KY850    CALL   MESSAG,(=24CPIO  KEY DATA OUT OF SEQ)
          AOM    KYSEQ
          UJP    KY890
* 
 KY860    CALL   MESSAG,(=26CPIO  NO RESPONSE CIU INPUT)
          AOM    KYRESP 
          UJP    KY890
* 
 KY870    AOM    KYOFLOW     INCREMENT OVERFLOW COUNT 
          STD    D.T0 
          CALL   OTOA        CONVERT OCTAL TO ALPHA 
          LDD    D.T1 
          STM    KYM100      PLANT ALPHA COUNTER
          LDD    D.T2 
          STM    KYM100+1 
          CALL   DFM,KYMSG1       OUTPUT DAYFILE MESSAGE
          LDN    0
          STD    KEYII       DUMP ALL KEYS IN BUFFER
          STD    KEYOI
          UJN    KYI9 
* 
 KY890    DCN    I=NIU       DISCONNECT CIU CHANNEL 
          DELAY  10 
          ACN    I=NIU       RE-ACTIVATE CIU CHANNEL
 KYI9     LJM    KEYINX 
* 
* 
 KYMSG1   DIS    ,*PIO  KEY BUFFER OVERFLOW  XXXX*
 KYM100   EQU    KYMSG1+13
* 
* 
* /---   BLOCK      KEYOUT     00 000   77/08/23  03.47 
          TITLE  -KEYOUT-    OUTPUT NEXT KEY
* 
* 
* 
*         -KEYOUT-
*         OUTPUTS NEXT KEY FROM PPU KEY BUFFER TO STATION 
*         KEY BUFFER IN ECS AND SETS BIT FOR THIS STATION 
*         IN CM AND ECS POLLING LISTS 
* 
* 
 KEYOUT   SUBR
* 
*         GET NEXT KEY TO *KEY* AND *STATION* 
* 
          LDD    KEYII       LOAD BUFFER INPUT POINTER
          SBD    KEYOI       CHECK AGAINST OUTPUT POINTER 
          ZJP    KYO900      EXIT IF NO KEYS TO DO
          MJP    KYO900 
          LDD    KEYOI       LOAD OUTPUT POINTER
          STD    D.T0 
          ADN    2           ADVANCE OUTPUT POINTER 
          STD    KEYOI
          LDM    KEYBUFF,D.T0     LOAD STATION WORD 
          STD    STATION
          SBD    FS          FIRST LEGAL PHYSICAL STATION 
          MJP    KYO820      NOT LEGAL
          LDD    STATION
          ADC    -0          MAX LEGAL PHYSICAL STATION 
 .NTERM1  EQU    *-1
          PJP    KYO820      IF TOO BIG 
          LDD    CB          BIAS TO LOGICAL STATION NUMBER 
          RAD    STATION
* 
*         CHECK IF THIS STATION FLOODING SYSTEM WITH KEYS 
* 
          STD    D.T1        SET STATION NUMBER 
          LDM    IBAD        GET NUMBER OF FLOODING STATIONS
          ZJN    KYO150 
          STD    D.T2 
* 
 KYO110   SOD    D.T2        DECREMENT INDEX IN BAD LIST
          MJN    KYO150 
          LDM    BADLIST,D.T2 
          SBD    D.T1        CHECK IF THIS STATION FLOODING 
          NJP    KYO110 
          LJM    KEYOUTX
* 
 KYO150   BSS    0
 
          LDM    KEYBUFF+1,D.T0   LOAD KEY WORD 
          STD    KEY
* 
* /---   BLOCK      KEYOUT     00 000   75/08/11  20.05 
* 
*         READ KEY BUFFER FOR THIS STATION
* 
          LDC    ECSBUFF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDD    STATION     COMPUTE KEY BUFFER INDEX 
          SHN    KEYBSHF
          ADM    ECRA+1      ADD LOWER PART OF ECS RA 
          ADM    KEYBADD+1   ADD LOWER PART OF KEY BUFF ADDR
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    KEYBADD     ADD UPPER PART OF KEY BUFF ADDR
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    10 
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
          CALL   READECS     D.T0 - D.T3 ALREADY SET UP 
          NJP    KEYOUTX     IF ECS PARITY ERROR
* 
* /---   BLOCK      KEYOUT     00 000   84/11/15  10.50 
* 
*         CHECK FOR FAST COLLECT BIT (TOP BIT OF STOP1 BYTE)
* 
          LDM    ECSBUFF+8   GET STOP1 CODE 
          LPC    4000B       ISOLATE FASTKEY ON-BIT 
          ZJP    KYO210      JUMP IF NOT FAST COLLECT 
* 
*         COUNT THE FAST COLLECT EXECUTIONS 
* 
          AOM    FKSTAT 
* 
*         READ FAST COLLECT CONTROL BUFFER
* 
          LDC    FKYBUFF     D.T0 = PPU MEMORY ADDRESS
          STD    D.T0 
          LDM    ECRA+1      LOWER PART OF ECS RA 
          ADM    FKBFADD+1   ADD LOWER PART OF ADDRESS
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    FKBFADD     ADD UPPER PART OF ADDRESS
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    10          LENGTH = 2 CM WORDS
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
          CALL   READECS
          NJP    KEYOUTX     IF ECS PARITY ERROR
* 
*         CHECK THAT THIS IS THE PROPER STATION 
* 
          LDM    FKYBUFF+5   GET STATION EXPECTED 
          SBD    STATION     ACTUAL STATION 
          NJP    KYO200      JUMP IF NOT CORRECT STATION
* 
*         CHECK IF ALREADY DONE COLLECTING
* 
          LDM    FKYBUFF+4   GET TOP BIT IN 5TH BYTE
          LPC    4000B       ISOLATE IT 
          NJP    KYO200      JUMP IF DONE (BIT SET) 
* 
*         READ PROPER WORD OF ECS STORAGE BUFFER
* 
 KYO155   LDC    STRBUFF     D.T0 = PPU MEMORY ADDRESS
          STD    D.T0 
          LDM    ECRA+1      LOWER PART OF ECS RA 
          ADM    FKYBUFF+1   ADD LOWER PART OF ADDRESS
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    FKYBUFF     ADD UPPER PART OF ADDRESS
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    5           LENGTH = 1 CM WORD 
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
          CALL   READECS
 KYO1     NJP    KEYOUTX     IF ECS PARITY ERROR
* 
* /---   BLOCK      KEYOUT     00 000   81/09/07  00.36 
* 
*         STORE THE KEY IN THE BUFFER 
* 
          LDM    FKYBUFF+4   BYTE ORDINAL 
          STD    D.T4        USE AS INDEX 
          LDD    KEY         GET THE KEY
          STM    STRBUFF,D.T4 
          CALL   WRITECS     WRITE BACK THE WORD OF STORAGE 
          NJN    KYO1        IF ECS PARITY ERROR
* 
*         INCREMENT THE BYTE INDEX AND ECS STORAGE ADDRESS
* 
          AOM    FKYBUFF+4   BYTE INDEX 
          SBN    5           CHECK FOR WRAP AROUND
          NJN    KYO160      SKIP ECS STORAGE ADDRESS 
          STM    FKYBUFF+4   ZERO BYTE INDEX
          AOM    FKYBUFF+1   LOWER ECS STORAGE ADDRESS
          SHN    -12
          ADM    FKYBUFF     UPPER HALF 
          STM    FKYBUFF
* 
*         COUNT NUMBER OF KEYS COLLECTED
* 
 KYO160   AOM    FKYBUFF+3   LOWER KEY COUNT
          SHN    -12
          ADM    FKYBUFF+2   UPPER HALF 
          STM    FKYBUFF+2
* 
* /---   BLOCK      KEYOUT     00 000   81/09/08  00.02 
* 
*         IF LAST KEY, SET DONE BIT 
* 
          LDM    ECSBUFF+8   FIRST CHECK FOR STOP1
          LPC    3777B       GET RID OF FASTKEY CONTROL BIT 
          SBD    KEY         CHECK AGAINST KEY
          ZJN    KYO180      IF STOP1 
* 
          LDM    FKYBUFF+6   CHECK SPECIAL KEY
          SBD    KEY
          ZJN    KYO180      IF SPECIAL KEY 
* 
          LDM    FKYBUFF+7   UPPER KEYS TO COLLECT
          SBM    FKYBUFF+2   UPPER KEYS COLLECTED 
          NJN    KYO190      IF NOT LAST KEY
          LDM    FKYBUFF+8   LOWER KEYS TO COLLECT
          SBM    FKYBUFF+3   LOWER KEYS COLLECTED 
          NJN    KYO190      IF NOT LAST KEY
* 
*         SET DONE BIT IN CONTROL BUFFER
* 
 KYO180   LDM    FKYBUFF+4   5TH BYTE 
          ADC    4000B       TURN ON BIT
          STM    FKYBUFF+4
* 
*         WRITE FAST COLLECT CONTROL BUFFER BACK TO ECS 
* 
 KYO190   LDC    FKYBUFF     D.T0 = PPU MEMORY ADDRESS
          STD    D.T0 
          LDM    ECRA+1      LOWER PART OF ECS RA 
          ADM    FKBFADD+1   ADD LOWER PART OF ADDRESS
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    FKBFADD     ADD UPPERPART OF ADDRESS 
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    5           LENGTH = 1 CM WORD 
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
          CALL   WRITECS     WRITE IT 
          NJP    KEYOUTX     IF ECS PARITY ERROR
* 
*         IF LAST KEY, PROCESS IT IN REGULAR WAY
* 
          LDM    FKYBUFF+4   5TH BYTE 
          LPC    4000B       MASK OFF DONE BIT
          ZJP    KEYOUTX
* 
* /---   BLOCK      KEYOUT     00 000   84/11/15  10.50 
* 
*         RECOMPUTE ADDRESSES FOR KEYBUFFER READECS 
* 
 KYO200   LDC    ECSBUFF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDD    STATION     COMPUTE KEY BUFFER INDEX 
          SHN    KEYBSHF
          ADM    ECRA+1      ADD LOWER PART OF ECS RA 
          ADM    KEYBADD+1   ADD LOWER PART OF KEY BUFF ADDR
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    KEYBADD     ADD UPPER PART OF KEY BUFF ADDR
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    10 
          STD    D.T3        D.T3 = NUMBER PPU WORDS TO READ
* 
*         CHECK IF ROOM FOR NEW KEY IN STATIONS KEY BUFFER
* 
 KYO210   LDM    ECSBUFF+4   PPU INDEX IN KEY BUFFER
          SBM    ECSBUFF+9   CPU INDEX IN KEY BUFFER
          ZJN    KYO225      IF CPU INDEX = PPU INDEX 
          PJN    KYO220 
          ADC    10000B      TAKE 12 BIT ABSOLUTE VALUE 
* 
 KYO220   LPN    3           MASK INDEX FOR MOD 4 
          NJN    KYO225      IF NO OVERFLOW 
          LDM    ECSBUFF+8   LOAD -STOP1- KEY VALUE 
          LPC    3777B       MASK OFF FASTKEY CONTROL BIT 
          SBD    KEY
          NJP    KYO800      IGNORE KEY IF NOT -STOP1-
          LDM    ECSBUFF+4
          UJN    KYO227      OVERWRITE LAST KEY 
* 
*         ADD NEW KEY TO STATION KEY BUFFER 
* 
 KYO225   AOM    ECSBUFF+4   INCREMENT PPU KEY BUFFER INDEX 
 KYO227   LPN    3           MASK OFF INDEX  (MOD 4)
          STD    D.T4 
          LDD    KEY         PLANT KEY CODE IN KEY BUFFER 
          STM    ECSBUFF,D.T4 
          LDN    5           D.T3 = NUMBER WORDS TO WRITE 
          STD    D.T3 
          CALL   WRITECS     D.T0 - D.T3 ARGUMENTS
* 
*         COMPUTE INDEX FOR THIS STATION IN ECS BIT TABLE 
* 
          LDD    STATION     GET STATION NUMBER 
          LPN    37B         MOD 32 
          ADN    4           ADD BIAS TO STARTING BIT 
          STD    D.T1 
          LDN    3           INITIALIZE INDEX AT LOW BYTE 
          STD    D.T4 
* 
* /---   BLOCK      KEYOUT     00 000   81/04/28  17.08 
* 
 KYO300   LDD    D.T1        LOAD BIT INDEX 
          SBN    12          CHECK IF BIT IS IN THIS BYTE 
          MJN    KYO310 
          STD    D.T1        ADJUST BIT INDEX 
          SOD    D.T4        ADJUST BYTE INDEX
          UJP    KYO300 
* 
 KYO310   LDM    KYO320      LOAD SHIFT INSTRUCTION 
          SCN    77B
          ADD    D.T1        ATTACH SHIFT COUNT 
          STM    KYO320 
          LDN    1           SET UP BIT 
* 
 KYO320   SHN    0           POSITION BIT WITHIN BYTE 
          STM    KYO362+1    STORE BIT MASK 
* 
* /---   BLOCK      KEYOUT     00 000   85/06/13  13.17 
* 
*         SET BIT IN ECS POLLING LIST FOR THIS STATION
* 
 KYO360   LDC    ECSBUFF     SET FOR ECS READ 
          STD    D.T0          D.T0 = PPU MEMORY ADDRESS
          LDD    STATION       ECS ADDRESS = STATION
          SHN    -5            /32
          ADM    ECRA+1        + ECS RA 
          ADM    ECSSWX+1      + RELATIVE ADDRESS 
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12           ADJUST CARRY 
          ADM    ECRA          COMPUTE UPPER PART OF ADDRESS
          ADM    ECSSWX 
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          LDN    5
          STD    D.T3        D.T3 = NUM PPU WORDS TO READ 
          CALL   READECS     READ WORD FROM REQUEST LIST
          NJP    KEYOUTX     IF ECS PARITY ERROR
***       CDC-ONLY TRAP FOR BAD INPUT LIST WORDS
 CDCIF    IFNE   CDC,0
          LDC    2037B       RIGHT VALUE
          LMM    ECSBUFF     CHECK EXPONENT 
          ZJN    TRAP1       IF OK
 .NOS2    IFLT   OSLEV,578D 
          MONITOR MXFM       SAY CHEESE 
 .NOS2    ELSE
 .NOS241  IFLT   OSLEV,630D 
          MONITOR HNGM       SAY CHEESE 
 .NOS241  ELSE
          LDC    *
          STD    CM+1        SAVE CALL ADDRESS
          LDK    PPET 
          STD    CM+2        *PP ABORT* ERROR FLAG
          MONITOR CHGM       SAY CHEESE, CONDITIONALLY
 .NOS241  ENDIF 
 .NOS2    ENDIF 
 TRAP1    BSS    0
 CDCIF    ENDIF 
***       END TRAP. 
* 
          LDM    ECSBUFF,D.T4  GET PROPER WORD
 KYO362   LPC    0           MASK OFF PROPER BIT
          NJP    KYO2        IF BIT ALREADY ON
          LDM    ECSBUFF,D.T4 
          LMM    KYO362+1    SET BIT FOR THIS STATION 
          STM    ECSBUFF,D.T4 
          LDN    1           SET LOWEST BIT FOR RE-READ 
          STM    ECSBUFF+4
***       CDC-ONLY TRAP FOR BAD INPUT LIST WORDS
 CDCIF    IFNE   CDC,0
          LDC    2037B       RIGHT VALUE
          LMM    ECSBUFF     CHECK EXPONENT 
          ZJN    TRAP2       IF OK
 .NOS2    IFLT   OSLEV,578D 
          MONITOR MXFM       SAY CHEESE 
 .NOS2    ELSE
 .NOS241  IFLT   OSLEV,630D 
          MONITOR HNGM       SAY CHEESE 
 .NOS241  ELSE
          LDC    *
          STD    CM+1        SAVE CALL ADDRESS
          LDK    PPET 
          STD    CM+2        *PP ABORT* ERROR FLAG
          MONITOR CHGM       SAY CHEESE, CONDITIONALLY
 .NOS241  ENDIF 
 .NOS2    ENDIF 
 TRAP2    BSS    0
 CDCIF    ENDIF 
***       END TRAP. 
          CALL   WRITECS     WRITE WORD BACK TO ECS 
          NJN    KYO2 
          CALL   READECS     READ REQUEST LIST WORD AGAIN 
          LDM    ECSBUFF+4
          SBN    1           CHECK FOR POSSIBLE CPU CONFLICT
          NJP    KYO360 
 KYO2     LJM    KEYOUTX
* 
* /---   BLOCK      KEYOUT     00 000   84/11/15  10.51 
* 
*         ADD THIS STATION TO LIST OF STATIONS FLOODING 
*         SYSTEM WITH KEYS AND OUTPUT B-DISPLAY MESSAGE 
* 
* 
* 
*                  CHECK THE LIST PASSED FROM SCIM TO SEE 
*                  IF THIS STATION IS ONE THAT SHOULD 
*                  NOT BE TURNED OFF
* 
 KYO800   LDM    SCIMBUF+XBADLTH    LOAD LENGTH OF LIST 
          ZJN    KYO803      IF LIST FROM SCIM EMPTY
          STD    D.T0 
          SBN    XBADLTH+1   CHECK FOR BAD LENGTH VALUE 
          PJN    KYO803      IF BAD LENGTH
* 
 KYO802   SOD    D.T0        DECREMENT COUNTER
          MJN    KYO803      IF STATION NOT ON LIST 
          LDD    STATION     LOAD CURRENT STATION NUMBER
          SBM    SCIMBUF,D.T0   SUBTRACT VAL FOUND IN TABLE 
          NJP    KYO802      IF NO MATCH CHECK NEXT ENTRY 
          AOM    KYIGNT      COUNT KEYS IGNORED IN TEST MODE
          UJP    KYO805      AVOID TURNING STATION OFF
* 
* 
*         INSERT STATION INTO TEST LIST OR INCREMENT
*         COUNT FOR A STATION ALREADY LISTED
* 
* 
 KYO803   LDM    ITEST       LOAD NUMBER OF STATIONS IN LIST
          STD    D.T0 
 KYO8031  SOD    D.T0        DECREMENT COUNTER
          MJN    KYO8032     NOT FOUND, TRY TO ADD TO LIST
          LDD    STATION
          SBM    TESTLST,D.T0  CHECK NEXT ENTRY IN THE LIST 
          NJP    KYO8031     IF NO MATCH TRY NEXT ENTRY 
          UJN    KYO8033     FOUND, GO PROCESS COUNT
* 
 KYO8032  LDM    ITEST       LOAD COUNT OF ENTRIES IN LIST
          STD    D.T0 
          SBN    BADLTH*2    CHECK IF ROOM IN TEST LIST 
          PJP    KYO805      GIVE UP IF NO ROOM 
* 
          LDD    STATION
          STM    TESTLST,D.T0   ADD STATION TO LIST 
*          STM    KYIGNT+1    DEBUG ONLY...LAST STATION ADDED 
          LDN    1
          STM    CNTLST,D.T0   SET COUNT TO 1 FOR STATION 
          AOM    ITEST       INCREMENT COUNT OF ENTRIES 
*          STM    KYIGNT+2    DEBUG ONLY...ENTRIES IN LIST
          UJN    KYO805 
* 
 KYO8033  AOM    CNTLST,D.T0 INCREMENT COUNT FOR STATION
          SBN    OFLIMIT     CHECK IF NEEDS TO BE BLOCKED 
          MJN    KYO805      DONT BLOCK STATION INPUT 
* 
* 
* /---   BLOCK      KEYOUT     00 000   79/01/04  21.48 
* 
* 
* 
*                ADD STATION TO BAD LIST IF LIST NOT FULL 
* 
 KYO804   LDM    IBAD        LENGTH OF BAD STATION LIST 
          STD    D.T0 
          SBN    BADLTH 
          PJN    KYO805      IF LIST FULL 
          AOM    IBAD        INCREMENT LENGTH OF LIST 
          LDD    STATION
          STM    BADLIST,D.T0 
* 
* 
* 
* 
*                INCREMENT COUNT AND OUTPUT MESSAGE 
* 
* 
 KYO805   AOM    KYIGN       INCREMENT IGNORED COUNTER
          SOM    KOMCNT      CHECK IF SHOULD OUTPUT MESSAGE 
          PJN    KYO3 
          LDC    300         RE-SET COUNTER 
          STM    KOMCNT 
          LDD    STATION
          STD    D.T0        CONVERT STATION NUMBER TO ALPHA
          CALL   OTOA 
          LDD    D.T1        LOAD FIRST TWO ALPHA CHARACTERS
          STM    KOMSG1+13
          LDD    D.T2        LOAD SECOND TWO CHARACTERS 
          STM    KOMSG1+14
          CALL   MESSAG,KOMSG1    OUTPUT B-DISPLAY MESSAGE
 KYO3     LJM    KEYOUTX
* 
* 
*         OUTPUT B-DISPLAY MESSAGE FOR ILLEGAL STATION
* 
 KYO820   CALL   MESSAG,KOMSG2
          AOM    KYSTATN
          UJN    KYO3 
* 
*         RE-SET BUFFER POINTERS IF EMPTY 
* 
 KYO900   LDN    0           RE-SET BUFFER POINTERS 
          STD    KEYII
          STD    KEYOI
          UJN    KYO3 
* 
* 
 KOMCNT   DATA   0
* 
 KOMSG1   DIS    ,*PIO  KEY IGNORED STATION  XXXXB* 
 KOMSG2   DIS    ,*PIO  STATION TOO BIG*
* 
* 
* /---   BLOCK      PAUSE      00 000   89/06/01  11.28 
          TITLE  -PAUSE-     CHECK FOR STORAGE MOVE OR ERROR
 PAUSE    SPACE  5,11 
**        PAUSE - PAUSE FOR STORAGE RELOCATION
* 
*         CHECK CPU ACTIVITY AND PAUSE / DROP AS NECESSARY
* 
*         IF NO CPU ACTIVITY BUT *DIS* ACTIVE,
*                CONTINUE PROCESSING
*         IF NO CPU ACTIVITY BUT *ESM* ACTIVE,
*                WAIT FOR *ESM* TO DROP.
 
 
 PAUSE    SUBR
          LDD    CP 
          ADN    STSW 
          CRD    CM 
          LDD    CM+1        CHECK ERROR FLAG 
          ZJN    PSE1        IF NO ERROR
          LJM    PSE8 
 
 PSE1     LDD    CM          CHECK CPU ACTIVITY 
          SHN    -11B 
          NJN    PSE3        IF ACTIVITY
 
*         CHECK FOR DIS / ESM ACTIVE
 
          LDN    PPUL 
          CRD    CM 
          LDD    CM+2        SAVE NUMBER OF PPS ON SYSTEM 
          SBN    11D
          PJN    PSE1.1      IF MORE THAN 10 PPS
          LDN    10D         SET 10 PPS 
          UJN    PSE1.2 
 
 PSE1.1   LDN    20D
 PSE1.2   STD    T1 
          LDN    PPCP        GET ADDRESS OF PP COMMUNICATION
          CRD    CM 
          LDD    CM+4 
          STD    T2 
 PSE2     CRD    CM          READ NEXT INPUT REGISTER 
          LDD    CM 
          LMC    2RDI 
          NJN    PSE5        IF NOT *DIS* 
          LDD    CP 
          SHN    -7 
          LMC    1RS*100B 
          LMD    CM+1 
          SCN    40B
          NJN    PSE5        IF NOT *DIS* AT THIS CP
 
*         CHECK FOR STORAGE MOVE
 
 PSE3     LDN    CMCL 
          CRD    CM 
          LDD    CP 
 .NOS27   IFGE   OSLEV,716D  NOS 2.7.1
          SHN    -7 
 .NOS27   ENDIF 
          LMD    CM 
          NJN    PSE4        IF NOT THIS CP 
          RJM    PSM         PAUSE FOR STORAGE MOVE 
 PSE4     LJM    PAUSEX 
 
 PSE5     LDD    CM+1 
          SCN    77B
          SHN    14B
          LMD    CM 
          LMC    3RMES       CHECK FOR *ESM*
          NJN    PSE6        IF NOT *ESM* 
          RJM    PSM         PAUSE FOR STORAGE MOVE 
          LJM    PAUSE+1     RE-ENTER LOOP
 
 PSE6     SOD    T1 
* /---   BLOCK      PAUSE      00 000   81/04/28  14.26 
          NJN    PSE7        IF MORE PPS TO CHECK 
          LJM    PSE9        NO ACTIVITY AT THE CP
 
 PSE7     LDN    10B         BUMP TO NEXT INPUT REGISTER
          RAD    T2 
          LJM    PSE2        LOOP 
 
*         PROCESS ERROR FLAG
 
 PSE8     LDD    CM+1 
          SBN    FSET        CHECK FOR *MRQ* DROP 
          ZJN    PSE10
          SBN    OKET-FSET
          ZJN    PSE10
 PSE9     CALL   ALLOUT,OFFMSG  OUTPUT -PLATO OFF-
 PSE10    LJM    DROP 
 PSM      SPACE  5,11 
**        PSM - PAUSE FOR STORAGE MOVE
* 
*         ISSUE MONITOR FUNCTION TO PAUSE 
*         UPDATE PP ADDRESSES TO REFLECT NEW RA 
 
 PSM      SUBR
          PAUSE  ST 
          LDM    PSTATX      UPDATE CM ADDRESSES
          SHN    6
          ADD    RA 
          SHN    6
          ADM    PSTATX+1 
          PLANT  CM,PSTATS
          LJM    PSMX 
* /---   BLOCK      READECS    00 000   84/11/16  10.53 
          TITLE  -READECS-   ECS TO PPU TRANSFER VIA DDP
* 
* 
* 
*         -READECS- 
*         ON ENTRY  -  D.T0 = PPU MEMORY ADDRESS
*                      D.T1 = UPPER PORTION OF ECS ADDRESS
*                      D.T2 = LOWER PORTION OF ECS ADDRESS
*                      D.T3 = NUMBER OF PPU WORDS TO READ 
* 
*         ON RETURN - A = 0 = READ COMPLETED
*                         1 = ECS PARITY ERROR
* 
* 
 READECS  SUBR
          LDD    A170 
          NJP    RCS50       IF 180 CLASS MAINFRAME 
          IJM    RCS10,C=DDP
          DCN    C=DDP,40B
* 
 RCS10    FNC    5001B,C=DDP      5001B = READ ECS
          WAIT   INACTIVE,C=DDP,RCSE1 
          ACN    C=DDP,40B
          FJM    RCSE2,C=DDP
          LDN    2
          OAM    D.T1,C=DDP  OUTPUT 2 WORD ECS ADDRESS
          LDD    D.T0 
          STM    RCS15+1     PLANT PPU MEMORY ADDRESS 
          WAIT   FULL,C=DDP,RCSE3 
* 
          LDM    D.T3        NUMBER OF WORDS TO READ
 RCS15    IAM    **,C=DDP    READ ECS TO PPU MEMORY 
          NJP    RCSE4       EXIT IF ERROR
* 
 RCS20    IJM    RCSE5,C=DDP      WAIT CHANNEL ACTIVE + FULL
          EJM    RCS20,C=DDP
 RCS30    DCN    C=DDP,40B   DISCONNECT CHANNEL 
          LDN    0           MARK NO ERROR OCCURRED 
          LJM    READECSX 
* 
 RCSE1    LDN    0           SET ERROR CODE 
          UJN    RCSERR 
 RCSE2    LDN    1
          UJN    RCSERR 
 RCSE3    LDN    2
          UJN    RCSERR 
 RCSE4    LDN    3
          UJN    RCSERR 
 RCSE5    LDN    4
 
 RCSERR   ADC    2RR1        SET CHARACTER STRING FOR ERROR 
          STM    DDPMSG+14
          LDM    RCS30       GET CHANNEL FOR ERROR MESSAGE
          LPN    37B
          STD    D.T0 
          CALL   OTOA 
          LDD    D.T2 
          STM    DDPMSG+11
          CALL   DFM,DDPMSG  ISSUE ERROR MESSAGE TO DAYFILES
* 
          CALL   DDPMCP      MASTER CLEAR DDP PORT
          LDN    1           A = 1 = ERROR OCCURRED 
          LJM    READECSX 
* 
* 
* /---   BLOCK      READUEM    00 000   85/04/18  16.43 
* 
*         READ UEM DIRECTLY ON 800-SERIES MACHINES
* 
 RCS50    SRD    D.RSAV      SAVE CURRENT (R) 
 
*         CONVERT COUNT FROM PPU WORDS TO CPU WORDS 
 
          LDD    T0 
          STM    T0SAV
          LDD    T2 
          STM    T2SAV
          LDD    D.T3        (A) = NUMBER OF PPU WORDS
          STM    D.T3S
          RJM    DV5         CONVERT TO CPU WORDS 
          STD    D.T3        (D.T3) = NUMBER OF CPU WORDS 
 
*         PLANT PP ADDRESS THE CM WORDS ARE TO BE READ INTO 
 
          LDD    D.T0        (A) = PP MEMORY ADDRESS TO USE 
          STM    RCS60       STORE PP ADDRESS 
 
*         FORM PART OF EM ADDRESS IN (R)
 
          LDD    D.T1        (A) = UPPER PART OF EM ADDRESS 
          SHN    -6          (A) = BITS 23 - 18 OF EM ADDR
          STD    T1 
          LDD    D.T1 
          SHN    6           (A) = BITS 17 - 12 OF EM ADDR
          STD    T2 
          LRD    T1          (R) = BITS 23 - 12 OF EM ADDR
 
*         FORM THE REST OF THE EM ADDRESS IN (A)
 
          LDD    D.T2        (A) = LOWER PART OF EM ADDRESS 
          LMC    R.USE       SET BIT TO USE (R) IN ADDR CALC
 
*         READ EM 
 
          CRM    **,D.T3
 RCS60    EQU    *-1         (PP MEMORY ADDRESS)
 
*         DONE. 
 
          LRD    D.RSAV      RESTORE OLD (R)
          LDM    T0SAV
          STD    T0 
          LDM    T2SAV
          STD    T2 
          LDM    D.T3S
          STD    D.T3 
          LDN    0           MARK NO ERROR OCCURRED 
 
*          RETURN 
 
          LJM    READECSX 
 
 
 
*CALL     COMPDV5 
 
* /---   BLOCK      WRITECS    00 000   84/11/16  11.01 
          TITLE  -WRITECS-   PPU TO ECS TRANSFER VIA DDP
* 
* 
* 
*         -WRITECS- 
*         ON ENTRY  -  D.T0 = PPU MEMORY ADDRESS
*                      D.T1 = UPPER PORTION OF ECS ADDRESS
*                      D.T2 = LOWER PORTION OF ECS ADDRESS
*                      D.T3 = NUMBER OF PPU WORDS TO WRITE
* 
*         ON RETURN - A = 0 = WRITE COMPLETED 
*                         1 = ECS ABORT 
* 
* 
 WRITECS  SUBR
          LDD    A170 
          NJP    WCS60       IF 180 CLASS MAINFRAME 
          IJM    WCS10,C=DDP
          DCN    C=DDP,40B
* 
 WCS10    FNC    5002B,C=DDP      5002B = WRITE ECS 
          WAIT   INACTIVE,C=DDP,WCSE1 
          ACN    C=DDP,40B
          LDN    2
          OAM    D.T1,C=DDP  OUTPUT 2 WORD ECS ADDRESS
          LDD    D.T0 
          STM    WCS15+1     PLANT PPU MEMORY ADDRESS 
* 
          LDM    D.T3        NUMBER OF WORDS TO WRITE 
 WCS15    OAM    **,C=DDP    WRITE PPU MEMORY TO ECS
          NJP    WCSE2       EXIT IF ERROR
          DCN    C=DDP,40B
* 
 WCS30    FNC    5004B,C=DDP      5004B = SELECT STATUS 
          WAIT   INACTIVE,C=DDP,WCSE3 
          ACN    C=DDP,40B   RE-ACTIVATE DDP CHANNEL
          WAIT   FULL,C=DDP,WCSE4 
          IAN    C=DDP,40B   INPUT STATUS WORD
          DCN    C=DDP,40B
          LPN    11B         MASK WRITE/ABORT BITS
          NJN    WCS50       IF ERROR OR INCOMPLETE 
          IJM    WCS41,C=DDP
 WCS40    DCN    C=DDP,40B
 WCS41    LJM    WRITECSX 
* 
 WCS50    LPN    10B
          ZJN    WCSE5       IF ECS ABORT 
          LJM    WCS30       WRITE NOT COMPLETE 
 
 WCSE1    LDN    0           SET ERROR CODE 
          UJN    WCSERR 
 WCSE2    LDN    1
          UJN    WCSERR 
 WCSE3    LDN    2
          UJN    WCSERR 
 WCSE4    LDN    3
          UJN    WCSERR 
 WCSE5    LDN    4
 
 WCSERR   ADC    2RW1        SET CHARACTER STRING FOR ERROR 
          STM    DDPMSG+14
          LDM    WCS40       GET CHANNEL FOR ERROR MESSAGE
          LPN    37B
          STD    D.T0 
          CALL   OTOA 
          LDD    D.T2 
          STM    DDPMSG+11
          CALL   DFM,DDPMSG  ISSUE ERROR MESSAGE TO DAYFILES
* 
          CALL   DDPMCP      MASTER CLEAR DDP PORT
          LDN    1           MARK ERROR OCCURRED
          LJM    WRITECSX 
* 
 DDPMSG   DIS    ,*PIO  DDP CHAN ERR   C=XX  E=XX*
* 
* /---   BLOCK      WRITUEM    00 000   85/04/18  16.43 
* 
*         WRITE UEM DIRECTLY ON 800-SERIES MACHINES 
* 
 WCS60    SRD    D.RSAV      SAVE CURRENT (R) 
 
*         CONVERT COUNT FROM PPU WORDS TO CPU WORDS 
 
          LDD    T0 
          STM    T0SAV
          LDD    T2 
          STM    T2SAV
          LDD    D.T3        (A) = NUMBER OF PPU WORDS
          STM    D.T3S
          RJM    DV5         CONVERT TO CPU WORDS 
          STD    D.T3        (D.T3) = NUMBER OF CPU WORDS 
 
*         PLANT PP ADDRESS THE CM WORDS ARE TO BE 
*         WRITTEN FROM
 
          LDD    D.T0        (A) = PP MEMORY ADDRESS TO USE 
          STM    WCS20       PLANT PP MEMORY ADDRESS
 
*         FORM PART OF EM ADDRESS IN (R)
 
          LDD    D.T1        (A) = UPPER PART OF EM ADDRESS 
          SHN    -6          (A) = BITS 23 - 18 OF EM ADDR
          STD    T1 
          LDD    D.T1 
          SHN    6           (A) = BITS 17 - 12 OF EM ADDR
          STD    T2 
          LRD    T1          (R) = BITS 23 - 12 OF EM ADDR
 
*         FORM THE REST OF THE EM ADDRESS IN (A)
 
          LDD    D.T2        (A) = LOWER PART OF EM ADDRESS 
          LMC    R.USE       SET BIT TO USE (R) IN ADDR CALC
 
*         WRITE EM
 
          CWM    **,D.T3
 WCS20    EQU    *-1         LOCATION TO PLANT PP ADDR INTO 
 
*         DONE. 
 
          LRD    D.RSAV      RESTORE OLD (R)
          LDM    T0SAV
          STD    T0 
          LDM    T2SAV
          STD    T2 
          LDM    D.T3S
          STD    D.T3 
          LDN    0           MARK NO ERROR OCCURRED 
 
*          RETURN 
 
          LJM    WRITECSX 
 
 
 T0SAV    BSSZ   1
 T2SAV    BSSZ   1
 D.T3S    BSSZ   1
 
          TITLE  -DDPMCP-    MASTER CLEAR DDP PORT
* 
* 
* 
*         -DDPMCP-           MASTER CLEAR DDP PORT
* 
 DDPMCP   SUBR
          IJM    DMC20,C=DDP
          DCN    C=DDP,40B   INSURE CHANNEL INACTIVE
* 
 DMC20    FNC    5010B,C=DDP      5010B = MASTER CLEAR PORT 
          WAIT   EMPTY,C=DDP,DMC22
 DMC22    WAIT   INACTIVE,C=DDP,DMC30 
* 
 DMC30    IJM    DMC40,C=DDP      CHECK IF CHANNEL INACTIVE 
          DCN    C=DDP,40B   DISCONNECT DDP CHANNEL 
 DMC40    PSN 
*         UJN    *+3         IF ECS MODE
          FNC    5404B,C=DDP SELECT ESM MODE
          LJM    DDPMCPX
* /---   BLOCK      WRITUEM    00 000   84/11/16  11.05 
* 
* 
* /---   BLOCK      STATS      00 000   78/12/20  02.01 
          TITLE  -STATS-     OUTPUT STATISTICS
* 
* 
* 
*         -STATS- 
*         OUTPUTS PIO STATISTICS TO ECS BUFFER
* 
* 
 STATS    SUBR
          SOM    STATCNT     CHECK TIME FOR STATISTICS
          PJN    STATSX 
          LDC    500
          STM    STATCNT     RESET COUNTER
          LDC    STATLTH*5   NUMBER OF PPU WORDS TO WRITE 
          STD    D.T3        D.T3 = NUMBER PPU WRDS TO WRITE
          LDC    STATBUF
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      LOAD LOWER PART OF ECS RA
          ADM    ECSTX+1     ADD LOWER PART OF ECS REL ADDR 
          STD    D.T2        D.T2 = LOWER ECS ADDRESS 
          SHN    -12
          ADM    ECRA        ADD UPPER PART OF ECS RA 
          ADM    ECSTX       ADD UPPER PART OF ECS REL ADDR 
          STD    D.T1        D.T1 = UPPER ECS ADDRESS 
          CALL   WRITECS     WRITE STATS TO ECS 
          UJN    STATSX 
* 
* 
* /---   BLOCK      OUTNET     00 000   81/04/21  20.49 
          TITLE  -OUTNET-    OUTPUT TERMINAL WORD 
* 
* 
* 
*         -OUTNET-
*         OUTPUTS A SINGLE TERMINAL WORD FROM THE TOP THREE 
*         BYTES OF *CMBUFF* 
* 
*         ON EXIT  -  A =  0 = DATA SENT SUCCESSFULLY 
*                         -1 = DATA COULD NOT BE SENT 
* 
* 
 OUTNET   SUBR
          IJM    OUTN10,O=NIU 
          DCN    O=NIU       DEACTIVATE CIU OUTPUT CHANNEL
* 
 OUTN10   FNC    0,O=NIU     SELECT OUTPUT CONTROLLER 
          WAIT   INACTIVE,O=NIU,OUTN90
          ACN    O=NIU       ACTIVATE CIU OUTPUT CHANNEL
          LDN    3           TERMINAL WORD = 3 PPU WORDS
          OAM    CMBUFF,O=NIU         OUTPUT TERMINAL WORD
          WAIT   EMPTY,O=NIU,OUTN90 
          DCN    O=NIU       DEACTIVATE CIU CHANNEL 
          LDN    0
 OUTN20   LJM    OUTNETX
* 
* 
 OUTN90   IJM    OUTN91,O=NIU 
          DCN    O=NIU       DEACTIVATE CIU CHANNEL 
* 
 OUTN91   LCN    1
          UJN    OUTN20 
* 
* 
* /---   BLOCK      MESSAG     00 000   78/02/06  11.06 
          TITLE  -MESSAG-    OUTPUT B-DISPLAY MESSAGE 
* 
* 
* 
*         -MESSAG-
*         OUTPUTS B-DISPLAY MESSAGE 
* 
*         ON ENTRY  -  A = ADDRESS OF MESSAGE 
* 
* 
 MESSAG   SUBR
          STM    MSG10+1     PLANT PPU ADDRESS OF MESSAGE 
          LDN    5
          STD    T1          SET LENGTH OF MESSAGE
          LDD    CP          LOAD CONTROL POINT AREA ADDRESS
          ADN    MS1W        ADD BIAS TO MESSAGE AREA 
* 
 MSG10    CWM    **,T1       WRITE MESSAGE TO CP AREA 
          UJN    MESSAGX
* 
* 
* /---   BLOCK      OTOA       00 000   75/05/21  23.50 
          TITLE  -OTOA-      CONVERT OCTAL TO ALPHA 
* 
* 
* 
*         -OTOA-
*         CONVERT 4 DIGIT OCTAL NUMBER TO DISPLAY CODE
* 
*         ON ENTRY  -  D.T0 = OCTAL NUMBER TO CONVERT 
* 
*         ON RETURN -  D.T1 = FIRST TWO ALPHA CHARACTERS
*                      D.T2 = SECOND TWO CHARACTERS 
* 
* 
 OTOA     SUBR
          LDD    D.T0        LOAD OCTAL TO CONVERT
          SHN    -9          POSITION UPPER OCTAL DIGIT 
          ADN    33B         CONVERT TO ALPHA 
          SHN    6
          STD    D.T1 
          LDD    D.T0        LOAD OCTAL TO CONVERT
          SHN    -6          POSITION SECOND OCTAL DIGIT
          LPN    7
          ADN    33B         CONVERT TO ALPHA 
          RAM    D.T1 
          LDD    D.T0        LOAD OCTAL TO CONVERT
          SHN    -3          POSITION THIRD OCTAL DIGIT 
          LPN    7
          ADN    33B         CONVERT TO ALPHA 
          SHN    6
          STD    D.T2 
          LDD    D.T0        LOAD OCTAL TO CONVERT
          LPN    7           MASK OFF FOURTH DIGIT
          ADN    33B
          RAM    D.T2 
          UJN    OTOAX
* 
* 
* /---   BLOCK      CEQUIP     00 000   81/04/30  15.09 
          TITLE  -CEQUIP-    CLEAR EQUIPMENT
* 
* 
* 
*         -CEQUIP-
*         CLEARS EQUIPMENT SELECTIONS - DE-SELECTS CIU
*         INPUT AND OUTPUT AND MASTER CLEARS DDP PORT 
* 
* 
 CEQUIP   SUBR
          LDM    DDP         CHECK IF DDP ASSIGNED
          ZJN    CEQ200 
          IJM    CEQ110,C=DDP 
          DCN    C=DDP,40B   DE-ACTIVATE DDP CHANNEL
* 
 CEQ110   FNC    5010B,C=DDP      MASTER CLEAR DDP
          IJM    CEQ200,C=DDP 
          DELAY  30 
          IJM    CEQ200,C=DDP 
          DCN    C=DDP,40B   DE-ACTIVATE DDP CHANNEL
* 
 CEQ200   LDM    CIUEQ       CHECK IF CIU AVAILABLE 
          ZJN    CEQUIPX
          IJM    CEQ210,I=NIU 
          DCN    I=NIU       DE-ACTIVATE CIU INPUT CHANNEL
* 
 CEQ210   FNC    0B,I=NIU         DE-SELECT CIU INPUT 
          IJM    CEQ300,I=NIU 
          DELAY  30 
          IJM    CEQ300,I=NIU 
          DCN    I=NIU       DE-ACTIVATE CIU INPUT CHANNEL
* 
 CEQ300   IJM    CEQ310,O=NIU 
          DCN    O=NIU       DE-ACTIVATE CIU OUTPUT CHANNEL 
* 
 CEQ310   FNC    7000B,O=NIU      DE-SELECT CIU OUTPUT
          IJM    CEQ400,O=NIU 
          DELAY  30 
          IJM    CEQ400,O=NIU 
          DCN    O=NIU       DE-ACTIVATE CIU OUTPUT CHANNEL 
 CEQ400   LJM    CEQUIPX
* 
* /---   BLOCK      ALLOUT     00 000   81/04/30  15.09 
          TITLE  -ALLOUT-    SEND MESSAGE TO ALL TERMINALS
* 
* 
* 
*         -ALLOUT-
*         SEND A MESSAGE TO ALL TERMINALS 
* 
*         ON ENTRY  -  A = ADDRESS OF MESSAGE 
* 
* 
 ALLOUT   SUBR
          STD    BASE        ADDRESS OF MESSAGE 
          STD    ADDRESS
          LDM    CIUEQ       CHECK CIU AVAILABLE FLAG 
          ZJN    ALLOUTX
* 
*         FIND THE LENGTH OF THE MESSAGE
* 
          LDN    0           INITIALIZE 
          STD    LENGTH 
          STD    ILOOP
 
 ALLL     LDI    ADDRESS     GET THE NEXT 12 BIT PARCEL 
          ZJP    ALLA          ZERO WORD MARKS END. 
          AOD    LENGTH 
          AOD    ADDRESS
          UJP    ALLL 
* 
*         BEGIN OUTER LOOP OVER THE MESSAGE LENGTH
* 
 ALLA     LDD    ILOOP
          SBD    LENGTH      ILOOP-LENGTH 
          SBN    NCLASSES    MINUS 2**NN
          PJN    ALLOUTX     IF ILOOP GT MESSAGE LTH, DONE
* 
*         BEGIN INNER LOOP OVER STATIONS
* 
          LDC    1008        NUMBER OF REAL STATIONS
          STD    STATION     HIGHEST STATION NUM IS ONE LESS
* 
 ALLB     SOD    STATION     INNER LOOP 
          ZJP    ALLC        END TEST 
          SCN    NN          CLEAR NN BITS
          LMC    -0          COMPLEMENT 
          ADD    STATION     CLASS=MOD(STATN,2**NN) 
          SHN    1           2*CLASS
          LMC    -0          -2*CLASS 
          ADD    ILOOP       ILOOP-2*CLASS
          STD    ADDRESS     RELATIVE ADDRESS, THIS CLASS 
          MJN    ALLB        IF ADDRESS LT 0, LOOP
* 
          SBD    LENGTH 
          PJN    ALLB        IF ADDRESS GE LENGTH, LOOP 
* /---   BLOCK      ALLOUT     00 000   81/04/21  20.51 
* 
          LDD    BASE        START OF MESSAGE 
          RAD    ADDRESS     CORRECT ADDRESS BY BASE
          LDI    ADDRESS
          STM    CMBUFF      FIRST PART 
          AOD    ADDRESS
          LDI    ADDRESS
          STM    CMBUFF+1    SECOND PART
          LDD    STATION
          STM    CMBUFF+2    STATION NUMBER 
          CALL   MSGOUT 
          PJP    ALLB        IF NO ERROR, LOOP
          UJP    ALLD        ERROR--COULD NOT GET IT OUT
* 
*         END OF LOOP--PUT OUT END OF FRAME 
* 
 ALLC     LDN    2
          RAD    ILOOP       ILOOP=ILOOP+2 (PPU WD COUNTER) 
          LDC    4000B       SET START DATA BIT 
          STM    CMBUFF 
          LDN    0
          STM    CMBUFF+1 
          LDC    2000B       END OF FRAME BIT 
          STM    CMBUFF+2    SEND TO STATION 0
          CALL   MSGOUT 
          PJP    ALLA        IF NO ERROR, NEXT OUTER LOOP 
* 
*         THE CIU DOES NOT REPLY--PUT OUT MESSAGE AND RETURN
* 
 ALLD     CALL   DFM,NIUDN      *(PIO) NO REPLY FROM CIU* 
          LJM    ALLOUTX
* 
 NIUDN    DIS    ,*(PIO) NO REPLY FROM CIU* 
* 
* /---   BLOCK      MSGOUT     00 000   81/04/21  20.52 
          EJECT 
* 
* 
* 
*         -MSGOUT-
*         SUBROUTINE USED BY -ALLOUT- TO SEND TO A TERMINAL 
* 
*         ON EXIT -  A = POSITIVE IF MESSAGE SENT 
*                        NEGATIVE IF CIU WOULD NOT ACCEPT 
* 
* 
 MSGOUT   SUBR
          LDC    4000        INITIALIZE WAIT COUNTER
          STM    II 
* 
 MO100    CALL   OUTNET 
          PJN    MSGOUTX     IF MESSAGE SENT
          SOM    II 
          PJP    MO100       CONTINUE TRYING
          UJN    MSGOUTX
* 
* 
* /---   BLOCK      OFFMSG     00 000   75/07/07  22.25 
          TITLE  OFFMSG      *PLATO OFF* MESSAGE
* 
* 
 OFFMSG   DATA   4160B,0070B  CLEAR ABORT / BLOCK CHECK OFF 
          DATA   4500B,1000B LOAD SSL LAMP OFF, SHUTTER SHUT
          DATA   4140B,0064B LOAD CHAR MODE (MODE REWRITE)
          DATA   4200B,0420B LOAD X=136 (COLUMN 18) 
          DATA   4201B,1600B LOAD Y=448 (LINE 4)
          DATA   5777B,1640B (UNCOVER)(UNCOVER)(20) 
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   4160B,0070B  CLEAR ABORT / BLOCK CHECK OFF 
          DATA   4140B,0064B LOAD CHAR MODE (MODE REWRITE)
          DATA   4200B,0420B LOAD X=136 (COLUMN 18) 
          DATA   4201B,1540B LOAD Y=432 (LINE 5)
          DATA   5777B,1640B (UNCOVER)(UNCOVER)(20) 
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5552B,0030B (SPACE)PL
          DATA   5012B,1036B ATO
          DATA   5555B,1236B (SPACE)(SPACE)O
          DATA   5060B,1532B FF(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   4160B,0070B  CLEAR ABORT / BLOCK CHECK OFF 
          DATA   4140B,0064B LOAD CHAR MODE (MODE REWRITE)
          DATA   4200B,0420B LOAD X=136 (COLUMN 18) 
          DATA   4201B,1500B LOAD Y=416 (LINE 6)
          DATA   5777B,1640B (UNCOVER)(UNCOVER)(20) 
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   5555B,1332B (SPACE)(SPACE)(SPACE)
          DATA   4160B,0070B  CLEAR ABORT / BLOCK CHECK OFF 
          DATA   4140B,0024B LOAD LINE MODE 
          DATA   5570B,1640B LINER(376,464) 
          DATA   5210B,1640B LINER(136,464) 
          DATA   5210B,1500B LINER(136,416) 
          DATA   5570B,1500B LINER(376,416) 
          DATA   0           END OF MESSAGE 
* 
* 
* /---   BLOCK      ONMSG      00 000   76/12/06  02.03 
* 
 ONMSG    DATA   4160B,0070B  CLEAR ABORT / BLOCK CHECK OFF 
          DATA   4500B,1000B LOAD SSL LAMP OFF, SHUTTER SHUT
          DATA   4140B,0076B LOAD CHAR MODE (WRITE, FULL SCREEN ERASE)
          DATA   4200B       LOAD X 
 ONMSX    DATA   400B        X!0=128
          DATA   4201B       LOAD Y 
 ONMSY    DATA   400B        Y!0=128
          DATA   5772B,0240B (UNCOVER)(21)'P
          DATA   5772B,0044B (UNCOVER)(20)R 
          DATA   5052B,0646B ESS
          DATA   5555B,1376B (SPACE)(SPACE)(UNCOVER)
          DATA   5211B,1412B (21)NE 
          DATA   5302B,1176B XT(UNCOVER)
          DATA   5205B,1332B (20)(SPACE)(SPACE) 
          DATA   5241B,1732B TO(SPACE)
          DATA   5020B,1216B BEG
          DATA   5111B,1576B IN(UNCOVER)
          DATA   5207B,1640B (20)(UNCOVER)(20)
          DATA   0           END OF MESSAGE 
* 
* /---   BLOCK      DROP       00 000   81/04/30  15.11 
          TITLE  -DROP-      DROP PPU 
* 
* 
* 
*         -DROP-
*         RELEASE ALL EQUIPMENT/CHANNELS ASSIGNED AND 
*         DROP PPU PROGRAM
* 
* 
 DROP     CALL   CEQUIP      DE-SELECT DDP/CIU
          LDM    DDP         CHECK IF DDP ASSIGNED
          ZJN    DROP200
* 
*         DROP DDP PORT CHANNEL 
* 
          LDM    /C=DDP/C=DDP 
          DCHAN 
* 
*         DROP CIU EQUIPMENT/CHANNELS 
* 
 DROP200  LDM    CIUEQ       CHECK IF CIU ASSIGNED
          ZJN    DROP400
          LDM    /I=NIU/I=NIU 
          DCHAN 
          LDM    /O=NIU/O=NIU 
          DCHAN 
          LDN    ZERL 
          CRD    CM          PRE-CLEAR ARGUMENTS
          LDM    CIUEQ       SET CIU EQ (EST ORDINAL) 
          STD    CM+1 
          MONITOR DEQM       DROP CIU EQUIPMENT 
* 
 DROP400  CALL   DFM,DMSG1        OUTPUT DAYFILE MESSAGE
          MONITOR DPPM       DROP PPU 
          UJP    PPR
* 
* 
 DMSG1    DIS    ,*(PIO)  PPU DROPPED*
* 
* 
* /---   BLOCK      STORAGE    00 000   81/09/02  14.08 
          TITLE  STORAGE DEFINITIONS
* 
* 
*CALL     PLAPDNM 
*CALL     PLAPPLN 
* 
* 
 C=DDP    TABLE  CHANNEL     DDP CHANNEL
 O=NIU    TABLE  CHANNEL     CIU OUTPUT CHANNEL 
 I=NIU    TABLE  CHANNEL     CIU INPUT  CHANNEL 
* 
* 
 ECRA     BSS    2           ECS REFERENCE ADDRESS
* 
 PARAMS   BSSZ   5*NPARAMS
 ECSSWX   EQU    PARAMS+1    ECS ADDR OF REQUEST SWITCH/LIST
 FKBFADD  EQU    ECSSWX+2    REL ADDR OF FASTKEY REQUEST BUF
 PSITES   EQU    PARAMS+9    NUMBER OF SITES
 SCIMADD  EQU    PSITES+2    REL ADDR OF PIO/SCIM BUFFER
 KEYBADD  EQU    SCIMADD+2   REL ADDR OF KEY BUFFERS
 OUTPNT   EQU    KEYBADD+5   REL ADDR OF FRAME COUNTER
 OUTTAB   EQU    OUTPNT+5    REL ADDR OF FRAME LENGTH TABLE 
 OUTBUFF  EQU    OUTTAB+5    REL ADDR OF FRAME BUFFERS
 ECSTX    EQU    OUTBUFF+3   REL ADDR OF ECS STATS BUFFER 
 JFILL    EQU    ECSTX+7     UNUSED 
 FRAMLTH  EQU    JFILL+6     MAXIMUM LENGTH OF FRAME
 
 
 
*****   DONT REMOVE ARGUMENTS WITHOUT CHANGING NEXT CODE
 
 CIUNUM   EQU    PARAMS+5*9  10 THE ARG.  CIU NUMBER
 PLATSIT  EQU    CIUNUM+1    FIRST PLATO SITE 
 NUMSIT   EQU    PLATSIT+1   NUMBER OF SITES
 PHYSIT   EQU    NUMSIT+1    FIRST SITE OF CIU TO BE USED 
 
 
* 
* 
 PSTATS   TABLE  CM          PPU STATUS WORD
 STATSW   TABLE  CM          CONTROL POINT STATUS WORD
* 
 PSTATX   BSSZ   2           REL ADDR OF PPU STATUS WORD
* 
 ILAST    BSS    1
 IBIAS    BSS    2
 II       BSS    1
 JJ       BSS    1
 KOCNT    BSS    1
 PINIT    DATA   0
 FICNT    DATA   0
* 
 NFRAME   BSSZ   5           FRAME COUNTER
 IFRAME   DATA   0           INDEX TO CURRENT FRAME 
 FBIAS    DATA   0           BIAS  TO CURRENT FRAME 
          DATA   0
 ECSBUFF  BSS    10          BUFFER FOR ECS READ/WRITE
 FKYBUFF  BSS    10          BUFFER FOR ECS READ/WRITE
 STRBUFF  BSS    5           BUFFER FOR ECS READ/WRITE
 CMBUFF   BSS    5           BUFFER FOR CM  READ/WRITE
* 
 NOOP0    VFD    12/4000B    SPECIAL NO-OP FOR STATION 0
          VFD    12/0 
          VFD    12/0 
* 
* /---   BLOCK      STORAGE    00 000   81/09/08  01.00 
* 
 CIUEQ    DATA   0           CIU        EST ORDINAL 
 DDP      DATA   0           DDP        EST ORDINAL 
* 
 CIC      DATA   0           CIU INPUT  CHANNEL NUMBER
 COC      DATA   0           CIU OUTPUT CHANNEL NUMBER
* 
* 
*         NON-OVERLAYED INITIALIZATIONS 
* 
 INITIAL  SUBR
          RJM    /PRS/INITIAL 
*         ZERO BUFFERS OVERLAYED BY INITIALIZATION CODE 
          LDC    ZERLTH 
          STD    D.T0 
 
 INIT1    LDN    0
          STM    PPBUFF,D.T0
          SOD    D.T0 
          PJN    INIT1
*         SET OVERLAYED CONSTANTS 
          LDK    PPBLTH 
          STM    PENDTST
          LDK    KEYLTH-2 
          STM    KENDTST
          UJN    INITIALX 
* 
* 
*         FOLLOWING BUFFERS ARE OVERLAYED BY PRESET ROUTINE.
*         NON-OVERLAYED INITIALIZATIONS ABOVE ZERO THESE
*         BUFFERS BEFORE THEY ARE USED. 
* 
* 
 PPBUFF   EQU    *           TERMINAL OUTPUT BUFFER 
 KEYBUFF  EQU    PPBUFF+5*PPBLTH+5   KEY INPUT BUFFER 
* 
 PENDTST  EQU    KEYBUFF+KEYLTH 
 KENDTST  EQU    PENDTST+1
* 
 SFCNT    EQU    KENDTST+1
 STATCNT  EQU    SFCNT+1
* 
 STATBUF  EQU    STATCNT+1
*         FIRST 2 CM WORDS = STATISTICS 
*         NEXT  2          = BAD STATION LIST 
 IBAD     EQU    STATBUF     STATIONS FLOODING KEYS 
 KYRESP   EQU    IBAD+1      NO INPUT RESPONSE
 OUTRESP  EQU    KYRESP+1    NO OUTPUT RESPONSE 
 KYOFLOW  EQU    OUTRESP+1   PPU BUFFER OVERFLOW
 KYIGN    EQU    KYOFLOW+1   KEYS IGNORED 
 KYSEQ    EQU    KYIGN+1     KEY DATA WORDS OUT OF SEQUENCE 
 KYSTATN  EQU    KYSEQ+1     KEY STATION ILLEGAL
 KYIGNT   EQU    KYSTATN+1   KEYS IGNORED IN TEST MODE
 FKSTAT   EQU    KYIGNT+1    FASTKEY STATS
 MXKBIDX  EQU    FKSTAT+1    MAXIMUM KEYBUFFER INDEX
 BADLIST  EQU    STATBUF+10  BAD STATION LIST 
* 
 SCIMBUF  EQU    STATBUF+5*STATLTH    PIO/SCIM COMM BUFFER
 TESTLST  EQU    SCIMBUF+SCIMLTH*5   LIST OF STATIONS WITH
*                            1--4 KEY BUFFER OVERFLOWS
 CNTLST   EQU    TESTLST+BADLTH*2   COUNT OF OVERFLOWS FOR
*                            STATIONS ON TEST LIST
* 
 BADCNT   EQU    CNTLST+BADLTH*2
 ITEST    EQU    BADCNT+1    COUNT OF STATIONS ON TEST LIST 
* 
 ZERLTH   EQU    ITEST-PPBUFF   LENGTH TO BE ZEROED 
* 
*         CHECK FOR BUFFERS OVERFLOWING PPU 
* 
          ERRPL  ITEST+1-7770B   BUFFERS OVERFLOW PPU 
* 
* /---   BLOCK      INITIAL    00 000   87/02/24  12.54 
          TITLE  -INITIAL-   INITIALIZATIONS
          QUAL   PRS
          ORG    PPBUFF 
* 
* 
* 
*         -INITIAL- 
*         ONE TIME ONLY INITIALIZATIONS 
* 
* 
 INITIAL  SUBR
 .NOSV2   IFGE   OSLEV,562D  NOS V2 
          LDK    MABL        READ MACHINE ATTRIBUTES
          CRD    CM 
          LDD    CM+1        CPU ATTRIBUTES 
          SHN    -13B        GET 800 SERIES BIT 
          LMN    1
.NOSV2    ELSE
          LDC    CPUL 
          CRD    CM 
          LDD    CM+3 
          SHN    -10B 
          LPN    1
 .NOSV2   ENDIF 
          STD    A170 
* 
*         INITIALIZE VARIABLES
* 
          LDN    0
          STD    KEYII
          STD    KEYOI
* 
*         GET ADDR OF CONTROL POINT STATUS WORD (STSW)
* 
 INIT130  LDD    CP          CONTROL POINT ADDRESS WORD 
          ADN    STSW        FORM ADDRESS OF STATUS WORD
          CRD    D.T0        READ CONTROL POINT STATUS
          LDD    D.T0+C.CPEF
          NJP    DROP        DROP PPU IF ERROR
* 
*         WAIT PLATO IN RECALL BEFORE READING ECS ADDRESS 
* 
          LDD    D.T0+C.CPSTAT
 .NOSV2   IFLT   OSLEV,562D  NOS V1 
          LPC    3000B       CHECK PLATO IN RECALL (I OR X) 
          NJN    INIT135
 .NOSV2   ELSE               NOS V2 
          SHN    -11B        CHECK FOR *I* STATUS (6) 
          SBN    5
          PJN    INIT135     IF IN AUTO-RECALL
 .NOSV2   ENDIF 
          DELAY  1000        IDLE FOR 1 MILLISECOND 
          UJP    INIT130
* /---   BLOCK      INITIAL    00 000   87/02/24  13.00 
* 
*         READ ECS REFERENCE ADDRESS FROM EXCHANGE PACKAGE
* 
 INIT135  LDD    CP          ADDRESS OF CONTROL POINT AREA
          ADN    4           BIAS TO RAX
          CRD    D.T0 
 .NOS252  IFGE   OSLEV,678D 
          LDK    MEFL 
          CRD    CM 
          LDD    CM+2 
          SHN    6+4         EXTENDED ADDRESSING BIT
          MJN    INIT137     IF EXTENDED ADDRESSING MODE
 .NOS252  ELSE
          RJM    GEC         GET ECS MODE 
          NJN    INIT137     IF ESM MODE
 .NOS252  ENDIF 
          LDD    D.T0        SET UPPER PART OF ECS RA 
          LPC    777B 
          STM    ECRA 
          LDD    D.T0+1      SET LOWER PART OF ECS RA 
          STM    ECRA+1 
 .NOS252  IFGE   OSLEV,678D 
          UJN    INIT138
 .NOS252  ELSE
          LDC    0303B       UJN  *+3 
          STM    DMC40       NO-OP SELECT ESM MODE
          UJN    INIT140
 .NOS252  ENDIF 
 
 INIT137  LDD    D.T0 
          LPN    77B         CLEAR FLAG BITS
          SHN    12 
          LMD    D.T1 
          SHN    12 
          STM    ECRA        SAVE UPPER PART OF ECS RA
          SHN    -6          POSITION LOWER PART OF ESM RA
          SCN    77B
          STM    ECRA+1      SAVE LOWER PART OF ECS RA
 .NOS252  IFGE   OSLEV,678D 
 
*         SET ECS/ESM MODE
 
 INIT138  RJM    GEC         GET ECS MODE 
          NJN    INIT140     IF ESM MODE
          LDC    0303B       UJN  *+3 
          STM    DMC40       NO-OP SELECT ESM MODE
 .NOS252  ENDIF 
* 
*         PLANT REFERENCES TO CONTROL POINT STATUS WORD 
* 
 INIT140  LDM    II          PLANT REFERENCES TO STATUS WORD
          PLANT  CM,STATSW
* 
* /---   BLOCK      INITIAL    00 000   81/04/28  14.28 
* 
*         GET ADDR OF PPU STATUS WORD AND READ PARAMETERS 
*         WHICH FOLLOW TO PPU MEMORY
* 
          LDD    IR+3        SET UPPER PART OF REL ARGUMENT 
          LPN    37B
          STM    PSTATX 
          LDD    IR+4 
          STM    PSTATX+1    SET LOWER PART OF REL ARGUMENT 
          LDD    IR+3 
          LPN    37B         FORM ADDRESS OF ARGUMENT 
          SHN    12 
          ADD    IR+4 
          RJM    ABS         CONVERT TO ABSOLUTE
          ZJP    DROP 
          PLANT  CM,PSTATS   PLANT REFERENCES TO STATUS WORD
          LDM    PSTATX      LOAD UPPER PART OF REL ADDRESS 
          SHN    6
          ADD    RA          ADD CM REFERENCE ADDRESS 
          SHN    6
          ADM    PSTATX+1    ATTACH LOWER 12 BITS 
          PLANT  CM,IPSTAT   PLANT FOR INITIALIZATIONS
          LDC    NPARAMS
          STD    D.T0        SET NUMBER OF WORDS TO READ
          LOADCM IPSTAT 
          ADN    1
          CRM    PARAMS,D.T0      READ PARAMETER VECTOR 
* 
* /---   BLOCK      INITIAL    00 000   87/02/11  12.10 
* 
*         RESERVE DISTRIBUTIVE DATA PATH CHANNEL
* 
 INI200   BSS    0
          LDD    A170 
          NJP    INI201      IF 800 MACHINE 
          LDC    2RD2        DDP EQUIPMENT NAME 
          RJM    EQN
          MJP    NODDP       EXIT IF NO DDP AVAILABLE 
          STM    DDP
 .NOS252  IFGE   OSLEV,678D 
          MONITOR RCHM
 .NOS252  ELSE
          LDN    0           CLEAR ADDITIONAL CHANNELS WORD 
          STD    CM+2 
          LDD    CM+1        LOAD DDP PORT CHANNEL NUMBERS
          RCHAN 
 .NOS252  ENDIF 
          LDD    CM+1        LOAD CHANNEL ACTUALLY ASSIGNED 
          PLANT  CHANNEL,C=DDP
          CALL   DDPMCP      MASTER CLEAR DDP 
          CALL   DFM,IMSG1   OUTPUT DAYFILE MESSAGE 
* 
*         SEARCH EQUIPMENT TABLE FOR SPECIFIED CIU
* 
 INI201   LDC    2RCI        CI = CIU EQUIPMENT NAME
          STD    T3          T3 = EQUIPMENT TYPE NAME 
          LDN    ESTP 
          CRD    CM          READ POINTER TO EST
 .NOS22   IFGE   OSLEV,594D  NOS 2.2
          LDD    CM+2 
          STD    T2          (T2) = LAST EST ORDINAL + 1
          LDN    0
          STD    T4          (T4) = CURRENT EST ORDINAL 
 
 INIT230  SFA    EST,T4      (A) = FWA OF CURRENT EST ENTRY 
          ADK    EQDE        OFFSET TO WORD WITH DEVICE TYPE
 .NOS22   ELSE               NOS 2.1
          LDD    CM          LOAD FWA OF EST
          STD    T1          T1 = FWA EST 
          STD    T4          T4 = INDEX IN EST
          LDD    CM+1        LOAD LWA+1 OF EST
          STD    T2          T2 = LWA+1 EST 
* 
* /---   BLOCK      INITIAL    00 000   87/02/10  10.56 
* 
 INIT230  LDD    T4          LOAD POINTER TO NEXT EST ENTRY 
 .NOS22   ENDIF 
          CRD    CM 
          LDD    CM+3        LOAD EQUIPMENT TYPE CODE 
          SBD    T3 
 .NOS251  IFGE   OSLEV,664D 
          NJP    INIT235     IF DEVICE TYPE DOES NOT MATCH
          LDD    CM 
          LPN    3
          ZJP    INIT240     IF DEVICE IS AVAILABLE 
 .NOS251  ELSE
          ZJP    INIT240     IF DEVICE TYPE MATCHES 
 .NOS251  ENDIF 
* 
 INIT235  AOD    T4          ADVANCE TABLE POINTER
          SBD    T2          CHECK FOR END OF TABLE 
          NJP    INIT230
          UJP    INIT350
* 
 INIT240  LDD    CM+4        LOAD UNIT NUMBER WORD
          LPC    77B         MASK OFF UNIT NUMBER 
          SBM    CIUNUM 
          NJP    INIT235     CHECK IF SPECIFIED CIU 
 .NOSV2   IFGE   OSLEV,562D  NOS V2 
 .NOS22   IFGE   OSLEV,594D  NOS 2.2
          SFA    EST,T4      (A) = FWA OF EST ENTRY 
          ADK    EQAE        OFFSET TO WORD WITH EJT ORDINAL
          CRD    D.T0 
 .NOS22   ELSE               NOS 2.1
          LDD    T4          (A) = EST ENTRY ADDRESS
          ADD    HN          OFFSET TO EAT
          CRD    D.T0 
 .NOS22   ENDIF 
          LDD    D.T0+4      (A) = EJT ORDINAL
 .NOSV2   ELSE               NOS V1 
          LDD    CM 
          LPC    37B         MASK OFF CONTROL PT ASSIGNMENT 
 .NOSV2   ENDIF 
          NJP    DROP        JUMP IF CIU ALREADY RESERVED 
* 
*         OBTAIN CIU CHANNEL/EQUIPMENT NUMBERS
* 
          LDD    CM+1 
          LPC    77B         MASK OFF CIU INPUT CHANNEL 
          STM    CIC         SET CIU INPUT CHANNEL NUMBER 
 .NOS252  IFGE   OSLEV,678D 
          LDD    CM+2 
 .NOS252  ELSE
          LDD    CM+1 
          SHN    -6          POSITION OUTPUT CHANNEL NUMBER 
 .NOS252  ENDIF 
          LPC    77B
          STM    COC         SET CIU OUTPUT CHANNEL NUMBER
          LDD    T4          COMPUTE  EQUIPMENT ORDINAL 
 .NOS21   IFLT   OSLEV,594D  NOS 2.1 OR PRIOR 
          SBD    T1 
 .NOS21   ENDIF 
          STM    CIUEQ       SET CIU EQUIPMENT
* 
* /---   BLOCK      INITIAL    00 000   81/04/30  15.12 
* 
*         RESERVE CIU EQUIPMENT 
* 
          LDN    ZERL        PRE-CLEAR ARGUMENTS
          CRD    CM 
 .NOS242  IFGE   OSLEV,642D 
          ERRNZ  REQS        CODE DEPENDS ON REQS = 0 
 .NOS242  ENDIF 
          LDM    CIUEQ       LOAD CIU EQUIPMENT ORDINAL 
          STD    CM+1 
          MONITOR REQM       RESERVE CIU EQUIPMENT
* 
*         RESERVE CIU INPUT/OUTPUT CHANNELS 
* 
          LDM    CIC         LOAD CIU INPUT CHANNEL NUMBER
          RCHAN 
          LDD    CM+1        LOAD CHANNEL ACTUALLY ASSIGNED 
          PLANT  CHANNEL,I=NIU
          LDM    COC         LOAD CIU OUTPUT CHANNEL NUMBER 
          RCHAN 
          LDD    CM+1        LOAD CHANNEL ACTUALLY ASSIGNED 
          PLANT  CHANNEL,O=NIU
          CALL   DFM,IMSG2   OUTPUT DAYFILE MESSAGE 
* 
*         UPDATE *PIO* CM STATUS WORD 
* 
 INIT350  LOADCM IPSTAT      GET ADDRESS OF STATUS WORD 
          CRD    D.T0        READ PPU STATUS WORD 
          LDN    1           SET COMPLETION BIT OF STATUS WD
          STD    D.T0+4 
          LDN    0           PRE-SET = NO EQUIPMENT RESERVED
          STD    D.T0 
          LDM    CIUEQ       CHECK IF CIU AVAILABLE 
          ZJP    INIT354       JUMP IF NOT
          LDN    3           MARK CIU RESERVED
          STD    D.T0 
* 
*         SET BIT 0 OF PIO PARAMETER WORD TO INDICATE 
*         ALL INITIALIZATIONS DONE. 
* 
 INIT354  LOADCM IPSTAT      GET ADDRESS OF STATUS WORD 
          CWD    D.T0        RE-WRITE STATUS WORD 
* 
* /---   BLOCK      INITIAL    00 000   81/04/21  20.57 
* 
*         SET UP *PRESS -NEXT- TO BEGIN* MESSAGE
* 
 INIT360  IAN    14B         INPUT REAL TIME CLOCK
          SHN    -6 
          LPC    77B         MASK TO RANGE OF 64
          SHN    2           SHIFT TO RANGE OF 128
          RAM    ONMSX
          IAN    14B         INPUT REAL TIME CLOCK
          LPC    77B         MASK TO RANGE OF 64
          SHN    3           SHIFT TO RANGE OF 256
          RAM    ONMSY
          CALL   CEQUIP      DE-SELECT CIU/DDP
* 
          LDM    NUMSIT 
          SHN    5
          STD    NS          SET UP NUMBER OF STATIONS
          LDM    PHYSIT 
          SHN    5
          STD    FS          FIRST LEGAL PHYSICAL STATION 
          LDD    NS 
          ADD    FS 
          LMC    -0 
          STM    .NTERM1     SET MAX PHYSICAL STATION NUMBER
          LDM    PLATSIT     CALCULATE STATION BIAS 
          SBM    PHYSIT 
          SHN    5
          STD    CB          SET UP CIU BIAS
* 
* /---   BLOCK      INITIAL    00 000   78/10/22  11.57 
* 
*         READ INITIAL VALUE OF FRAME COUNTER 
* 
          LDC    NFRAME 
          STD    D.T0        D.T0 = PPU MEMORY ADDRESS
          LDM    ECRA+1      COMPUTE ECS ADDR OF FRAME COUNT
          ADM    OUTPNT+1 
          STD    D.T2        D.T2 = LOWER PART OF ECS ADDR
          SHN    -12
          ADM    ECRA 
          ADM    OUTPNT 
          STD    D.T1        D.T1 = UPPER PART OF ECS ADDR
          LDN    5
          STD    D.T3        D.T3 = NUMBER WORDS TO WRITE 
          CALL   READECS     READ FRAME COUNTER FROM ECS
          LJM    INITIALX 
 
 
 NODDP    LOADCM IPSTAT      SET COMPLETE BIT 
          CRD    D.T0 
          LDN    1
          STD    D.T0+4 
          LDN    0           SET NO EQUIPMENT RESERVED
          STD    D.T0 
          LOADCM IPSTAT 
          CWD    D.T0 
          CALL   DFM,NODDPA  ISSUE DAYFILE MESSAGE
          LJM    DROP 
 
 NODDPA   DIS    ,*(PIO)  NO DDP/LSP AVAILABLE* 
 GEC      SPACE  5,11 
**        GEC - GET ECS MODE
* 
*         SEARCH FOR MASTOR,S CONTROL POINT AND READ
*         ECS CONTROL WORD
* 
*         EXIT - (A) - 0 IF ECS MODE
*                      1 IF ECM MODE
 
 
 GEC      SUBR
 .NOSV2   IFGE   OSLEV,562D  (NOS VERSION 2)
          RJM    IFP         INITIALIZATION FOR SFA MACRO 
 .NOSV2   ENDIF 
 
          LDK    NCPL        ADDR OF LOW-CORE WORD WITH NCP 
          CRD    CM 
 .NOSV2   IFGE   OSLEV,562D  NOS V2 
          LDD    CM+1 
 .NOSV2   ELSE               NOS V1 
          LDD    CM+3        (A) = NUMBER OF CONTROL POINTS 
 .NOSV2   ENDIF 
          STD    T1 
 GEC1     LDD    T1 
          SHN    7
          STM    MASCPA      FWA OF MASTOR-S CP AREA
          ADK    JCIW        GET SUBSYSTEM ID/QUEUE PRIORITY
          CRD    T2 
 .NOSV2   IFLT   OSLEV,562D  NOS V1 
          SBK    JCIW-JNMW
          CRD    CM 
 .NOSV2   ELSE               NOS V2 
          LDD    T1          (A) = CONTROL POINT NUMBER 
          SHN    7           (A) = CP AREA ADDRESS
          ADK    TFSW        GET EJT ORDINAL
          CRD    CM 
          SFA    EJT,CM      COMPUTE ABS ADDR OF EJT ENTRY
          ADK    JSNE        ADD WORD OFFSET FOR JSN
          CRD    CM          (CM - CM+1) = JOB SEQUENCE NAME
 .NOSV2   ENDIF 
          LDD    CM+1 
          SCN    77B
          SHN    6
          LMD    CM 
          LMC    3RSMA
          ZJN    GEC1.1      IF MASTOR
          LJM    GEC2        IF NOT MASTOR
 
 GEC1.1   BSS    0
 .NOSV2   IFLT   OSLEV,562D  NOS V1 
          LDD    T2+1        CHECK QUEUE PRIORITY 
          ADC    -MXPS-1
          MJP    GEC2        IF NOT MASTOR
 .NOSV2   ELSE               NOS V2 
 .NOS23   IFGE   OSLEV,617D 
          LDD    T2+2 
          SBK    PLSI 
          NJP    GEC2        IF NOT MASTOR SUBSYSTEM ID 
 .NOS23   ELSE
* /---   BLOCK      INITIAL    00 000   89/06/01  15.54 
          LDD    T2+2        CHECK SUBSYSTEM ID 
          SBK    PLSI        INITIAL PLATO ID 
          ZJN    GEC1.2      IF PLATO CONTROL POINT 
          LDD    T2+2 
          SBK    7754B
          NJP    GEC2        IF NOT PLATO SUBSYSTEM ID
 .NOS23   ENDIF 
 .NOSV2   ENDIF 
 
 GEC1.2   BSS    0
          LDN    CMCL        CHECK IF CP MOVING 
          CRD    CM 
          LDD    T1 
.NOS27    IFLT   OSLEV,716D  NOS2.7.1 
          SHN    7
.NOS27    ENDIF 
          LMD    CM 
          ZJP    GEC1        IF MOVING
* 
*         MASTOR(N) LOCATED; READ EXTENDED MEMORY POINTERS. 
* 
 
 .NOSV2   IFGE   OSLEV,562D  (NOS VERSION 2)
          LDD    A170 
          ZJN    GEC1.3      -- IF CME NOT PRESENT
          LDN    1           CME PRESENT, 800 SERIES
 
 GEC1.3   BSS    0           ENTER WITH (A) = 0 OR 1
          ADK    FLSW        OFFSET TO FIELD LENGTH WORDS 
          ADM    MASCPA      PLUS MASTOR CP AREA ADDR 
          CRD    CM          READ APPROPRIATE WORD
          SRD    D.RSAV      SAVE *R* FROM CALLING CP 
          LRD    CM+1        LOAD *R* WITH (RA-NFL)/100B
          LDD    CM+3        MASTOR(N) RA 
 
 .NOSV2   ELSE               (NOS VERSION 1)
 
          LDM    MASCPA      MASTOR CP AREA ADDR
 .NOS552  IFGE   OSLEV,552D  (NOS VERSION 1.4/552)
          ADK    FLSW 
 .NOS552  ELSE               (PRE-NOS VERSION 1.4/552)
          ADK    STSW 
 .NOS552  ENDIF 
          CRD    CM          READ RA/FL INFORMATION 
 
          LDD    A170 
          NJN    GEC1.3      -- IF AN 800 SERIES MAINFRAME
          LDD    CM+3        12-BIT RA ON A NON-800 
          UJN    GEC1.4      -- ALL THAT'7S NEEDED
 
 GEC1.3   BSS    0           800-SERIES MAINFRAME 
          SRD    D.RSAV      SAVE CALLING CP'7S *R* 
          LRD    CM+2        SET *R* TO MASTOR(N)'7S RA 
          LDD    RA          4000B ON AN 800 SERIES 
 
 .NOSV2   ENDIF 
 
 GEC1.4   BSS    0           ENTER WITH (A) = RA/100B 
          SHN    6
          ADN    MS.CHKS
          CRM    CHKS,TR     READ EXTENDED MEMORY POINTERS
          LRD    D.RSAV      RESTORE CALLING CP'7S *R*
 
          LDM    ECSP        (A) = 3/MFORD, 9/WHO CARES 
          SHN    -9D         (A) = MFORD (MAINFRAME ORDINAL)
          STM    MFN
          RJM    VEP         VERIFY EXTENDED MEMORY POINTERS
          LDM    ECSP        (A) = VARIOUS BIT FLAGS
          LPN    1           (A) = ECS / ESM MODE 
          LJM    GECX 
 
 GEC2     SOD    T1 
          NJP    GEC1        IF MORE CONTROL POINTS TO SCAN 
 
*         MASTOR NOT FOUND
 
          CALL   DFM,IMSG3   *MASTOR NOT ACTIVE*
          LJM    DROP 
* 
* 
 IMSG1    DIS    ,*(PIO)  DDP RESERVED* 
 IMSG2    DIS    ,*(PIO)  CIU RESERVED* 
 IMSG3    DIS    ,*(PIO)  MASTOR NOT ACTIVE*
* 
 IPSTAT   TABLE  CM 
 
 QUAL$    EQU    *           SO NO /COMPVEP/ SYMBOLS
* 
*CALL PLAPVEP 
 
**        CELLS NEEDED TO READ AND VERIFY THE EXTENDED
*         MEMORY PARAMETERS. THE FIRST 15 WORDS (CHKS - PNW)
*         MUST BE CONTIGUOUS. 
 
 CHKS     BSS    5           CHECKSUM FOR POINTERS
 ECSP     BSS    1           VARIOUS BIT FLAGS
 MRAX     BSS    2           MASTOR RAX 
 MFLX     BSS    2           MASTOR FLX 
 PNW      BSS    5           PROGRAM NAME AND NO. OF ARGS 
 
 MASNAM   DATA   6LMASTOR 
 MFN      BSS    1           MASTOR MAINFRAME NUMBER
 MASCPA   BSS    1           FWA OF MASTOR-S CP AREA
* 
*CALL     PLAPABS 
*CALL     PLAPEQN 
* 
*         CHECK LENGTH OF PPU PROGRAM 
* 
          QUAL   *
* 
*         CHECK IF LITERALS OVERLAP BUFFERS 
* 
          ERRNG  *-ITEST+1   LITERALS OVERLAP BUFFERS 
          USE    LITERALS    FORCE OUT LITERALS BEFORE TEST 
          ERRPL  *-7770B     FORCE ERROR IF PPU OVERFLOW
 
          END