Retro1.org codex

EMDMP 
* /---   FILE TYPE = E
* /---   BLOCK      INTRO      00 000   82/09/30  08.35 
          IDENT  EMDMP,111B,EMDMP 
          TITLE  EMDMP - CONTROL POINT EM DUMP (PLATO). 
* 
* 
* 
*         DUMPS EXTENDED MEMORY 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.  THE CALLING JOB MUST
*         ALREADY HAVE AN EM FIELD LENGTH SET, EMDMP DOES 
*         NOT REQUEST ANY EM 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.
* 
* 
* 
*         EMDMP(FILE,FFFF,LLLL) 
* 
*         FILE = FILE NAME TO RECEIVE DUMP (ASSUMES *EMFILE*) 
*         FFFF = FIRST WORD TO DUMP/1000B (IN OCTAL)
*         LLLL = LAST WORD OF TO DUMP/1000B (IN OCTAL)
* 
* 
* 
* 
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1982.
*COMMENT EMDMP - CONTROL POINT EM DUMP (PLATO). 
* 
          ABS 
          SST 
          SYSCOM B1 
*CALL     COMCMAC 
* 
 BUFL     EQU    1001B       CIO BUFFER LENGTH
* /---   BLOCK      MAIN       00 000   82/09/30  08.40 
          TITLE  MAIN LOOP
          ORG    111B 
* 
 EMDMP    RJ     PRS
          SA1    ECSL        CHECK FOR NOTHING TO DO
          ZR     X1,ECDONE
          NG     X1,ECDONE
          OPEN   EMFILE,WRITE,R 
          RECALL EMFILE 
          REWIND EMFILE,R 
          RECALL EMFILE 
* 
*         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    EMFILE+2 
          SX6    BUFF        SET OUT POINTER
          SA6    A6+B1
          WRITER EMFILE,R    WRITE HEADER 
          RECALL EMFILE 
* 
*         SET ERROR EXIT ADDRESS TO ALLOW ORDERLY EXIT
* 
          EREXIT ECDONE 
* 
*         SET UP FOR EM DUMP
* 
          SA0    BUFF        CM ADDRESS 
          SA1    ECSF        SET BEGINNING EM 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    EMFILE+2 
          SX6    BUFF 
          SA6    A6+B1
          WRITER EMFILE,R    TRANSFER DATA
          RECALL EMFILE 
          SX1    BUFL-1      INCREMENT EM 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 EMFILE,R    TACK ON AN EOF 
          RECALL EMFILE 
          ENDRUN             QUIT 
* 
* 
 MSG      CON    10LDUMPING - 
          BSS    1
          CON    0
* /---   BLOCK      ECSERR     00 000   82/09/30  08.41 
          TITLE  ECSERR -- REPORT EM ERRORS 
**
*         ECSERR - REPORT EM ERRORS 
* 
*         ON ENTRY - X0 = ADDRESS OF EM 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,(EMDMP) ECS ERROR -
 ADDR     BSS    1
          CON    0
* 
 DUMMY    DIS    ,/*** ECS ERROR ***/ 
* 
* /---   BLOCK      COD        00 000   82/09/30  08.41 
 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
* /---   BLOCK      MISC       00 000   82/09/30  08.43 
          TITLE  COMMON DECKS / FETS / ETC. 
*CALL     COMCCPM 
*CALL     COMCCIO 
*CALL     COMCSYS 
          SPACE  4
 ECSF     BSS    1           FIRST WORD TO DUMP/1000B 
 ECSL     BSS    1           ECS DUMP LENGTH/1000B
* 
* 
*         FET AND BUFFER
* 
 EMFILE   FILEB  BUFF,BUFL
* 
* 
 BUFF     EQU    *
* 
* 
 RFL=     EQU    BUFF+BUFL+2
* /---   BLOCK      PRS        00 000   82/09/30  08.47 
          TITLE  PRESET 
* 
*         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 *EMFILE*
          SX7    B1 
          BX6    X6+X7
          SA6    EMFILE 
* 
*         CONVERT EM FWA TO OCTAL 
* 
 INIT1    MX0    -6 
          MX6    0           CLEAR NUMBER BUILDING
          SA1    ARGR+1      LOAD EM FWA
          ZR     X1,W10 
          BX2    -X0*X1      CHECK FOR LEGAL ARGUMENT 
          NZ     X2,W10 
          RJ     ATOO 
* 
 W10      SA6    ECSF 
* 
*         CONVERT EM LWA TO OCTAL 
* 
          MX0    -6 
          MX6    0           CLEAR NUMBER BUILDING
          SA1    ARGR+2      LOAD EM LWA
          ZR     X1,W100
          BX2    -X0*X1      CHECK FOR LEGAL ARGUMENT 
          NZ     X2,W100
          RJ     ATOO 
* 
 W100     SA1    ECSF        CHANGE TO EM 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 
          SPACE  3
          END