Retro1.org codex

EFRDMP
* /---   FILE TYPE = E
* /---   BLOCK      IDENT      00 000   81/07/12  02.13 
 
          IDENT  EFRDMP,111B,EFRDMP 
 
          ABS 
          SST 
          SYSCOM B1 
 
          ENTRY  EFRDMP 
          ENTRY  RFL= 
 
*COMMENT  EFRDMP - DUMP EXTENDED ESM FLAG REGISTERS.
          COMMENT COPYRIGHT CONTROL DATA CORP. 1981.
 
          TITLE  EFRDMP - DUMP EXTENDED ESM FLAG REGISTERS. 
 
* /---   BLOCK      DOCUMENT   00 000   81/07/12  02.44 
 
 EFRDMP   SPACE  4,10 
***       EFRDMP - DUMP EXTENDED ESM FLAG REGISTERS.
*         M. S. VOLLMER      81/07/13.
          SPACE  4,10 
***       EFRDMP PROVIDES A LABELED DUMP OF THE EXTENDED
*         ESM FLAG REGISTERS USED BY MULTI-EXECUTOR/MULTI-
*         FORMATTER PLATO SYSTEMS.
          SPACE  4,10 
***       CONTROL CARD CALL.
* 
*         EITHER ZERO OR TWO ARGUMENTS MAY BE PRESENT.
* 
*         IF NO ARGUMENTS ARE PRESENT, THE BASE FLAG
*         REGISTER NUMBER (*EFRB* IN THE PLATO CONFIG FILE) 
*         AND THE NUMBER OF PLATO STATIONS (*NUMSTAT* IN
*         PLATO) ARE ASSUMBED TO BE IN KCL R2 AND R3, 
*         RESPECTIVELY. 
* 
*         IF TWO ARGUMENTS ARE PRESENT, THE FIRST SPECIFIES 
*         THE BASE FLAG REGISTER NUMBER AND THE SECOND THE
*         NUMBER OF PLATO STATIONS.  THE ARGUMENTS ARE
*         ALWAYS POSITIONAL, NOT KEYWORD-ORIENTED.
* 
*         EXAMPLES -- 
* 
*         EFRDMP.            USE KCL R2 AS BASE AND R3 AS 
*                            NUMBER OF PLATO STATIONS.
*         EFRDMP(100B,640)   START WITH REGISTER 100B.  USE 
*                            640 AS THE NUMBER OF PLATO 
*                            STATIONS.
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         * ARGUMENT ERROR.* - AN INCORRECT NUMBER OF 
*         ARGUMENTS WERE SPECIFIED ON THE CONTROL CARD, OR
*         AN ARGUMENT COULD NOT BE CONVERTED TO A BINARY
*         INTEGER BY *DXB*, OR THE NUMBER OF PLATO STATIONS 
*         IS NOT DIVISIBLE BY 32, OR ONE OF THE PARAMETERS
*         IS NEGATIVE OR INCONSISTENT.  THE PROGRAM IS
*         ABORTED.
* 
*         * BAD FLAG REGISTER NUMBER.* - THE PROGRAM
*         ATTEMPTED TO DUMP A REGISTER NOT IN THE RANGE 
*         0 .LE. REGISTER .LE. 16383.  THE PROGRAM IS 
*         ABORTED.
* 
*         * MACHINE NOT IN ESM MODE.* - THE MACHINE HAS NO
*         EXTENDED MEMORY, HAS ECS, OR HAS ESM IN ECS MODE. 
*         EXECUTION OF EFRDMP ENDS NORMALLY WITHOUT DUMPING 
*         ANY EXTENDED FLAG REGISTERS.
* 
*         * NO MATCH FOR REGISTER.* - AN ABORT WAS RETURNED 
*         FOR ALL POSSIBLE CONTENTS OF AN EXTENDED ESM FLAG 
*         REGISTER.  THIS COULD BE DUE TO HARDWARE ERROR OR 
*         BECAUSE ANOTHER PROGRAM WAS CHANGING THE CONTENTS 
*         OF THE REGISTER AT THE SAME TIME.  THE CONTENTS OF
*         OF THE REGISTER WILL BE SHOWN AS *ERROR.* IN THE
*         OUTPUT. 
 
****      COMMON DECKS (NOS MACROS) 
 
*CALL     COMCMAC 
*CALL     COMCCMD 
 
****
 
          ORG    111B 
 
* /---   BLOCK      EFRDMP     00 000   81/07/12  03.55 
 EFRDMP   SPACE  4,21 
**        EFRDMP - EXTENDED FLAG REGISTER DUMP
* 
*         DUMP EXTENDED ESM FLAG REGISTERS USED BY PLATO
*         AND BY FRAMAT/FORMAT IF A MACHINE IS IN ESM 
*         MODE AND IS CONFIGURED FOR MULTIPLE EXECUTORS 
*         AND/OR FOR MULTIPLE FORMATTERS. 
* 
*         ENTRY  BASE REGISTER AND NUMBER OF PLATO STATIONS 
*                PASSED AS CONTROL CARD ARGUMENTS OR IN 
*                KCL R2 AND R3. 
* 
*         EXIT   PLATO/FORMAT FLAG REGISTERS DUMPED.
*                PROGRAM TERMINATED NORMALLY. 
* 
*         USES   A - NONE.
*                B - 1. 
*                X - 6. 
* 
*         CALLS  CMM, GPM, PER, SYS=. 
* 
*         MACROS ENDRUN.
 
 
 EFRDMP   SB1    1           (B1) = 1 
 
          RJ     CMM         CHECK MEMORY MODE
          RJ     GPM         GET PARAMETERS 
          RJ     PER         PRINT EXTENDED REGISTERS 
 
          ENDRUN
 
* /---   BLOCK      CMM        00 000   81/07/12  02.35 
 CMM      SPACE  4,15 
**        CMM - CHECK MEMORY MODE 
* 
*         SEE IF MACHINE IS IN ESM MODE.
* 
*         ENTRY  NONE.
* 
*         EXIT   PROGRAM ENDED IF IN ECS MODE.
* 
*         USES   A - 1. 
*                B - NONE.
*                X - 1, 2.
* 
*         CALLS  CVL=, MSG=, SYS=.
* 
*         MACROS ENDRUN, GETMC, MESSAGE.
 
 CMM      PS
          GETMC  CMMA 
          SA1    CMMA 
          LX1    59-ESMM     TEST FOR ESM MODE
          NG     X1,CMM      IF IN ESM MODE 
          MESSAGE CMMB,0,R
          ENDRUN
 
 CMMA     BSS    1
 CMMB     DIS    ,* MACHINE NOT IN ESM MODE.* 
 
* /---   BLOCK      EFR        00 000   81/07/13  13.35 
 EFR      SPACE  4,18 
**        EFR - EVALUATE FLAG REGISTER
* 
*         RETURN THE CONTENTS OF AN EXTENDED FLAG REGISTER
* 
*         ENTRY  (X1) = RELATIVE REGISTER NUMBER. 
*                (BASE) = EXTENDED FLAG REGISTER BASE.
* 
*         EXIT   (X6) = RIGHT-JUSTFIED ALPHA REGISTER VALUE.
*                (X6) = 6LERROR. IF NO MATCH. 
*                PROGRAM ABORTED IF REGISTER .GT. 16383.
* 
*         USES   A - 0, 1, 2. 
*                B - 2, 7.
*                X - 0, 1, 2, 3, 6. 
* 
*         CALLS  COD, MSG=, SYS=. 
* 
*         MACROS ABORT, MESSAGE.
 
 
 EFR      PS
          SA2    BASE        (X2) = BASE REGISTER NUMBER
          IX2    X1+X2       (X2) = ABSOLUTE REGISTER NUMBER
          SX2    X2          LIMIT TO 18 BITS 
          NG     X2,EFR3     ERROR IF .LT. 0
          SX1    X2-EFRMAX-1  CHECK IF .GT. 16383 
          PL     X1,EFR3     IF REGISTER NUMBER TOO LARGE 
          LX2    4           POSITION REGISTER IN BITS 4-17 
          SX3    ESEES
          LX3    GFRSC       (X3) = EQUALITY/STATUS FUNCTION
          BX2    X2+X3       (X2) = REGISTER AND FUNCTION 
          SA1    EFRA-1      PRESET ADDRESS OF TABLE
          SA0    EFRB        (A0) = SOMETHING REASONABLE
 
 EFR1     SA1    A1+B1       (X1) = NEXT PATTERN
          BX0    X1+X2       (X0) = ASSEMBLED FLAG FUNCTION 
+         RE     1
-         EQ     EFR2        IF REJECT TRY NEXT PATTERN 
          SB7    0           DEFAULT TO OCTAL BASE
          RJ     COD         CONVERT RESULT TO DISPLAY CODE 
          EQ     EFR
 
 EFR2     NZ     X1,EFR1     IF NOT END OF TABLE
          MESSAGE EFRC,0,R   ISSUE ERROR MESSAGE TO DAYFILE 
          SA1    EFRD 
          BX6    X1          (X6) = 6LERROR.
          EQ     EFR
 
 EFR3     MESSAGE EFRE,0,R   SEND ERROR MESSAGE TO DAYFILE
          ABORT              DIE
 
 EFRA     CON    15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0
 EFRB     BSS    1
 EFRC     DIS    ,* NO MATCH FOR REGISTER.* 
 EFRD     DATA   6LERROR. 
 EFRE     DIS    ,* BAD FLAG REGISTER NUMBER.*
 
* /---   BLOCK      GPM        00 000   81/07/13  00.54 
 GPM      SPACE  4,20 
**        GPM - GET PARAMETERS
* 
*         DETERMINE (1) BASE REGISTER AT WHICH TO START 
*         DUMPING THE EXTENDED FLAG REGISTERS AND (2) THE 
*         NUMBER OF PLATO STATIONS. 
* 
*         ENTRY  VALUES PASSED VIA CONTROL CARD ARGUMENTS OR
*                KCL R2 AND R3. 
* 
*         EXIT   (BASE) = NUMBER OF BASE REGISTER.
*                (NUMSTAT) = NUMBER OF PLATO STATIONS.
*                PROGRAM ABORTED IF ARGUMENT ERROR. 
* 
*         USES   A - 1, 2, 5, 6, 7. 
*                B - 7. 
*                X - 1, 2, 5, 6, 7. 
* 
*         CALLS  CPM=, DXB, MSG=, SYS=. 
* 
*         MACROS ABORT, GETJCI, MESSAGE.
 
 
 GPM      PS
          SA1    ACTR        (X1) = 42/PROGRAM, 18/ARGUMENTS
          SX1    X1          (X1) = NUMBER OF ARGUMENTS 
          ZR     X1,GPM1     IF VALUES IN KCL R2 AND R3 
          SX1    X1-2        CHECK FOR 2 ARGUMENTS
          ZR     X1,GPM2     IF ARGUMENTS PRESENT 
          EQ     GPM4        IF BAD NUMBER OF ARGUMENTS 
 
*         IF NO ARGUMENTS WERE PRESENT, GET THE BASE
*         REGISTER NUMBER FROM KCL R2 AND THE NUMBER OF 
*         PLATO STATIONS FROM KCL R3. 
 
 GPM1     GETJCI GPMA        GET JOB CONTROL INFORMATION
          SA1    GPMA+1      (X1) = 6/EF,18/R3,18/R2,18/R1
          AX1    18 
          SX6    X1          (X6) = BASE REGISTER 
          AX1    18 
          SX7    X1          (X7) = NUMBER OF PLATO STATIONS
          SA6    BASE 
          SA7    NUMSTAT
          EQ     GPM3 
 
*         IF ARGUMENTS ARE PRESENT, USE THEM AS THE BASE
*         REGISTER NUMBER AND THE NUMBER OF PLATO STATIONS. 
 
 GPM2     SA5    ARGR        (X5) = 1ST ARGUMENT
          SB7    B1+         DEFAULT TO DECIMAL BASE
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,GPM4     IF BAD ARGUMENT
          SA6    BASE        SAVE BASE REGISTER NUMBER
          SA5    ARGR+B1     (X5) = 2ND ARGUMENT
          SB7    B1+         DEFAULT TO OCTAL BASE
          RJ     DXB         CONVERT TO BINARY
          NZ     X4,GPM4     IF BAD ARGUMENT
          SA6    NUMSTAT     SAVE NUMBER OF PLATO STATIONS
* /---   BLOCK      GPM        00 000   81/07/13  02.52 
 
*         CHECK FOR CORRECTNESS AND CONSISTENCY OF THE
*         ARGUMENTS.
 
 GPM3     SA1    BASE        (X1) = BASE FLAG REGISTER
          SA2    NUMSTAT     (X2) = NUMBER OF PLATO STATIONS
          NG     X1,GPM4     ERROR IF NEGATIVE BASE 
          NG     X2,GPM4     ERROR IF NEGATIVE STATIONS 
          ZR     X2,GPM4     ERROR IF ZERO STATIONS 
          MX6    -5 
          BX6    -X6*X2      ZERO IF DIVISIBLE BY 32
          NZ     X6,GPM4     ERROR IF MOD(NUMSTAT,32) .NE. 0
          SX6    X2 
          AX6    5           (X6) = NUMBER OF SITES 
          SX6    X6-MXSITES-1 
          PL     X6,GPM4     IF TOO MANY SITES
          SX6    I.NUM+FI.NUM-1 
          IX6    X1+X6
          IX6    X2+X6       (X6) = LAST REGISTER USED
          SX1    EFRMAX      (X1) = MAX. REAL FLAG REGISTER 
          IX1    X1-X6
          PL     X1,GPM      EXIT IF REGISTERS IN RANGE 
 
*         IF THE NUMBER OF ARGUMENTS WAS INCORRECT OR IF
*         THE ARGUMENTS WERE OTHERWISE INCORRECT OR INCON-
*         SISTENT, ISSUE AN ERROR MESSAGE AND ABORT.
 
 GPM4     MESSAGE GPMB,0,R   ISSUE ERROR MESSAGE
          ABORT              LUNCH BREAK
 
 GPMA     BSS    2           JOB CONTROL INFORMATION
 GPMB     DIS    ,* ARGUMENT ERROR.*
 
* /---   BLOCK      PER        00 000   81/07/13  02.00 
 PER      SPACE  4,16 
**        PER - PRINT EXTENDED REGISTERS
* 
*         PRINT THE EXTENDED FLAG REGISTERS USED BY PLATO 
*         AND BY FRAMAT/FORMAT. 
* 
*         ENTRY  (BASE) = BASE REGISTER NUMBER. 
* 
*         EXIT   FLAG REGISTERS PRINTED.
* 
*         USES   A - 1, 2, 6. 
*                B - 2, 6.
*                X - 1, 2, 6, 7.
* 
*         CALLS  CDD, CIO=, COD, EFR, WTC=. 
* 
*         MACROS CLOSE, OPEN, WRITEC, WRITER. 
 
 
 PER      PS
 
*         OPEN PRINT FILE AND WRITE HEADER. 
 
          OPEN   OUTPUT,WRITENR,R  OPEN OUTPUT FILE 
          WRITEC OUTPUT,PERA  PRINT HEADER
          SA1    BASE        (X1) = BASE FLAG REGISTER
          RJ     COD         CONVERT TO OCTAL DISPLAY CODE
          SA6    PERB+2 
          WRITEC OUTPUT,PERB  PRINT BASE REGISTER NUMBER
          WRITEC OUTPUT,PERC  SKIP A LINE 
 
*         PRINT PROCESS INTERLOCKS. 
 
 PER1     SA1    PERD        (X1) = INDEX INTO *EFRTAB* 
          SA2    X1+EFRTAB   (X2) = NEXT TABLE ENTRY
          NG     X2,PER3     IF END OF TABLE
          SX6    X1+B1       UPDATE INDEX 
          SA6    A1 
          ZR     X2,PER2     IF SHOULD SKIP A LINE
          MX3    -18
          BX1    -X3*X2      (X1) = RELATIVE REGISTER NUMBER
          BX3    X3*X2       (X3) = ALPHA DESCRIPTION 
          SA2    PERE        (X2) = 3R =
          BX6    X3+X2
          SA6    PERF+1      STORE ALPHA DESCRIPTION IN LINE
          RJ     EFR         EVALUATE FLAG REGISTER 
          SA6    PERF+2 
          WRITEC OUTPUT,PERF  WRITE LABEL AND REGISTER VALUE
          EQ     PER1 
 
 PER2     WRITEC OUTPUT,PERC  SKIP A LINE 
          EQ     PER1 
 
* /---   BLOCK      PER        00 000   81/07/13  02.40 
 
*         PRINT STATION INTERLOCKS. 
 
 PER3     WRITEC OUTPUT,PERG  WRITE PAGE HEADER 
          WRITEC OUTPUT,PERC  SKIP A LINE 
          SA1    BASE        (X1) = BASE FLAG REGISTER
          SX6    X1+I.NUM+FI.NUM  ADJUST FOR STATION INTLOKS
          SA6    A1 
 
 PER4     SA1    PERI        (X1) = LAST STATION NUMBER 
          SX6    X1+1        (X6) = NEXT STATION NUMBER 
          SA2    NUMSTAT     (X2) = NUMBER OF STATIONS
          IX2    X6-X2
          PL     X2,PER5     IF ALL STATIONS FINISHED 
          SA6    A1          SAVE CURRENT STATION NUMBER
          SX1    X6+
          AX1    5           (X1) = SITE NUMBER 
          RJ     CDD         CONVERT TO DECIMAL 
          MX4    -12
          BX6    -X4*X6      SAVE BOTTOM TWO DIGITS 
          LX6    48          (X6) = LEFT-JUSTIFIED SITE NO. 
          SA6    PERJ 
          SA1    PERI        (X1) = BINARY STATION NUMBER 
          MX6    -5 
          BX1    -X6*X1      (X6) = STATION PORTION 
          RJ     CDD         CONVERT TO DECIMAL 
          MX4    -12
          BX6    -X4*X6      SAVE TWO DIGITS OF STATION NO. 
          SX4    1R-
          LX6    30          POSITION STATION NUMBER
          LX4    42          POSITION HYPHEN
          SA1    PERJ        (X1) = LEFT-JUSTIFIED SITE NO. 
          BX6    X6+X1
          BX6    X6+X4       (X6) = SITE-STATION
          SA1    PERK        (X1) = 5R   =
          BX6    X1+X6
          SA6    PERF+1 
          SA1    PERI        (X1) = BINARY STATION NUMBER 
          RJ     EFR         EVALUATE FLAG REGISTER 
          SA6    PERF+2 
          WRITEC OUTPUT,PERF
          EQ     PER4        PROCESS NEXT STATION 
 
 PER5     WRITEC OUTPUT,PERL  PAGE EJECT
          WRITER OUTPUT,RECALL
          CLOSE  OUTPUT,NR,RECALL 
          EQ     PER
 
 PERA     DIS    ,*1EXTENDED FLAG REGISTER DUMP.* 
 PERB     DATA   20H0   BASE REGISTER = 
          BSS    1
          DATA   1LB
 PERC     DATA   1L          FOR BLANK LINES
 PERD     DATA   0           INDEX INTO *EFRTAB*
 PERE     DATA   3R = 
 PERF     DATA   10H
          BSS    1           ALPHA DESCRIPTION
          BSS    1           OCTAL CONTENTS OF REGISTER 
          DATA   1LB
 PERG     DIS    ,*1STATION INTERLOCKS.*
 PERI     DATA   -1          BINARY STATION NUMBER
 PERJ     BSS    1           ALPHA STATION NUMBER (XX-YY) 
 PERK     DATA   5R   = 
 PERL     DATA   1L1         PAGE EJECT 
 
* /---   BLOCK      END        00 000   81/07/13  02.52 
 
****      COMMON DECKS (NOS)
 
 QUAL$    EQU    0
 
          LIST   -X 
 
*CALL COMCSYS 
*CALL COMCCPM 
*CALL COMCCVL 
*CALL COMCDXB 
*CALL COMCCOD 
*CALL COMCCDD 
*CALL COMCWTC 
*CALL COMCWTW 
*CALL COMCCIO 
 
          LIST   *
 
****
****      COMMON DECKS (PLATO)
 
 
*CALL SYSCON
*CALL EXTEXT
*CALL     PLASRWX 
 
 
****
 
          LIST   D
 
 EFRTAB   BSS    0
 INTTAB$  HERE               INSERT INTERLOCK TABLE 
 
          LIST   *
 
 BASE     BSS    1           EXTENDED REGISTER BASE 
 NUMSTAT  BSS    1           NUMBER OF PLATO STATIONS 
 
 EFRMAX   EQU    16383       MAXIMUM FLAG REGISTER NUMBER 
 
 CIOLTH   EQU    401B 
 OUTPUT   FILEB  CIOBUF,CIOLTH,FET=14B
 CIOBUF   BSS    CIOLTH 
 
 RFL=     EQU    *+1
 
          END