Retro1.org codex

ECDMP 
          IDENT  ECDMP,111B,ECDMP 
          TITLE  ECDMP - ECS DUMPER FOR PLATO.
* 
* 
* 
*         DUMPS CONTENTS OF GIVEN ECS LOCATIONS INTO FILE 
*         NAMED IN FIRST ARGUMENT.  FILE IS WRITTEN AS A
*         SERIES OF 1000B (512) WORD RECORDS AND IS ENDED 
*         WITH AN END-OF-FILE.  JOB CALLING ECDMP MUST
*         ALREADY HAVE AN ECS FIELD LENGTH SET, ECDMP DOES
*         NOT REQUEST ANY ECS OF ITS OWN. 
* 
*         THE FIRST RECORD OF EVERY DUMP IS A HEADER RECORD 
*         CONTAINING THE NAME OF THE JOB WHICH DID THE DUMP 
*         AND THE DATE AND TIME OF THE DUMP.
* 
* 
* 
*         ECDMP(FILE,FFFF,LLLL) 
* 
*         FILE = FILE NAME TO RECEIVE DUMP (ASSUMES *ECFILE*) 
*         FFFF = FIRST WORD OF ECS TO DUMP/1000B (IN OCTAL) 
*         LLLL = LAST WORD OF ECS TO DUMP/1000B (IN OCTAL)
* 
* 
* 
* 
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1978.
*COMMENT ECDMP - ECS DUMPER FOR PLATO.
* 
          ABS 
          SST 
          SYSCOM B1 
*CALL     COMCMAC 
* 
 BUFL     EQU    1001B       CIO BUFFER LENGTH
          TITLE  MAIN LOOP
          ORG    111B 
* 
 ECDMP    RJ     PRS
          SA1    ECSL        CHECK FOR NOTHING TO DO
          ZR     X1,ECDONE
          NG     X1,ECDONE
          OPEN   ECFILE,WRITE,R 
          RECALL ECFILE 
          REWIND ECFILE,R 
          RECALL ECFILE 
* 
*         WRITE HEADER RECORD 
* 
          GETJN  BUFF        SET JOB NAME IN HEADER 
          DATE   BUFF+1      SET DATE IN HEADER 
          CLOCK  BUFF+2      SET TIME IN HEADER 
          SX6    BUFF+3      SET IN POINTER 
          SA6    ECFILE+2 
          SX6    BUFF        SET OUT POINTER
          SA6    A6+B1
          WRITER ECFILE,R    WRITE HEADER 
          RECALL ECFILE 
* 
*         SET ERROR EXIT ADDRESS TO ALLOW ORDERLY EXIT
* 
          EREXIT ECDONE 
* 
*         SET UP FOR ECS DUMP 
* 
          SA0    BUFF        CM ADDRESS 
          SA1    ECSF        SET BEGINNING ECS ADDRESS
          LX1    9
          BX0    X1 
* 
 ECLOOP   BX1    X0          ISSUE MESSAGE
          RJ     COD
          SA6    MSG+1
          MESSAGE  MSG,1,R
          RE     BUFL-1      READ WORDS INTO BUFFER 
-         RJ     ECSERR 
          SX6    BUFF+BUFL-1  RESET CIO POINTERS FOR TRANSFR
          SA6    ECFILE+2 
          SX6    BUFF 
          SA6    A6+B1
          WRITER ECFILE,R    TRANSFER DATA
          RECALL ECFILE 
          SX1    BUFL-1      INCREMENT ECS ADDRESS
          IX0    X0+X1
          SA2    ECSL        DECREMENT LENGTH TO READ 
          AX1    9
          IX6    X2-X1
          ZR     X6,ECDONE   IF ALL DUMPED
          NG     X6,ECDONE   IF ALL DUMPED
          SA6    A2 
          EQ     ECLOOP 
* 
 ECDONE   BSS    0
          WRITEF ECFILE,R    TACK ON AN EOF 
          RECALL ECFILE 
          ENDRUN             QUIT 
* 
* 
 MSG      CON    10LDUMPING - 
          BSS    1
          CON    0
          TITLE  ECSERR -- REPORT ECS ERRORS
**
*         ECSERR - REPORT ECS ERRORS
* 
*         ON ENTRY - X0 = ADDRESS OF ECS READ 
* 
*         ISSUES ERROR MESSAGE
* 
* 
 ECSERR   EQ     *+400000B
          BX1    X0          CONVERT ADDRESS TO DISPLAY CODE
          RJ     COD
          SA6    ADDR 
          MESSAGE  ERR,0,R
          SX1    BUFL-1      DUMMY UP A RECORD
          AX1    1           DIVIDE BY TWO
          SB2    X1 
          SA1    DUMMY
          SA2    A1+B1
          BX6    X1 
          BX7    X2 
          SA6    BUFF 
          SA7    A6+B1
* 
 ECSERR1  SB2    B2-B1
          ZR     B2,ECSERR   IF DONE
          NG     B2,ECSERR   IF OVER-DONE 
          SA6    A6+2 
          SA7    A6+B1
          EQ     ECSERR1
* 
* 
 ERR      DIS    2,(ECDMP) ECS ERROR -
 ADDR     BSS    1
          CON    0
* 
 DUMMY    DIS    ,/*** ECS ERROR ***/ 
* 
 COD      TITLE  CONVERSION ROUTINES
**
*         COD - CONSTANT TO OCTAL DISPLAY CODE CONVERSION 
* 
*         CONVERT 10 OCTAL DIGITS TO DISPLAY CODE WITHOUT 
*         LEADING ZERO SUPPRESSION
* 
*         MODIFICATION OF KRONOS COMMON DECK COMCCOD
* 
*         ENTRY  X1=NUMBER TO CONVERT 
* 
*         EXIT   X6=DPC CONVERSION
* 
*         USES - A - NONE 
*                X - 1,2,3,4,6
*                B - 3
* 
*         CALLS  NONE 
* 
* 
 COD      EQ     *+400000B
          SB3    10          CONVERT 10 DIGITS
          MX2    -3          DIGIT MASK 
          MX6    0
          SX3    1R0         CONVERSION CONSTANT
* 
 COD1     BX4    -X2*X1      GET DIGIT
          IX4    X4+X3       CONVERT
          LX4    -6 
          LX6    -6 
          BX6    X6+X4       INSERT CHAR
          SB3    B3-B1
          EQ     B3,B0,COD   JUMP IF 10 DIGITS
          AX1    3           GO TO NEXT DIGIT 
          EQ     COD1        LOOP TILL 10 DIGITS
* 
* 
* 
* 
*CALL     COMCCPM 
*CALL     COMCCIO 
*CALL     COMCSYS 
* 
* 
* 
 ECSF     BSS    1           FIRST WORD TO DUMP/1000B 
 ECSL     BSS    1           ECS DUMP LENGTH/1000B
* 
* 
*         FET AND BUFFER
* 
 ECFILE   FILEB  BUFF,BUFL
* 
* 
 BUFF     EQU    *
* 
* 
 RFL=     EQU    BUFF+BUFL+2
* 
*         INITIALIZATIONS GO INTO CIO BUFFER
* 
 PRS      EQ     *+400000B
          SB1    1
* 
*         SET OUTPUT FILE NAME
* 
          SA1    ARGR        SET FILE NAME
          MX6    42 
          BX6    X6*X1
          ZR     X6,INIT1    IF NONE, USE *ECFILE*
          SX7    B1 
          BX6    X6+X7
          SA6    ECFILE 
* 
*         CONVERT ECS FWA TO OCTAL
* 
 INIT1    MX0    -6 
          MX6    0           CLEAR NUMBER BUILDING
          SA1    ARGR+1      LOAD ECS FWA 
          ZR     X1,W10 
          BX2    -X0*X1      CHECK FOR LEGAL ARGUMENT 
          NZ     X2,W10 
          RJ     ATOO 
* 
 W10      SA6    ECSF 
* 
*         CONVERT ECS LWA TO OCTAL
* 
          MX0    -6 
          MX6    0           CLEAR NUMBER BUILDING
          SA1    ARGR+2      LOAD ECS LWA 
          ZR     X1,W100
          BX2    -X0*X1      CHECK FOR LEGAL ARGUMENT 
          NZ     X2,W100
          RJ     ATOO 
* 
 W100     SA1    ECSF        CHANGE TO ECS LENGTH TO DUMP 
          IX6    X6-X1
          SA6    ECSL 
          EQ     PRS
* 
* 
* 
 ATOO     EQ     *
          LX1    6           POSITION NEXT CHARACTER
          BX2    -X0*X1 
          ZR     X2,ATOO     EXIT IF END
          SX2    X2-1R0      CONVERT TO OCTAL 
          LX6    3
          IX6    X2+X6       ADD TO NUMBER BUILDING 
          EQ     ATOO+1 
* 
* 
* 
* 
* 
          END