Retro1.org codex

COPYPF
* /---   FILE TYPE = E
* /---   BLOCK      COPYPFX    00 000   81/04/29  11.32 
COPYPF
          IDENT  COPYPF,BEGIN,COPYPF
          ENTRY  COPYPF 
          SYSCOM B1          DEFINE (B1) = 1
*COMMENT  COPY PLATO FILES FROM DUMPS 
          COMMENT COPYRIGHT CONTROL DATA CORP. 1980.
          TITLE  COPY PLATO FILES FROM DUMPS
          SPACE  4
***       COPY PLATO FILES FROM DUMPS 
*         J. J. BUCHMANN.  80/06/17.
* 
*FUNCTION;
*     THIS PROGRAM HAS TWO MODES OF OPERATION, SINGLE PLATO 
*     FILE RECOVERY, AND MASTERFILE RECOVERY MODE.  THE MODE
*     OF OPERATION DEPENDS ON THE *FF* PARAMETER ON THE 
*     CONTROL CARD.  IF *FF* IS PRESENT, THEN SINGLE FILE 
*     MODE IS SELECTED, IF NOT PRESENT, THEN MASTERFILE MODE
*     IS SELECTED.
* 
*     IN SINGLE FILE MODE, ALL THE PARAMETERS MUST BE 
*     SPECIFIED ON THE CONTROL CARD; PLATO MUST BE UP; AND A
*     PLATO FILE CREATED (*TF* PARAMETER) OF TYPE BACKUP, 
*     RESIDING IN THE SAME ACCOUNT AS THE ORIGINAL FILE, AND
*     OF THE SAME SIZE.  THE COPYPF PROGRAM WILL REQUEST THE
*     TAPE/DISK (E,P DISPLAY IF THE V=VSN PARAMETER IS
*     SPECIFIED).  THE TAPE/DISK WILL BE SCANNED FOR THE
*     REQUESTED FILE, AND THE FILE WILL BE RESTORED IF ALL
*     CONDITIONS FOR FILE TYEP, ACCOUNT, AND SIZE ARE MET.
* 
*     IN MASTERFILE MODE, THE PARAMETERS MAY BE PASSED ON 
*     THE CONTROL CARD OR VIA THE K-DISPLAY.  WHEN THE
*     PROPER MASTERFILES HAVE BEEN SELECTED FOR RECOVERY, 
*     THEN A K.GO WILL START THE PROCESS.  ALL MASTERFILES
*     THAT ARE TO BE RECOVERED MUST HAVE BEEN ATTACHED TO 
*     THE CONTROL POINT PRIOR TO THE RECOVERY ATTEMPT.  THE 
*     PROGRAM WILL REQUEST TAPES/PACKS VIA THE E,P DISPLAY. 
*     THE OPERATOR CONTINUES TO MOUNT THE TAPE/PACKS AS 
*     NEEDED UNTIL ALL REQUESTED MASTERFILES HAVE BEEN
*     RECOVERED.
* 
*     AN ON-LINE LISTING OF ALL PARAMETERS MAYBE DISPLAYED
*     BY TYPING KK. 
* 
*PARAMETERS;
*     SINGLE PLATO FILE RECOVERY MODE;
*     V=VSN        REQUEST LABELED TAPE (VSN=LABEL) 
*     FF=XXXXXX    FROM FILE NAME (PLATO FILE NAME ON TAPE) 
*     TF=XXXXXX    TO FILE NAME (CURRENT PLATO FILE NAME) 
*                  IF NOT SPECIFIED, DEFAULT = FF 
* 
*     MASTERFILE RECOVERY MODE; 
*     PN=PACK      PACKNAME TO BE RECOVERED 
*     MF=MASTER    MASTERFILE NAME TO BE RECOVERED
*     DA=MMDD      MONTH AND DAY TO BE RECOVERED
*     SL=NN        SLOT VALUE TO BE USED
* 
*     K-DISPLAY PARAMETERS (MASTERFILE MODE ONLY);
*     PN,MF,DA,SL  SAME AS ABOVE
*     GO           BEGIN PROCESSING THE RECOVERY TAPES
* 
* /---   BLOCK      COPYPFX    00 000   81/04/29  11.33 
*INFORMATIVE MESSAGES;
*     DO NOT USE BLANK LABEL TAPE (WRONG TAPE)
*     DUMP FILE ASSIGNED TO DISK (RESTART THE PROGRAM AND 
*          GIVE TAPE ASSIGNMENT)
*     NO FILES SELECTED (WHEN K.GO IS ENTERED)
*     FFFFF - FILE NOT FOUND IN MASTERFILE MMMMM (FILE NOT
*          IN THIS MASTERFILE, SKIP TO NEXT MASTERFILE) 
*     MMMMM - MASTERFILE NOT REQUESTED (THIS MASTERFILE WILL
*          BE SKIPPED)
*     ALL DONE
* 
*ERROR MESSAGES;
*     ERROR IN PARAMETERS  (CORRECT THE PROCEDURES) 
*     TOO MANY FILES SELECTED (TO BE RESTORED - MAX. 50)
*     FIW OF TO FILE NOT BACKUP TYPE
*     TO FILE TYPE NOT BACKUP (WORD 2 OF BLOCK 0) 
*     FILE SIZES DO NOT MATCH 
*     FILE ACCOUNTS DO NOT MATCH
* 
*PLATO ATTACH READ/WRITE ERROR MESSAGES;
*     WAITING FOR FILE - XXXXXX (INFORMATIVE ONLY)
*     ERROR IN ATTACHING FILE 
*     ERROR IN READING FILE 
*     ERROR IN WRITING FILE 
*     FILE NAME = XXXXX 
*     ERROR STATUS = NNNN 
*     BEGINNING RECORD = NNNN 
*     ENDING RECORD = NNNN
* 
*INTERNAL ERROR MESSAGES; 
*     ERROR IN PROCESSOR TABLE
*     TOO MANY FILES IN MASTER FILE 
*     NAMES OF TO FILES DO NOT MATCH (FIW .VS. FILE DIRECT.)
*     NAMES OF FROM FILES DO NOT MATCH (FIW .VS. FILE DIR.) 
*     FROM FILE SIZE WRONG
*     FILE NOT COMPLETELY CONTAINED IN MASTERFILE 
          SPACE  4
*CALL     COMCMAC 
*CALL     COMCDCM 
*CALL     COMCCMD 
          SPACE  4,10 
*CALL     SYSCON
          SPACE  4,10 
****      ASSEMBLY CONSTANTS. 
 
 BUFL     EQU    10001B      CIO BUFFER LENGTH (SMALL)
 LBUFL    EQU    10001B      CIO BUFFER LENGTH (LARGE)
 WORKL    EQU    320*7       WORKING STORAGE BUFFER LENGTH
 CWRKH    EQU    6           COMMUNICATIONS BUFFER HEADER 
 CWRKF    EQU    3           COMM. BUFFER FILE ENTRY
 MAXFIL   EQU    MFFILES     MAX NUM OF FILES / MASTERFILE
 
 MAXK545  EQU    35          MAX LINES ON CC545 K-DISPLAY 
 MAXK721  EQU    20          MAX LINES ON 721 K-DISPLAY 
 MAXST    EQU    50          MAX NO. OF STACK ENTRIES 
 MAXST2   EQU    MAXST*2     SIZE OF STACK BUFFER 
 
 BLOCK    EQU    320         BLOCK SIZE 
 NUMBLK   EQU    7           NUMBER OF BLOCKS/PART
 PART     EQU    BLOCK*NUMBLK  PART SIZE
 BASE     EQU    320         BASE WORD FOR BEGINNING OF INFO
 MFNM     EQU    BASE        MASTER FILE NAME 
 MFTY     EQU    BASE+1      MASTER FILE TYPE 
 FILW     EQU    BASE+3      FILE WORD WITHIN FIRST BLOCK 
 OFFS     EQU    BASE+4      FILE LIST OFFSET 
 BACKTY   EQU    52B         BACKUP TYPE
 
 NAME     EQU    0           FILE NAME OFFSET IN DIRECTORY
 TYPE     EQU    1           FILE TYPE OFFSET 
 SIZE     EQU    2           FILE SIZE OFFSET 
 ACCT     EQU    40          ACCOUNT NAME OFFSET
 
* /---   BLOCK      COPYPFX    00 000   81/05/07  06.53 
 USERI    EQU    377773B     USER INDEX FOR FILES 
 TIMEL    EQU    7777B       TIME LIMIT 
 PRIOR    EQU    41B         PRIORITY 
 
 
 BEGIN    BSS    0
*         SET UP FETS 
 
 IF       BSS    0
 MFDUMP   FILEC  IBUF,LBUFL,(FET=14),XL 
 
 TB       BSS    0
 ZZZZZZ   FILEC  TBUF,BUFL,(FET=14) 
 
*         MAIN LOOP 
 
 COPYPF   BSS    0           ENTRY POINT
          SB1    1           FOREVER CONSTANT 
          RJ     INIT        INITIALIZE AND GET ARGS
 CPF1     SA1    MFCT        UPDATE MASTER FILE COUNT 
          SX6    X1+B1
          SA6    A1 
          SA1    VSNX        USER REQUESTED VSN 
          BX6    X1 
          RJ     RTF         OPEN TAPE
          READ   IF,R        INITIALIZE READING OF FILE 
 
 CPF2     READW  IF,WORK,WORKL
          SA2    ECOUNT      TRANSFER WORD COUNTS 
          SX7    B6-WORK     NUMBER OF WORDS READ 
          BX6    X2 
          SA6    WCOUNT 
          IX7    X6+X7       NEW WORD COUNT 
          SA7    A2 
          BX7    X1          SAVE READ STATUS 
          SA7    STATUS 
          NG     X1,CPF4     IF EOF/EOI 
          NZ     X1,CPF3     IF EOR 
          RJ     PROCESS     PROCESS INFO FOR THIS BLOCK
          EQ     CPF2 
 
 CPF3     RJ     PROCESS     PROCESS INFO FOR THIS BLOCK
          READ   IF 
          EQ     CPF2 
 
 CPF4     SX5    X1+B1
          NZ     X5,CPF5     IF EOI OR ERROR
          RJ     PROCESS     PROCESS INFO FOR THIS BLOCK
          READ   IF 
          EQ     CPF2 
 
 CPF5     RJ     PROCESS     PROCESS INFO FOR THIS BLOCK
          SA1    FF 
          ZR     X1,PROK6    IF DUMP MASTERFILE MODE
          MESSAGE TOOBIG
          EQ     ABORT
* /---   BLOCK      COPYPFX    00 000   80/11/17  11.04 
 ATTAUD   SPACE  4
**        ATTAUD - ATTACH AUDIT TRAIL FILE
 
 
 ATTAUD   DATA   0           ENTRY/EXIT 
          SETUI  USERI       USER INDEX 
          PACKNAM PACK       SET PACKNAME 
          SA1    TB+1        SET ERROR PROCESSING BIT 
          RJ     SETEPR 
 ATTA1    ATTACH TB,APER,,,R  ATTACH AUDIT FILE 
          SA1    TB          CHECK STATUS FOR BUSY
          RJ     CKSTATS
          NZ     X2,ATTA1    IF BUSY
          SA1    TB+1        CLEAR ERROR PROCESSING BIT 
          RJ     CLREPR 
          EQ     ATTAUD 
          TITLE  SUBROUTINES
 CKSTATS  SPACE  4
**        CKSTATS - CHECK FILE STATUS FOR BUSY
*         ROLLOUT FOR 64 SECONDS IF BUSY
*         ABORT IF ERROR
* 
*         ENTRY  X1-FET STATUS WORD 
* 
*         EXIT   X2=0, NOT BUSY 
 
 
 CKSTATS  DATA   0           ENTRY/EXIT 
          AX1    10 
          MX7    -8 
          BX2    -X7*X1      ISOLATE STATUS 
          ZR     X2,CKSTATS  IF NOT BUSY AND NO ERROR 
          SX2    X2-1 
          NZ     X2,ABORT    ATTACH ERROR 
          ROLLOUT CKSW
          SX2    1           BUSY STATUS
          EQ     CKSTATS
 
 CKSW     DATA   7700000100B
 CLREPR   SPACE  4
**        CLREPR - CLEAR ERROR PROCESSING BIT IN THE FET
* 
*         ENTRY  A1/X1=FET+1 AND CONTENTS 
 
 
 CLREPR   DATA   0           ENTRY/EXIT 
          SX6    B1          MASK FOR EPR 
          LX6    44 
          BX6    -X6*X1 
          SA6    A1 
          EQ     CLREPR 
* /---   BLOCK      COPYPFX    00 000   81/01/15  07.00 
 GETPN    SPACE  4
**        GETPN - ATTACH FILE ON PACK *PN*
 
 
 GETPN    DATA   0           ENTRY/EXIT 
          SA1    MFCT        GET MF COUNT 
          SA2    =5LMFDMP 
          LX1    24 
          BX6    X1+X2
          SA6    IF+8 
          SA1    IF+1        SET EPR
          RJ     SETEPR 
 GETPN1   ATTACH IF,IF+8,,,R,PN 
          SA1    IF 
          RJ     CKSTATS
          NZ     X2,GETPN1
          SA1    IF+1        CLEAR EPR
          RJ     CLREPR 
          REWIND IF,R 
          EQ     GETPN
 GTW      SPACE  4
**        GTW - GET WORD
* 
*         THIS ROUTINE EXTRACTS UP TO TEN CHARACTERS FROM 
*         A CONTROL CARD AREA.  'ALL WORDS ARE SEPARATED
*         BY DELIMITERS (ANY CHARACTER .GT. 9 EXCEPT BLANK).
* 
*         ENTRY  B1 = 1 
*                A4/X4 = CHARACTERS TO BE EXTRACTED FROM
*                B6 = SHIFT COUNT (INITIALLY 0) 
* 
*         EXIT   X1 = WORD THAT WAS EXTRACTED 
*                X2 = DELIMITER 
*                  IF X2 .LT. 0 - MORE THAN 10 CHARS IN WORD
*                  IF X2 .EQ. 0 - END OF CARD 
*                B5 = 60-(N*6) WHERE N IS THE NUMBER OF 
*                  CHARACTERS FOUND IN THE WORD 
*                A4/X4/B6 SET FOR NEXT WORD 
* 
*         USES   A-4
*                X-1,2,3,4
*                B-5,6,7
 
 
* /---   BLOCK      COPYPFX    00 000   81/01/15  06.59 
 GTW      DATA   0           ENTRY/EXIT 
          MX1    0           INITIAL SETTINGS 
          SB5    60 
          SB7    B5 
 GTW1     SB6    B6+6        NEXT CHARACTER 
          GT     B6,B7,GTW2  IF NEW WORD NEEDED 
          MX2    -6          CHARACTER MASK 
          LX4    6           SHIFT TO NEXT CHARACTER
          BX2    -X2*X4 
          ZR     X2,GTW      END OF CARD
          SX3    X2-1R       TEST FOR BLANKS
          ZR     X3,GTW1A 
          SX3    X2-1R9-1 
          PL     X3,GTW      IF DELIMITER 
 GTW1A    SB5    B5-6        DECREASE CHARACTER SHIFT COUNT 
          NG     B5,GTW3     IF MORE THAN 10 CHARS. 
          LX2    X2,B5       SHIFT TO PROPER LOCATION 
          BX1    X1+X2       MERGE
          EQ     GTW1        GET NEXT CHARACTER 
 
 GTW2     SA4    A4+B1       GET NEXT WORD
          SB6    B0 
          EQ     GTW1 
 
 GTW3     BX2    -X2         ERROR FLAG 
          EQ     GTW         EXIT 
 INIT     SPACE  4
**        INIT - INITIALIZE 
 
 
 INIT4    RJ     INITFIL     INITIALIZE FOR SINGLE FILE MODE
 INIT     DATA   0           ENTRY/EXIT 
          SB6    LSCR        CLEAR BUFFERS
          SB7    BEND-LSCR
          RJ     ZERO 
          RJ     INITPT      INITIALIZE POINTERS
          SETUI   USERI      SET USER INDEX 
          SETTL   TIMEL      SET TIME LIMIT 
          SETPR   PRIOR      SET PRIORITY 
* 
*         GET ARGUMENTS 
* 
          SA1    ACTR        ARG COUNT
          SB4    X1 
          SA4    ARGR        FIRST ARG
          SB5    ARGTBL      ARG TABLE
          RJ     ARG
          NZ     X1,INITERR  ERROR IN ARGUMENTS 
          SA1    INITM       MODIFY COMCARG FOR 10 CHARS
          BX6    X1 
          SA6    /COMCARG/ARG5
          SA1    Z           SEE IF EXTENDED PARAMETERS 
          ZR     X1,INIT1 
          SX5    CCDR        CONTROL CARD AREA
          RJ     PRA         EXTRACT EXTENDED PARAMETERS
          NZ     X6,INITERR  IF ERROR IN CARD 
          SB5    ARGTBL      ARG TABLE ADDRESS
          RJ     ARG
          NZ     X1,INITERR  ERROR IN ARGUMENTS 
 INIT1    SA1    FF          FROM FILE
          NZ     X1,INIT3    IF TO FILE SPECIFIED 
 INIT2    RJ     KDISP       DO K-DISPLAY 
          EQ     INIT 
 
 INIT3    SA2    TF          TO FILE
          NZ     X2,INIT4    IF TO FILE SPECIFIED 
          BX6    X1          SET TO = FROM
          SA6    A2 
          EQ     INIT4
 
 INITM    BX7    X3+X6       INSTRUCTIONS MODIFIED AT ARG5
          SA7    B2+
          SB3    B2-B3
 
 INITERR  MESSAGE INMSG 
          EQ     ABORT
* /---   BLOCK      COPYPFX    00 000   80/11/13  09.27 
 INITFIL  SPACE  4
**        INITFIL - INITIALIZE FOR FILE RECOVERY
 
 
 INITFIL  DATA   0           ENTRY/EXIT 
          REWIND TB 
          SA1    TF          ATTACH TO FILE 
          RJ     SETF 
          SX1    WORK        READ DIRECTORY BLOCK 
          SX6    B0 
          SX7    B1 
          RJ     DRD
          SA1    =XPFINFO 
          MX7    -6 
          AX1    24 
          BX6    -X7*X1      SIZE OF FILE (PARTS) 
          SA6    TOSIZE 
          AX1    6
          BX6    -X7*X1      TYPE OF FILE 
          SX6    X6-BACKTY   SEE IF BACKUP TYPE 
          NZ     X6,TOFIWE   IF WRONG TYPE
          SA1    WORK+NAME
          SA2    TF 
          IX6    X1-X2
          NZ     X6,TONAME   IF WRONG NAME
          SA1    WORK+TYPE
          SA2    BACKUP 
          IX6    X1-X2
          NZ     X6,TOTYPE   IF WRONG TYPE
          SA1    WORK+ACCT
          BX6    X1 
          SA6    TOACCT      SAVE ACCOUNT 
          EQ     INITFIL
 INITPCK  SPACE  4
**        INITPCK - INITIALIZE PACKNAME/VSN FOR MASTER FILE 
*         RECOVERY MODE.
* 
*         EXIT   X1=0, NO MORE STACK ENTRIES
 
 
 INITPCK  DATA   0           ENTRY/EXIT 
          SA1    STACKPT
          ZR     X1,INITPCK  IF NO ENTRIES
          SX7    0           ZERO POINTERS
          SA7    MFCT 
          SA7    VSNX 
          SA7    VSN
          SA7    PN 
          SA7    RTFA 
          SB6    0
          SB7    X1+         COUNTERS 
 IPCK1    SA1    B6+STACK+1  CURRENT STACK ENTRY
          NZ     X1,IPCK2    ENTRY FILLED 
          SB6    B6+2        NEXT ENTRY 
          LT     B6,B7,IPCK1 IF NOT DONE
          EQ     INITPCK     EXIT, X1=0 
 
 IPCK2    BX6    X1          STORE ENTRY IN VSN OR PACKNAME 
          MX7    6
          BX7    X7*X6
          ZR     X7,IPCK3    IF VSN 
          SA6    PN 
          EQ     INITPCK
 
 IPCK3    LX6    6
          SA6    VSNX 
          EQ     INITPCK
 INITPT   SPACE  4
**        INITPT - INITIALIZE POINTERS
 
 
 INITPT   DATA   0           ENTRY/EXIT 
          SX7    0           ZERO COUNTERS
          SA7    COUNT
          SA7    WCOUNT 
          SA7    ECOUNT 
          SA7    MFNAME 
          SA7    MFTYPE 
          SA7    NFILES 
          SA7    MFILES 
          SA7    OFFSET 
          SA1    PROX        INITIALIZE PROCESS POINTERS
          BX6    X1 
          SA6    PRO1 
          SX7    PTABLE 
          SA7    PPOINT 
          EQ     INITPT 
* /---   BLOCK      COPYPFX    00 000   80/11/03  07.22 
 PRA      SPACE  4
**        PRA - EXTRACT PARAMETERS BEYOND PERIOD
* 
*         EXTRACT PARAMETERS FROM CONTROL CARD AREA 
* 
*         ENTRY  B1 = 1 
*                X5 = ADDRESS OF CONTROL CARD 
* 
*         EXIT   X6 = 0 ALL OK, -1 IF ERROR 
*                ARGUMENTS AT ARGR
*                A4/X4 = FIRST ARGUMENT 
*                B4 = NUMBER OF ARGUMENTS 
* 
*         USES   A-4
*                X-1,2,3,4,6,7
*                B-3,4,5,6,7
* 
*         CALLS  GTW
 
 
 PRA      DATA   0           ENTRY/EXIT 
          SA4    X5          CONTROL CARD AREA
          SB6    0           INITIAL SHIFT COUNT
 PRA1     RJ     GTW         GET NEXT WORD
          NG     X2,PRAX     ERROR - MORE THAN 10 CHARS.
          ZR     X2,PRAX     ERROR - NULL WORD
          SX7    X2-1R. 
          ZR     X7,PRA2     IF PERIOD
          SX7    X2-1R) 
          NZ     X7,PRA1     IF NOT ) 
 PRA2     SB3    ARGR        LOCATION TO STORE ARGS 
 PRA3     RJ     GTW         GET NEXT WORD
          NG     X2,PRAX     ERROR - MORE THAN 10 CHARS 
          ZR     X1,PRA5     IF END OF CARD 
          SX7    X2-1R=      SEE IF = IS DELIMITER
          SX6    0
          NZ     X7,PRA4     IF NOT = 
          SB4    48 
          LT     B5,B4,PRA4  IF NOT 1 OR 2 CHARACTERS 
          SX6    1R=         ADD = CHARACTER TO WORD
 PRA4     BX6    X6+X1       MERGE
          SA6    B3          STORE ARGUMENT 
          SB3    B3+B1       ADVANCE ARG POINTER
          NZ     X2,PRA3     IF NOT END OF CARD 
 PRA5     SB4    B3-ARGR     NUMBER OF ARGUMENTS
          SA4    ARGR        FIRST ARGUMENT 
          MX6    0           OK EXIT
          EQ     PRA
 
 PRAX     MX6    59          ERROR EXIT 
          EQ     PRA
* /---   BLOCK      COPYPFX    00 000   80/11/14  09.08 
 RTF      SPACE  4
**        RTF - REQUEST TAPE FILE 
* 
*         REQUEST A LABELED TAPE
* 
*         ENTRY -  IF  = FET ADDRESS
*                  PN .NE. 0 - PN=PACKNAME (DO NOT LABEL) 
*                 (X6) = VSN REQUESTED
*                        IF BINARY 0, GET SCRATCH TAPE
*                        IF BINARY 1, REQUEST TAPE
* 
*         EXIT  - (X6) = VSN OF TAPE LOADED 
*                 LABELS WRITTEN
 
 
 RTF      DATA   0           ENTRY/EXIT 
          SA1    RTFA        INCREMENT TAPE FILE COUNT
          SX7    X1+B1
          SA7    A1 
 RTF1     SA1    PN          SEE IF PACK NAME SPECIFIED 
          NZ     X1,RTF8
          SX1    B1          TEST FOR REQUEST TAPE OPTION 
          SX2    B1 
          LX2    39          X2=RING OUT
          IX6    X6-X1
          ZR     X6,RTF2     REQUEST TAPE 
          IX6    X6+X1
          NZ     X6,RTF2     IF VSN SPECIFIED 
          SA1    =6L         LABEL FOR SCRATCH TAPE 
          BX6    X1          (X6) = SCRATCH VSN 
 RTF2     SX7    5           (X7) = LABELED / 9-TRACK 
          LX7    56 
          BX7    X7+X2
          SA7    IF+8 
          MX0    36 
          BX6    X0*X6
          SA6    A7+B1       SET VSN
          BX6    X6-X6
          SX6    B0          SET FILE NAME = 0
          SA6    A6+B1
          SA2    RTFA        GET TAPE POSITION
          BX7    X2 
*          SX2    X2-1
*          SX7    1           FIRST FILE SEQUENCE = 1 
*          ZR     X2,RTF4 
*          SX7    9999        ALL OTHERS = 9999 
 RTF4     IX6    X6+X7       MERGE WITH FILE NAME 
          SA6    A6+B1       FET+11 
          SA1    =6LMFDUMP
          BX6    X1 
          SA6    A6+B1       SET NAME = *MFDUMP*
          BX7    X7-X7
          SA7    A6+B1
          LABEL  IF          FIND LABELED TAPE
 
*         OPEN VOL1 LABEL IF FIRST TIME THRU
 
          SA3    RTFA        TAPE FILE NUMBER 
          SX3    X3-1 
          NZ     X3,RTF5     IF NOT FIRST FILE
*          RJ     SETEB 
*          SA1    =0LVOL1 
*          BX6    X1
*          SA6    PB+1
*          OPEN   IF,READ,R 
*          SA1    IF+B1       CHECK DEVICE TYPE 
*          PL     X1,RTF7     IF ASSIGNED TO DISK 
*          SA1    PB+1        GET VSN 
*          SA4    =6L         TEST FOR BLANK LABEL
*          MX6    36
*          LX1    24
*          BX6    X6*X1 
*          IX7    X6-X4 
*          ZR     X7,RTF9     IF BLANK LABEL
          SA1    VSNX 
          BX6    X1 
* /---   BLOCK      COPYPFX    00 000   80/10/27  10.12 
          LX6    54          CLEAR TOP BITS FOR TAPE FLAG 
          SA6    VSN
 RTF5     SA1    RTFA        FORM FILE SEQUENCE NUMBER
          SX1    X1+10000 
          RJ     CDD
          MX7    -18
          BX4    -X7*X6 
          SA1    IF+10       SHIFT TO STANDARD FET INFO 
          SA2    A1+B1
          BX6    X1 
          SA6    A1-B1       FILE IDENTIFIER-FIRST 10 CHARS 
          MX7    42 
          BX6    X7*X2       NEXT 7 CHARS 
          BX6    X6+X4       ADD SEQUENCE NUMBER
          SA6    A6+B1       FET+10 
          MX6    0
          SA6    A6+B1
          SA1    A6+B1       SET IDENTIFICATION 
          MX7    36 
          BX6    X7*X1
          SA6    A1          FET+12 
          SA1    IF+1        CLEAR EXTENDED LABEL BIT 
          SX6    B1 
          LX6    41 
          BX6    -X6*X1 
          SA6    A1 
          POSMF  IF,R 
          SA1    IF+2        IN=OUT 
          BX6    X1 
          SA6    A1+B1
          SA1    IF+B1       CHECK DEVICE TYPE
          NG     X1,RTF      IF ASSIGNED TO TAPE
 RTF7     MESSAGE WRONG      WRONG DEVICE 
          EQ     ABORT
 
 RTF8     RJ     GETPN       GET FILE ATTACHED ON PACK
          EQ     RTF         EXIT 
 
 RTF9     UNLOAD IF,R        GET RID IF BLANK LABEL 
          MESSAGE BLANK      ERROR MESSAGE
          SA1    VSNX        TRY TO REQUEST TAPE AGAIN
          BX6    X1 
          EQ     RTF1 
 
 PB       BSSZ   10          BUFFER FOR VOL1 HEADER 
 RTFA     DATA   0           COUNT OF FILES ON TAPE 
* /---   BLOCK      COPYPFX    00 000   80/10/30  12.14 
 SETEB    SPACE  4
**        SETEB - SETUP EXTENDED LABEL BUFFER 
* 
*         SETS UP COUNT FIELDS IN FET AND EXT. BUFFER 
*         CLEAR ALL OTHER FIELDS IN BUFFER
* 
*         USES   A - 6,7
*                X - 6,7
*                B - 6
 
 
 SETEB    DATA   0           ENTRY/EXIT 
          SX6    10          LENGTH 
          SX7    PB          BEGINNING ADDRESS
          LX6    18 
          BX6    X6+X7
          SA6    IF+9        PUT IN FET 
          SX7    80          CHARACTER COUNT
          SA7    PB 
          SX6    0
          SB6    9
 SEB1     SA6    A7+B6       CLEAR PB+1 TO PB+9 
          SB6    B6-B1
          GE     B6,B1,SEB1 
          EQ     SETEB
 SETEPR   SPACE  4
**        SETEPR - SET ERROR PROCESSING BIT IN THE FET
* 
*         ENTRY  A1/X1=FET+1 AND CONTENTS 
 
 
 SETEPR   DATA   0           ENTRY/EXIT 
          SX6    B1          MASK FOR EPR 
          LX6    44 
          BX6    X6+X1
          SA6    A1 
          EQ     SETEPR 
 ZERO     SPACE  4
**        ZERO - ZERO BUFFER
* 
*         ENTRY  B1=1 
*                B6=FWA 
*                B7=NUMBER OF WORDS TO ZERO 
* 
*         EXIT   X7=0 
*                BUFFER ZEROED
* 
*         USES   A-7
*                X-7
*                B-6,7
 
 ZERO     DATA   0           EMTRY/EXIT 
          MX7    0
          SB7    B7-B1
          NG     B7,ZERO
 ZRO1     SA7    B6+B7
          SB7    B7-B1
          PL     B7,ZRO1
          EQ     ZERO 
* /---   BLOCK      COPYPFX    00 000   80/10/24  07.15 
          TITLE  PROCESS MF DATA
**        PROCESS BLOCK INFORMATION 
 
 
 PROZ     SA1    PROY        INSTALL FAST EXIT
          BX6    X1 
          SA6    PRO1 
 PROCESS  DATA   0           PROCESS BLOCK INFO 
* 
*         THE FOLLOWING COMMANDS DUPLICATED AT PROX 
* 
 PRO1     SA3    PPOINT      PROCESS POINTER
          SA4    X3+
          ZR     X4,PROZ     IF ALL DONE
          SA1    WCOUNT      BEGINNING COUNT FOR THIS READ
          SA2    ECOUNT      ENDING COUNT FOR THIS READ 
          MX7    30 
          BX6    -X7*X4      WORD THAT IS WANTED
          ZR     X6,PRO5     JUMP ROUTINE DEMANDED
          IX5    X6-X1       COMPARE WITH BEGINNING 
          IX3    X6-X2       COMPARE WITH ENDING
          NG     X5,PROERR   IF WE HAVE ALREADY PASSED IT 
          PL     X3,PROCESS  IF NOT HERE YET
          MX7    12 
          BX7    X7*X4       WORD COUNT 
          ZR     X7,PRO5     PROCESS JUMP WANTED
          LX7    12 
          SB7    X7          WORD COUNT 
          NE     B7,B1,PRO2  IF MORE THAN 1 WORD
          SA1    X5+WORK     GET WORD THAT IS WANTED
          AX4    30          STORE LOCATION 
          BX7    X1 
          SA7    X4          STORE DESIRED WORD 
          SX7    A4+B1       BUMP POINTER COUNTER 
          SA7    PPOINT 
          EQ     PRO1        PROCESS NEXT REQUEST 
 
 PRO2     IX6    X3+X7       COMPARE WORD COUNT WITH ROOM 
          NG     X6,PRO3     IF ENOUGH ROOM 
          ZR     X6,PRO3     IF JUST ENOUGH ROOM
          IX7    X4-X3       INCREMENT FROM 
          LX3    30 
          IX7    X7-X3       INCREMENT TO 
          LX3    18 
          IX7    X7+X3       DECREMENT TO 
          LX3    12          RESTORE COUNT
          SA7    A4          STORE NEW COMMAND FOR NEXT PASS
          BX1    -X3         WORD COUNT THIS PASS 
          EQ     PRO4        MOVE WORDS 
 
 PRO3     SX7    A4+B1       BUMP POINTER 
          SA7    PPOINT 
          SX1    B7          WORD COUNT 
 PRO4     SX2    X5+WORK     FROM 
          AX4    30 
          SX3    X4          TO 
          RJ     MVE=        MOVE WORDS 
          EQ     PRO1        NEXT REQUEST 
 
* /---   BLOCK      COPYPFX    00 000   80/10/31  12.06 
 PRO5     SX7    A4+B1       BUMP POINTER 
          SA7    PPOINT 
          AX4    30          GET JUMP ADDRESS 
          SB7    X4 
          JP     B7+         JUMP TO PROPER ROUTINE 
 
 PROF     SA1    NFILES      GET FILE COUNTS
          SX7    X1          NUMBER OF FILES
          AX1    18 
          NZ     X7,PROF1    IF NO FILES, FAKE ONE
          SX7    1
 PROF1    SX6    X1          MAX NUMBER OF FILES
          SA7    A1 
          SA6    MFILES 
          SX5    X7-MAXFIL-1 COMPARE WITH MAX.
          PL     X5,PROFERR  TOO MANY 
          SA1    OFFSET 
          SX2    FILN        FILE NAME BUFFER 
          SX3    FILI        FILE INFO BUFFER 
          LX2    30 
          LX3    30 
          SX1    X1+BASE
          IX6    X6+X1
          LX7    48          FILE COUNT 
          IX6    X6+X7
          IX6    X6+X3
          IX7    X7+X1
          IX7    X7+X2
          SA7    PTABA
          SA6    A7+B1
          EQ     PRO1        NEXT REQUEST 
 
 PROG     SA2    NFILES      NUMBER OF FILES
          SA1    FF          FROM FILE
          SB7    X2+
          SB6    0
 PROG1    SA2    FILN+B6     CURRENT FILE NAME
          IX6    X1-X2
          ZR     X6,PROG4    IF DESIRED FILE
          SB6    B6+B1       NEXT FILE
          LT     B6,B7,PROG1 IF NOT DONE
          RJ     SFN         FORM MESSAGE 
          SA6    PROGM
          SA1    MFNAME      MASTER FILE NAME 
          SX2    3RLE 
          BX6    X1+X2
          LX6    42 
          SA6    PROGM1 
          MESSAGE PROGM 
 PROG1A   SA1    PN          UNLOAD IF DISK PACK
          ZR     X1,PROG2 
          UNLOAD IF,R 
          EQ     PROG3
 
 PROG2    SA1    IF+2        IN=OUT 
          BX6    X1 
          SA6    A1+B1
 PROG3    RJ     INITPT      INITIALIZE POINTERS
          EQ     CPF1        READ NEXT MASTER FILE
 
 PROG4    SA1    FILI+B6     FILE INFO WORD 
          SX5    PART        NUMBER OF WORDS IN PART
          MX7    -24
          BX6    -X7*X1      BEGINNING PART NUMBER
          IX6    X6*X5       BEGINNING WORD 
          SX7    PROH        FORM PROCESSOR TABLE ENTRY 
          LX7    30 
          IX6    X6+X7
          SA6    PTABB
          MX7    -6 
          AX1    24 
          BX6    -X7*X1      NUMBER OF PARTS IN FILE
          IX6    X6*X5       WORD COUNT 
          SA6    WCWANT 
          EQ     PRO1        NEXT ENTRY 
 
* /---   BLOCK      COPYPFX    00 000   81/01/15  07.56 
 PROH     BSS    0
          SA1    WCWANT      WORD COUNT REMAINING IN FILE 
          IX6    X3+X1       DECREMENT
          SA6    A1 
          NG     X6,PROH1    IF ENOUGH WORDS THIS PASS
          ZR     X6,PROH1    IF JUST ENOUGH WORDS 
          SA4    A4          REREAD PROCESSOR WORD
          IX7    X4-X3       INCREMENT FROM COUNT 
          SA7    A4 
          SX7    A4          RESET PROCESSOR POINTER
          SA7    PPOINT 
 
 PROH1    BX3    -X3         CORRECT WORD COUNT 
          WRITEW TB,WORK+X5,X3 WRITE OUT TEMP. FILE 
          SA1    WCWANT 
          NG     X1,PROH2    IF DONE
          NZ     X1,PRO1     IF NOT DONE
 PROH2    WRITER TB,R        WRITE EOR
          EQ     PRO1 
 
 PROI     BSS    0
          REWIND TB,R 
          READ   TB,R 
          READW  TB,WORK,BLOCK
          NZ     X1,PROIER   IF EARLY EOR, EOF, EOI 
          SA1    WORK+NAME   SEE IF NAMES MATCH 
          SA2    FF 
          IX6    X1-X2
          NZ     X6,FFNAME
          SA2    TOACCT 
          BX6    X2          UPDATE ACCT NAME IN FILE DIR.
          SA6    WORK+ACCT
          SA1    WORK+SIZE   SEE IF SIZE MATCH
          SA2    TOSIZE 
          SX6    NUMBLK 
          IX2    X6*X2
          IX6    X1-X2
          NZ     X6,TOSIZX
          BX6    X1          SAVE NUMBER OF BLOCKS
          SA6    A2 
          SX6    B0          CURRENT BLOCK
          SA6    WCWANT 
 PROI1    READW  TB,WORK,BLOCK
          NZ     X1,PROI2    IF EOR, EOF, EOI 
          SA1    WCWANT 
          SX6    X1+B1       CURRENT BLOCK
          SA6    A1 
          SX7    1           NUMBER OF BLOCKS TO WRITE
          SX1    WORK        FWA
          RJ     DWR         WRITE BLOCK
          EQ     PROI1
 
 PROI2    SA1    WCWANT 
          SA2    TOSIZE 
          SX1    X1+B1
          IX6    X1-X2
          NZ     X6,PROIER   IF FILES NOT THE SAME SIZE 
          REWIND TB,R        REREAD FIRST BLOCK 
          READ   TB,R 
          READW  TB,WORK,BLOCK
          NZ     X1,PROIER   IF EARLY EOR, EOF, EOI 
          SA1    TF          PUT IN PROPER NAME 
          BX6    X1 
          SA6    WORK+NAME
          SX6    B0          REWRITE DIRECTORY
          SX7    B1 
          SX1    WORK 
          RJ     DWR
 PROI3    MESSAGE (=C*ALL DONE*)
          ENDRUN
 
* /---   BLOCK      COPYPFX    00 000   80/11/14  08.33 
 PROJ     SA1    FF 
          NZ     X1,PRO1     SKIP IF IN SINGLE FILE MODE
          SA2    MFNAME      GET MASTER FILE NAME 
          SA3    STACKPT     NUMBER OF ENTRIES IN STACK * 2 
          SB6    B0          COUNTER
          SB5    2           INCREMENT
          SB7    X3          FINAL COUNT
 PROJ1    SA1    B6+STACK    CURRENT ENTRY
          BX6    X1-X2       COMPARE
          SB6    B6+B5       INCREMENT FOR NEXT ENTRY 
 PROJ2    ZR     X6,PROJ3    IF MASTER FILES AGREE
          LT     B6,B7,PROJ1 IF NOT DONE
          SA1    MFNAME      OUTPUT MASTERFILE NAME 
          RJ     SFN
          SA6    NOTREQ 
          MESSAGE NOTREQ
          EQ     PROG1A 
 
 PROJ3    SA1    B6+STACK-1  GET VSN/PACKNAME 
          MX7    6           MASK FOR TOP CHARACTER 
          BX7    X7*X6
          ZR     X7,PROJ5    IF VSN 
          SA1    PN          GET PACK NAME
 PROJ4    BX6    X1-X2       COMPARE VSN/PN WITH REQUEST
*          NZ     X6,PROJ2    IF NOT THE SAME 
          SX6    B6-B5       SAVE STACK ADDRESS 
          SA6    THISONE
          SA1    MFNAME 
          SX6    B1 
          IX6    X6+X1
          SA6    TB          SET UP F.E.T.
          REWIND TB,R 
          SX7    PTABD       RESET PROCESS POINTER
          SA7    PPOINT 
          SX6    PROK        SET UP PROCESS WORD
          LX6    30 
          SA6    X7 
          SA1    MFNAME      OUTPUT RESTORING MESSAGES
          RJ     SFN
          SA6    REING+1
          MESSAGE REING 
          EQ     PRO1        FOR NOW
 
 PROJ5    SA1    VSN         GET VSN
          EQ     PROJ4
 
 PROK     SA1    ECOUNT      ENDING COUNT 
          SX6    PROK        PROCESS TABLE POINTER
          SA2    WCOUNT      BEGINNING COUNT
          LX6    30          SHIFT TO PROPER SUBR. POSITION 
          IX5    X1-X2       WORD COUNT 
          IX6    X1+X6       NEXT RECORD PROCESS WORD 
          SA6    PTABD
          SX6    A6          PROCESS POINTER
          SA6    PPOINT 
          ZR     X5,PROK1    NO WORDS TO WRITE
          WRITEW TB,WORK,X5  WRITE OUT WORDS
 PROK1    SA1    STATUS      CHECK READ STATUS
          SB7    X1+
          LE     B7,B0,PROK2 IF NOT EOR 
          SB7    1           EOR JUMP NUMBER
 PROK2    JP     B7+PROK3+3  JUMP TO PROPER ROUTINE 
 
 PROK3    EQ     PROK5       ERROR
          EQ     PROK6       EOI
          EQ     PROK4       EOF
          EQ     PRO1        NORMAL READ
*          WRITER TB,R        EOR 
          EQ     PRO1        NEXT RECORD
 
* PROK4    WRITEF TB,R        EOF 
 PROK4    BSS    0
          EQ     PRO1        NEXT RECORD
 
 PROK5    MESSAGE (=C* ERROR WHILE READING INPUT*)
          EQ     ABORT
 
* /---   BLOCK      COPYPFX    00 000   80/11/07  13.23 
 PROK6    SA1    TB+2        SEE IF BUFFER EMPTY
          SA2    A1+B1
          IX3    X1-X2
          ZR     X3,PROK7 
          WRITE  TB,R 
          SA1    TB+2        SEE IF BUFFER NOW EMPTY
          SA2    A1+B1
          IX3    X1-X2
          ZR     X3,PROK7 
          WRITER TB,R        FORCE WRITE
 PROK7    SA1    MFNAME      OUTPUT RECOVERED MESSAGE 
          RJ     SFN
          SA6    RECOV
          MESSAGE RECOV 
          SA1    THISONE
          SA1    X1+STACK+1  GET THIS PACKNAME/VSN
          MX7    0           CLEAR THIS ENTRY 
          SA7    A1 
          SA7    A7-B1
* 
*         LOOK FOR MORE ENTRIES TO DO 
* 
          SB6    B0 
          SA3    STACKPT
          SB7    X3 
          SB5    B1+B1
 PROK8    SA2    B6+STACK+1  CURRENT ENTRY
          BX6    X1-X2       SEE IF SAME AS CURRENT ONE 
          SB6    B6+B5
          ZR     X6,PROG1A   IF MORE FOR THIS VSN/PACK
          LT     B6,B7,PROK8 IF MORE TO LOOK AT 
          UNLOAD IF,R        ALL DONE WITH THIS PACK VSN
          RJ     INITPT      SET UP POINTERS
          RJ     INITPCK     INIT. PACK POINTERS
          NZ     X1,CPF1     IF MORE ENTRIES
          EQ     PROI3       ALL DONE 
 
 PROX     SA3    PPOINT      COPY OF PRO1 
          SA4    X3+
 PROY     EQ     PROCESS     DUMMY FAST EXIT COMMAND
 
 PROERR   MESSAGE PROM
 ABORT    ABORT 
 
 PROFERR  MESSAGE PROFM 
          EQ     ABORT
 
 PROIER   MESSAGE PROIE 
          EQ     ABORT
 
*         PROCESSOR TABLE 
 
 PPOINT   VFD    60/PTABLE   PROCESS TABLE POINTER
 PTABLE   BSS    0
          VFD    12/1,18/MFNAME,30/MFNM 
          VFD    12/0,18/PROJ,30/0
          VFD    12/1,18/MFTYPE,30/MFTY 
          VFD    12/1,18/NFILES,30/FILW 
          VFD    12/1,18/OFFSET,30/OFFS 
          VFD    12/0,18/PROF,30/0
 PTABA    VFD    12/0,18/FILN,30/0  FILLED IN WITH NUM FILES
          VFD    12/0,18/FILI,30/0  FILLED IN WITH NUM FILES
          VFD    12/0,18/PROG,30/0
 PTABB    VFD    12/0,18/PROH,30/0  FILE LOCATION FILLED IN 
          VFD    12/0,18/PROI,30/0
 PTABC    DATA   0           END OF TABLE 
 
 PTABD    VFD    12/0,18/PROK,30/0
          DATA   0           END OF TABLE 
* /---   BLOCK      COPYPFX    00 000   80/10/15  08.53 
          TITLE  PLATO FILE ATTACH, READ WRITE ROUTINES 
**        SETF - ATTACH FILE
* 
*         X1=FILE NAME
* 
*         EXIT IF ALREADY ATTACHED
*         ABORT IF ERROR
 
 
 SETFX    SA1    DST4        SEE IF CLEAR MESSAGE NEEDED
          ZR     X1,SETF
          MX6    0           CLEAR FLAG 
          SA6    A1 
          SX6    CMSG 
          RJ     BDIS        CLEAR B DISPLAY
 SETF     DATA   0           ENTRY/EXIT 
          BX7    X1          FILE NAME
          SA1    DSNAME      OLD FILE NAME
          IX6    X7-X1
          ZR     X6,SETF     EXIT IF ALREADY ATTACHED 
          SA7    A1          SAVE FOR LATER 
 DST1     SA1    DARG1       ARGUMENT LIST
          RJ     =XSETFILE   ATTACH FILE
          SB1    1           RESTORE
          SA1    DERROR      SEE IF ERROR STATUS
          NG     X1,SETFX    IF NO ERROR
          SX6    X1-13       SEE IF ATTACHED EARLIER
          ZR     X6,DST2
          SX1    X1-2        SEE IF ATTACHED ELSEWARE 
          NZ     X1,DST3
          SA6    DST4        FLAG TO CLEAR WAITING MESSAGE
          SX6    DWAIT       WAITING MESSAGE
          RJ     BDIS 
          EQ     DST1 
 
 DST2     RJ     DDET        DETACH IT
          EQ     DST1        REATTACH IT
 
 DST3     MESSAGE DMATT      ATTACH ERROR MESSAAGE
          RJ     DMAM        FILE NAME
          RJ     DMEM        ERROR STATUS 
          EQ     ABORT
 
 DST4     DATA   0           FLAG FOR WAITING MESSAGE 
 DRD      SPACE  4
**        DRD - DATAIN ROUTINES 
* 
*         X1 - CENTRAL MEMORY LOCATION
*         X6 - STARTING RECORD
*         X7 - NUMBER OF RECORDS
 
 
 DRD      DATA   0           ENTRY/EXIT 
          RJ     DPAR        STORE PARAMETERS 
          RJ     =XDREAD     READ IN DATA 
          SB1    1           RESTORE
          SA1    DERROR      LOOK AT STATUS 
          NG     X1,DRD      IF NO ERROR
          MESSAGE DMRDM      DREAD  ERROR MESSAGE 
 DRDX     RJ     DMAM        FILE NAME
          RJ     DMEM        ERROR STATUS 
          RJ     DBGM        BEGINNING RECORD NUMBER
          RJ     DNRM        NUMBER OF RECORDS
          EQ     ABORT       ABORT
 DWR      SPACE  4
**        DWR - DWRITE ROUTINES 
* 
*         X1 - CENTRAL MEMORY LOCATION
*         X6 - STARTING RECORD
*         X7 - NUMBER OF RECORDS
 
 
 DWR      DATA   0           ENTRY/EXIT 
          RJ     DPAR        STORE PARAMETERS 
          RJ     =XDWRITE    WRITE OUT DATA 
          SB1    1           RESTORE
          SA1    DERROR      LOOK AT STATUS 
          NG     X1,DWR      IF NO ERROR
          MESSAGE DMWRM      DWRITE  ERROR MESSAGE
          EQ     DRDX        ERROR MESSAGES AND ABORT 
* /---   BLOCK      COPYPFX    00 000   80/10/15  08.42 
 DDET     SPACE  4
**        DDET - DETACH FILE
* 
*         DETACHES LAST FILE
 
 
 DDET     DATA   0           ENTRY/EXIT 
          SA1    DARG3       ARGUMENT LIST
          RJ     =XDETACH    DETACH FILE
          SB1    1           RESTORE
          EQ     DDET 
 DPAR     SPACE  4
**        DPAR - STORE PARAMETERS 
* 
*         X1 - CENTRAL MEMORY LOCATION
*         X6 - STARTING RECORD
*         X7 - NUMBER OF RECORDS
 
 
 DPAR     DATA   0           ENTRY/EXIT 
          SA6    DBR         BEGINNING RECORD 
          SA7    DNR         NUMBER OF RECORDS
          BX6    X1          MEMORY ADDRESS 
          SA6    DA2M 
          SA1    DARG2       PARAMETER LIST 
          EQ     DPAR 
 BDIS     SPACE  4
**        BDIS - SENT MESSAGE TO THE B DISPLAY ONLY 
* 
*         X6=ADDRESS OF MESSAGE 
 
 
 BDIS     DATA   0           ENTRY/EXIT 
          SA6    DARG4       STORE ARGUMENT 
          SA1    DARG4
          RJ     =XBDISP
          SB1    1           RESTORE
          EQ     BDIS 
* /---   BLOCK      COPYPFX    00 000   80/10/15  08.53 
 DMAM     SPACE 4 
**        DMAM - OUTPUT FILE NAME INTO DAYFILE
 
 
 DMAM     DATA   0           ENTRY/EXIT 
          SA1    DSNAME      GET CURRENT FILE NAME
          BX6    X1 
          SA6    DMNAX       STORE IN ERROR MESSAGE 
          MESSAGE DMNAM 
          EQ     DMAM 
 DMEM     SPACE 4 
**        DMEM - OUTPUT ERROR STATUS INTO DAYFILE 
 
 
 DMEM     DATA   0           ENTRY/EXIT 
          SA1    DERROR      GET ERROR STATUS 
          RJ     CDD         CONVERT
          SA6    DMERX       STORE IN ERROR MESSAGE 
          MESSAGE DMERR 
          EQ     DMEM 
 DBGM     SPACE 4 
**        DBGM - OUTPUT BEGIN RECORD INTO DAYFILE 
 
 
 DBGM     DATA   0           ENTRY/EXIT 
          SA1    DBR         GET BEGINNING RECORD NUMBER
          RJ     CDD         CONVERT
          SA6    DMBGX       STORE IN ERROR MESSAGE 
          MESSAGE DMBGR 
          EQ     DBGM 
 DNRM     SPACE 4 
**        DNRM - OUTPUT NUMBER OF RECORDS INTO DAYFILE
 
 
 DNRM     DATA   0           ENTRY/EXIT 
          SA1    DNR         GET NUMBER OF RECORDS
          RJ     CDD         CONVERT
          SA6    DMNRX       STORE IN ERROR MESSAGE 
          MESSAGE DMNRC 
          EQ     DNRM 
 
 
*         ERROR MESSAGES
 
 DMATT    DIS    ,* ERROR IN ATTACHING FILE*
 DMRDM    DIS    ,* ERROR IN READING FILE*
 DMWRM    DIS    ,* ERROR IN WRITING FILE*
 DMNAM    DATA   10H  FILE NAM
          DATA   10HE = 
 DMNAX    DATA   0
          DATA   0
 DMERR    DATA   10H  ERROR ST
          DATA   10HATUS =
 DMERX    DATA   0
          DATA   0
 DMBGR    DATA   10H  BEGINNIN
          DATA   10HG RECORD =
 DMBGX    DATA   0
          DATA   0
 DMNRC    DATA   10H  ENDING R
          DATA   10HECORD = 
 DMNRX    DATA   0
          DATA   0
 
*         ARGUMENT LISTS AND VARIABLES
 
 DWAIT    DATA   10HWAITING FO
          DATA   10HR FILE  - 
 DSNAME   DATA   0           FILE NAME
          DATA   0           END OF MESSAGE 
 DERROR   DATA   0           RETURN STATUS
 DM1      DATA   -1          WRITE PERMISSION 
 DBR      DATA   0           BEGINNING RECORD NUMBER
 DNR      DATA   0           NUMBER OF RECORDS
 CMSG     DATA   1L          CLEAR MESSAGE
 
 DARG1    VFD    60/DSNAME   ARGUMENT LIST FOR ATTACH 
          VFD    60/DERROR
          VFD    60/DM1 
          DATA   0
 
 DARG2    VFD    60/DBR      ARG. LIST FOR DREAD /DWRITE
 DA2M     VFD    60/0        MEMORY LOCATION STORED HERE
          VFD    60/DNR 
          VFD    60/DERROR
          DATA   0
 
 DARG3    VFD    60/DSNAME   ARGUMENT LIST FOR DETACH 
          DATA   0
 
 DARG4    VFD    60/0        B DISPLAY ARGUMENT 
          DATA   0
* /---   BLOCK      COPYPFX    00 000   80/10/27  14.51 
          TITLE  K-DISPLAY ROUTINES 
 BUILDO   SPACE  4
**        BUILDO - BUILD OUTPUT LINE
* 
*         AUDIT INFO IN BUFA
*         BUILDS OUTPUT LINE FOR PRINTER IN BUILD 
 
 BUILDO   DATA   0           ENTRY/EXIT 
          SA1    BUFA        MASTER FILE NAME 
          MX7    42 
          BX1    X7*X1
          RJ     SFN
          LX6    54 
          SA6    BUILD
          SA1    BUFA+1      PACKNAME 
          MX7    42 
          BX1    X7*X1
          RJ     SFN
          SA6    BUILD+1
          SA1    BUFA        NUMBER OF FILES
          SX1    X1 
          RJ     CDD
          MX7    -24
          BX6    -X7*X6 
          LX6    36 
          SA6    BUILD+2
          SA1    BUFA+1      SLOT NUMBER
          MX7    -7 
          BX1    -X7*X1 
          RJ     CDD
          SA1    BUILD+2
          LX6    6
          MX7    -36
          BX6    -X7*X6 
          IX6    X6+X1
          SA6    A1 
          SA1    BUFA+2      VSN/PACK 
          MX7    6           IF TAPE, ADD * 
          BX7    X7*X1
          NZ     X7,BUI1
          SX7    1R*
          LX7    54 
          BX1    X1+X7
 BUI1     MX7    42 
          BX1    X7*X1
          RJ     SFN
          SA6    BUILD+3
          SA1    BUFA+1      EST
          MX7    -6 
          AX1    7
          BX1    -X7*X1 
          RJ     WOD
          MX6    -12
          SA1    BUILD+3
          BX7    -X6*X7 
          BX1    X6*X1
          IX6    X7+X1
          SA6    A1 
          SA1    BUFA+2      YEAR 
          AX1    14 
          MX7    -4 
          BX1    -X7*X1 
          SX1    X1+80
          RJ     CDD
          MX7    -18
          BX6    -X7*X6 
          LX6    42 
          SA6    BUILD+4
          SA1    BUFA+2      MONTH
          AX1    10 
          MX7    -4 
          BX1    -X7*X1 
          RJ     CDD
          SA1    BUILD+4
          MX7    -18
          BX6    -X7*X6 
          LX6    24 
          IX6    X6+X1
          SA6    A1 
          SA1    BUFA+2      DAY
          AX1    5
          MX7    -5 
          BX1    -X7*X1 
          RJ     CDD
          SA1    BUILD+4
          LX6    6
          MX7    -24
          BX6    -X7*X6 
          IX6    X6+X1
          SA6    A1 
          SA1    BUFA+2      HOUR 
          MX7    -5 
          BX1    -X7*X1 
          RJ     CDD
          LX6    6
          MX7    -18
          BX6    -X7*X6 
          LX6    42 
          SA6    BUILD+5
          EQ     BUILDO 
* /---   BLOCK      COPYPFX    00 000   80/11/03  10.40 
 KDISP    SPACE  4
**        DO K-DISPLAY
 
 
 KDISP    DATA   0           ENTRY/EXIT 
          RJ     SETPAR      SET UP PARAMETERS
          NZ     X4,INITERR  IF ERROR IN PARAMS 
          SX6    0           CLEAR GO FLAG
          SA6    GO 
          RJ     ATTAUD      ATTACH AUDIT FILE
 KDSP1    RJ     SETK        SET UP K-DISPLAY PARAMETERS
 KDSP2    REWIND TB,R 
          READ   TB,R 
 KDSP3    READW  TB,BUFA,BUFAL  READ AUDIT ENTRY
          NZ     X1,KDSP11   IF EOR, EOF, EOI 
          SA1    PN          SEE IF PACKNAME SPECIFIED
          ZR     X1,KDSP4 
          SA2    BUFA+1 
          MX7    42 
          BX2    X7*X2
          BX6    X1-X2
          NZ     X6,KDSP3    IF PACKNAMES DO NOT MATCH
 KDSP4    SA1    MF          SEE IF MASTERFILE SPECIFIED
          ZR     X1,KDSP5 
          SA2    BUFA 
          MX7    42 
          BX2    X7*X2
          BX6    X1-X2
          NZ     X6,KDSP3    IF MASTERFILES DO NOT MATCH
 KDSP5    SA1    SL          SEE IF SLOT SPECIFIED
          ZR     X1,KDSP6 
          SA2    BUFA+1 
          MX7    -7 
          BX2    -X7*X2 
          BX6    X1-X2
          NZ     X6,KDSP3    IF SLOT DOES NOT MATCH 
 KDSP6    SA1    MO          SEE IF MONTH SPECIFIED 
          ZR     X1,KDSP7 
          SA2    BUFA+2 
          AX2    10 
          MX7    -4 
          BX2    -X7*X2 
          BX6    X1-X2
          NZ     X6,KDSP3    IF MONTH DOES NOT MATCH
 KDSP7    SA1    DAY         SEE IF DAY SPECIFIED 
          ZR     X1,KDSP8 
          SA2    BUFA+2 
          AX2    5
          MX7    -5 
          BX2    -X7*X2 
          BX6    X1-X2
          NZ     X6,KDSP3    IF DAY DOES NOT MATCH
 KDSP8    SA1    GO          SEE IF IN GO MODE
          ZR     X1,KDSP10   NO GO MODE 
          RJ     SETSTK      ADD TO REQUEST STACK 
          NG     X7,KDSP3    IF NO OVERFLOW 
          RJ     SETBUF      SETUP BUFFER 
          RJ     SETK 
          SB6    TOOMF       TOO MANY FILE SELECTED 
 KDSP9    RJ     MOVEL       MOVE ERROR LINE
          SX6    0           CLEAR GO FLAG
          SA6    GO 
          EQ     KDSP11 
 
 KDSP10   RJ     BUILDO      BUILD OUTPUT LINE
          SB6    BUILD
          RJ     MOVEL       MOVE TO K-DISPLAY BUFFER 
          ZR     X6,KDSP3    IF NO OUTPUT TO TRANSFER 
          EQ     KDSP12 
 
* /---   BLOCK      COPYPFX    00 000   80/11/07  07.34 
 KDSP11   SA1    GO          SEE IF GO MODE 
          NZ     X1,KDSP14
          SB6    0           END MESSAGE
          RJ     MOVEL
          ZR     X6,KDSP2    START OVER IF +
 KDSP12   SA1    =10HXXXXXXXXX.  SET UP FAKE CONTROL CARD 
          SX5    KFILL
          BX6    X1 
          SA6    X5 
          RJ     PRA         STRIP OFF PARAMETERS 
          NZ     X6,KDSP13   IF ERROR IN PARAMETERS 
          SB5    ARGT        ARG TABLE ADDRESS
          RJ     ARG
          NZ     X1,KDSP13   ERROR IN PARAMETERS
          RJ     SETBUF      SET UP BUFFER
          RJ     SETPAR      SET UP PARAMETERS
          NZ     X4,KDSP13   IF ERROR IN PARAMS 
          SA1    GO          SEE IF GO MODE 
          ZR     X1,KDSP1 
          SB6    STACK       ZERO STACK 
          SB7    MAXST*2
          RJ     ZERO 
          SA7    STACKPT     CLEAR STACK POINTER
          EQ     KDSP1
 
 KDSP13   RJ     SETBUF      SET UP BUFFER PARAMS 
          RJ     SETK 
          SB6    INMSG       ERROR IN PARAMS MESSAGE
          RJ     MOVEL
          EQ     KDSP11 
 
 KDSP14   RJ     INITPCK     SEE IF ANY ENTRIES/INITIALIZE
          ZR     X1,KDSP15
          UNLOAD TB,R        GET RID OF AUDIT TRAIL FILE
          MX6    0           RELEASE CONSOLE BUFFERS
          SA6    CMA
          CONSOLE CMA 
          EQ     KDISP
 
 KDSP15   RJ     SETBUF      SEND ERROR MESSAGE 
          RJ     SETK 
          SB6    NOFILE 
          EQ     KDSP9
 MOVEL    SPACE  4
**        MOVEL - MOVE CODED LINE TO LEFT SCREEN BUFFER 
* 
*         MOVES A CODED LINE TO LEFT DISPLAY BUFFER IF ROOM.
*         IF NO ROOM, OUTPUT MESSAGE *+ FOR MORE*, AND
*         WAIT FOR KEYBOARD INPUT.  IF INPUT =*+*, THEN 
*         ZERO BUFFER AFTER HEADER AND MOVE LINE. 
* 
*         ENTRY  B1=1 
*                B6=ADDRESS OF CODED LINE 
*                  IF B6=0, END MESSSAGE SENT 
*                WLINE, WHDR, LLINE, LHDR SET(INIT. 0,1,0,0)
* 
*         EXIT   X6=0, LINE MOVED OK
*                X6.NE.0, INFORMATION IN KEYBOARD BUFFER
*                WLINE, LLINE RESET 
 
 
* /---   BLOCK      COPYPFX    00 000   80/10/30  11.11 
 MOVEL    DATA   0           ENTRY/EXIT 
 MVL1     ZR     B6,MVL7     IF END MESSAGE 
          MX7    -12         CHARACTER MASK 
          SB7    B0          WORD COUNTER 
 MVL2     SA1    B6+B7       GET NEXT WORD
          BX6    -X7*X1      SEE IF BOTTOM 12 BITS ARE ZERO 
          ZR     X6,MVL3     IF END OF LINE 
          SB7    B7+B1       BUMP WORD COUNT
          EQ     MVL2 
 
 MVL3     SA1    WLINE       CURRENT WORD COUNT 
          SB7    B7+B1       CORRECT WORD COUNT FOR LINE
          SX6    X1+B7       TOTAL INCLUDING THIS LINE
          SX7    X6-1000B-3 
          PL     X7,MVL5     IF NOT ENOUGH ROOM IN BUFFER 
          SA6    A1          UPDATE WORD COUNT
          SA2    LLINE       UPDATE NUMBER OF LINES 
          SX6    X2+B1
          SA6    A2 
          SB4    B0          MOVE COUNTER 
          SA3    MAXK        CHECK IF TOO MANY LINES
          IX6    X2-X3
          PL     X6,MVL5
          SB5    X1+LSCR     FIRST STOREAGE ADDRESS 
 MVL4     SA1    B6+B4       NEXT WORD TO TRANSFER
          BX6    X1 
          SA6    B5+B4       STORE IN LEFT SCREEN BUFFER
          SB4    B4+B1       BUMP COUNTER 
          LT     B4,B7,MVL4  IF NOT DONE
          MX6    0           OK FLAG
          EQ     MOVEL       EXIT 
 
 MVL5     SA2    =10L+ FOR MORE  MORE INFO MESSAGE
 MVL6     BX6    X2 
          SX7    B6          SAVE FWA OF MESSAGE
          SA6    LSCR+X1     PUT IN SCREEN BUFFER 
          SA7    LSAVE
          RJ     WAINP       WAIT FOR KEYBOARD INPUT
          NZ     X6,MOVEL    EXIT WITH ERROR FLAG 
          RJ     SETBUF      SET UP BUFFER
          SA1    LSAVE       RESTORE FWA OF LINE
          SB6    X1 
          MX6    0
          ZR     B6,MOVEL    EXIT IF END MESSAGE
          EQ     MVL1        TRY IT AGAIN 
 
 MVL7     SA2    =3LEND      END MESSAGE
          SA1    WLINE       WORD COUNT 
          EQ     MVL6        MOVE END MESSAGE 
 
 WLINE    DATA   0           NUMBER OF WORDS USED IN BUFFER 
 LLINE    DATA   0           NUMBER OF LINES IN BUFFER
 WHDR     DATA   1           NUMBER OF WORDS IN HEADER
 LHDR     DATA   0           NUMBER OF LINES IN HEADER
 LSAVE    DATA   0           SAVE FWA OF LINE 
* /---   BLOCK      COPYPFX    00 000   80/10/29  14.34 
 SETBUF   SPACE  4
**        SETBUF - SET UP BUFFER
* 
*         ZEROS NON-HEADER PORTION OF BUFFER
*         ZERO KEYBOARD BUFFER
*         SETS POINTER TO REFLECT HEADER
 
 
 SETBUF   DATA   0           ENTRY/EXIT 
          SA1    WHDR        ZERO BUFFER AND SET LINE COUNT 
          SA2    LHDR 
          BX6    X1 
          BX7    X2 
          SA6    WLINE
          SA7    LLINE
          SB6    X1+LSCR
          SB7    X1-1000B    - WORD COUNT 
          SB7    -B7
          RJ     ZERO 
          SB6    KBUF        ZERO KEYBOARD BUFFER 
          SB7    KEND-KBUF
          RJ     ZERO 
          EQ     SETBUF 
 SETK     SPACE  4
**        SETK - SET UP K-DISPLAY PARAMETERS
 
 
 SETK     DATA   0           ENTRY/EXIT 
 .NOS23   IFGE   "MODLEVEL",617D
          CSTATUS CTYPE      GET CONSOLE TYPE 
          SA1    CTYPE
          MX6    12 
          BX1    X6*X1
          ZR     X1,SETK1    IF CC545 CONSOLE 
          SX6    MAXK721     RESET MAX LINES
          SA6    MAXK 
 .NOS23   ENDIF 
 SETK1    SX6    B1          SET UP SCREEN BUFFERS
          SA6    WLINE       NUMBER OF WORDS
          LX6    48 
          SX7    0
          SA7    LLINE       LINE COUNT 
          SA6    LSCR        SET DISPLAY MODES
          SA6    RSCR 
          SA1    PN          FORMAT PACKNAME
          RJ     SFN
          MX7    42 
          BX6    X7*X6
          SX7    3RPN=
          IX6    X6+X7
          LX6    42 
          SA6    PLINE+1
          SA1    MF          FORMAT FILENAME
          RJ     SFN
          MX7    42 
          BX6    X7*X6
          SX7    3RMF=
          IX6    X6+X7
          LX6    42 
          SA6    PLINE+3
          SA1    SL          FORMAT SLOT
          RJ     CDD
          MX7    42 
          BX4    X7*X4
          SX6    3RSL=
          BX6    X6+X4
          LX6    36 
          BX6    X7*X6
          SA6    PLINE+4
          SA1    DA          FORMAT DATE
          RJ     CDD
          MX7    42 
          BX4    X7*X4
          SX6    3RDA=
          BX6    X6+X4
          LX6    36 
          SA6    PLINE+2
          SB6    PLINE       MOVE HEADER LINES
          RJ     MOVEL
          SB6    =1L
          RJ     MOVEL
          SB6    LINE1
          RJ     MOVEL
          SB6    LINE2
          RJ     MOVEL
          SA1    WLINE       NUMBER OF WORDS IN HEADER
          BX6    X1 
          SA6    WHDR 
          SX6    4           NUMBER OF LINES IN HEADER
          SA6    LHDR 
          CONSOLE CMA        CALL CONSOLE 
          EQ     SETK 
 
 CTYPE    BSS    1
* /---   BLOCK      COPYPFX    00 000   80/10/29  14.43 
 SETPAR   SPACE  4
**        SETPAR - SETUP PARAMETERS 
* 
*         CONVERT DATE/SLOT PARAMETERS
* 
*         EXIT   X4=0 IF OK, X4.NE.0 IF ERROR 
 
 
 SETPAR   DATA   0           ENTRY/EXIT 
          SA5    SLOT        CONVERT SLOT 
          SX6    B1 
          IX6    X5-X6
          MX4    0           EXIT FLAG
          SB7    B1          BASE FLAG = DECIMAL
          ZR     X6,SETP1 
          RJ     DXB         CONVERT
 SETP1    NZ     X4,SETPAR   IF ERROR 
          SA6    SL          STORE CONVERTED NUMBER 
          SA5    DATE        CONVERT DATE 
          SX6    B1 
          IX6    X5-X6
          ZR     X6,SETP2 
          RJ     DXB         CONVERT
 SETP2    NZ     X4,SETPAR   IF ERROR 
          SA6    DA          STORE CONVERTED NUMBER 
          SX5    100         FIND MONTH 
          BX1    X6 
          IX7    X6/X5
          SA7    MO 
          SX5    100
          IX7    X7*X5       FIND DAY OF MONTH
          IX7    X1-X7
          SA7    DAY
          EQ     SETPAR 
 SETSTK   SPACE  4
**        SETSTK - SET PARAMETERS IN STACK
* 
*         GOOD AUDIT ENTRY AT BUFA
*         STACKPT - SET TO CURRENT STACK ENTRY
* 
*         EXIT   X7.LT.0 - ENTRY INSERTED, X7=+ - OVERFLOW
 
 
 SETSTK   DATA   0           ENTRY/EXIT 
          SA2    STACKPT     CURRENT STACK POINTER
          SA1    BUFA        GET MASTER FILE NAME 
          MX7    42 
          BX6    X7*X1
          SA6    STACK+X2 
          SA1    BUFA+2      GET VSN/PACK NAME
          BX6    X7*X1
          SA6    A6+B1
          SX7    X2+2        INCREMENT STACK POINTER
          SA7    A2 
          SX7    X7-MAXST2-1 TEST FOR OVERFLOW
          EQ     SETSTK 
 WAINP    SPACE  4
**        WAINP - WAIT FOR KEYBOARD INPUT 
* 
*         EXIT   X6=0, FIRST CHARACTER OF INPUT IS A *+*
 
 
 WAINP    DATA   0
 WAI1     RECALL             WAIT FOR USER INPUT
          SA1    KBUF        SEE IF USER INPUT
          ZR     X1,WAI1     IF NO INPUT
          MX6    6           SEE IF *+* 
          BX6    X6*X1
          LX6    6
          SX6    X6-1R+ 
          EQ     WAINP
* /---   BLOCK      COPYPFX    00 000   87/03/18  14.33 
 DEBUG    SPACE  4
 DEBUG    DATA   0           ENTRY/EXIT 
          RJ     CDD
          SA6    DMSG 
          MESSAGE DMSG
          EQ     DEBUG
 DEBUGX   DATA   0           ENTRY/EXIT 
          BX7    X2 
          SA7    DMS
          RJ     CDD
          SA6    DMSG 
          MESSAGE DMS 
          EQ     DEBUGX 
 SHOW     DATA   0
          BX6    X1 
          SA6    DMSG 
          RJ     WOD
          SA6    DMSA 
          SA7    A6+B1
          MESSAGE DMSA
          EQ     SHOW 
 MESSX    DATA   0           ENTRY/EXIT 
          BX7    X2 
          SA7    DMS
          BX6    X1 
          SA6    DMSG 
          MESSAGE DMS 
          EQ     MESSX
* /---   BLOCK      ARG        00 000   87/03/18  14.08 
 ARG      TITLE  ARG - PROCESS ARGUMENTS. 
***       ARG - PROCESS ARGUMENTS.
*         G. R. MANSFIELD.  70/10/09. 
* 
*         THIS IS A COPY OF NOS COMMON DECK  COMCARG. 
* 
*         AFTER PARSING THE CONFORMING ARGUMENTS, THE *INIT*
*         ROUTINE MODIFIES THE CODE TO ACCEPT 10 CHARACTER
*         ARGUMENTS (THOSE FOLLOWING THE CLOSE PARENTHESIS
*         OR PERIOD) FOR THE *Z* PARAMETER. 
* 
          IF     -DEF,QUAL$,1 
          QUAL   COMCARG
          BASE   D
 ARG      SPACE  4
***              ARG PROCESSES AN ARGUMENT LIST BY THE USE OF AN
*         EQUIVALENCE TABLE.
* 
*         ENTRY  (B1) = 1.
*                (B4) = ARGUMENT COUNT. 
*                (A4) = ADDRESS OF FIRST ARGUMENT.
*                (X4) = FIRST ARGUMENT. 
*                (B5) = ADDRESS OF ARGUMENT TABLE IN ONE OF THE 
*                       FOLLOWING FORMS - 
*                       1.  12/ OP, 18/ ASV, 12/ ST, 18/ ADDR 
*                       2.  12/ 77B, 18/ ASV, 12/ ST, 18/ ADDR
*                           42/ OP, 18/0
*                            77B = INDICATION THAT TWO-WORD ENTRY TABLE 
*                                  FORMAT WAS USED. 
*                            OP = ONE TO SEVEN CHARACTER OPTION.
*                            ASV = ADDRESS OF ASSUMED VALUE.
*                            ST = STATUS. 
*                            ADDR = ADDRESS TO STORE ARGUMENT.
*                       THE LOWER 18 BITS OF THE ASSUMED VALUE ARE
*                       ENTERED INTO THE EQUIVALENCED ARGUMENT. 
*                       IF *ASV* .LT. 0, THE ARGUMENT MUST NOT BE 
*                       EQUIVALENCED. 
*                       IF *ASV* = *ADDR*, ONLY ONE ENTRY OF THAT 
*                       ARGUMENT WILL BE ALLOWED (*OP* IS SET TO - 0).
*                       IF STATUS = 4000B, A ZERO *0* PARAMETER IS
*                       RETAINED AS A DISPLAY ZERO, OTHERWISE A 
*                       VALUE OF ZERO IS STORED.
* 
*         EXIT   (X1) .NE. 0, IF ARGUMENT ERROR DETECTED. 
*                AN ERROR STATUS IS RETURNED FOR THE FOLLOWING
*                CONDITIONS - 
*                1.  OPTION NOT FOUND IN TABLE
*                2.  SINGLE ARGUMENT EQUIVALENCED 
*                3.  ILLEGAL RE-ENTRY OF ARGUMENT 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4. 
*                A - 2, 3, 4, 7.
 
* /---   BLOCK      ARG        00 000   87/03/18  14.02 
 
 ARG      SUBR               ENTRY/EXIT 
          MX0    42 
          SX1    B0 
          ZR     B4,ARGX     IF NO ARGUMENTS
          SX1    B1          PRESET ERROR 
 
*         SEARCH FOR MATCH IN ARGUMENT TABLE. 
 
 ARG1     ZR     X4,ARGX     IF NULL ARGUMENT 
          SA2    B5-B1
          MX3    12 
          SB3    12 
 ARG1.1   SA2    A2+B1       GET NEXT OPTION
          ZR     X2,ARGX     IF END OF OPTION TABLE 
          SB2    B0 
          BX6    X3*X2       CHECK FOR KEYWORD MATCH
          LX7    X6,B3
          SX7    X7-77B 
          NZ     X7,ARG1.2   IF ARGUMENT LESS THAN THREE CHARACTERS 
          SB2    B1 
          SA2    A2+B1       GET SECOND WORD OF THE ENTRY 
          BX6    X0*X2       GET OPTION 
 ARG1.2   BX7    X4-X6
          BX7    X0*X7
          NZ     X7,ARG1.1   IF NO MATCH
 
*         CHECK FOR EQUIVALENCE ALLOWED.
 
          ZR     B2,ARG2     IF ONE WORD ENTRY
          SA2    A2-B1
 ARG2     SX7    X4-1R=      CHECK FOR EQUIVALENCE SEPARATOR
          SB2    X2          SET VALUE ADDRESS
          LX2    30          GET ASSUMED VALUE
          ZR     X7,ARG2.1   IF NOS *=* 
          SX7    X4-2        CHECK FOR PRODUCT SET FORMAT *=* 
 ARG2.1   SB3    X2 
          PL     B3,ARG3     IF EQUIVALENCE ALLOWED 
          SA3    -B3         ASSUMED VALUE
          BX6    -X0*X3      ASSUMED STATUS 
          SB3    -B3
          NZ     X7,ARG5     IF ARGUMENT NOT EQUIVALENCED 
          SA4    A4+B1
          SB4    B4-B1
          ZR     X4,ARG6     IF NULL PARAMETER
          EQ     ARGX        RETURN 
 
* /---   BLOCK      ARG        00 000   87/03/18  14.04 
*         PROCESS EQUIVALENCE.
 
 ARG3     SA3    B3          ASSUMED VALUE
          BX6    -X0*X3      ASSUMED STATUS 
          NZ     X7,ARG5     IF ARGUMENT NOT EQUIVALENCED 
          SA4    A4+B1       CHECK EQUIVALENCE
          SB4    B4-B1
          BX3    X4          CHANGED TO BX3 X0*X4 IN NOS 670
          AX4    42 
          NG     X2,ARG4     IF DISPLAY ZERO REQUESTED
          SX2    X4-1L0 
 ARG4     ZR     X3,ARG6     IF NULL PARAMETER
          NZ     X2,ARG5     IF NOT *0* 
          SX3    B0          CLEAR EQUIVALENCE
          SX6    B0          CLEAR STATUS 
 
*         ENTER ARGUMENT. 
 
 ARG5     BX3    X0*X3       MERGE ARGUMENT AND STATUS
          IX7    X3+X6
          SA7    B2          STORE ARGUMENT 
          SB3    B2-B3
          NZ     B3,ARG6     IF ASSUMED VALUE NOT IN ARGUMENT ADDRESS 
          SA2    A2 
          MX3    12 
          BX4    -X3*X2 
          BX7    X3+X4       SET OP = -0 IF ONLY ONE ARGUMENT ALLOWED 
          SA7    A2 
 ARG6     SB4    B4-B1       CHECK FOR MORE ARGUMENTS 
          SA4    A4+B1
          NZ     B4,ARG1     IF MORE ARGUMENTS TO PROCESS 
          SX1    B0          CLEAR ERROR
          EQ     ARGX        RETURN 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 ARG      EQU    /COMCARG/ARG 
 QUAL$    ENDIF 
* /---   BLOCK      MESSAGES   00 000   87/03/18  14.33 
          TITLE  MESSAGES, BUFFERS, DATA AREAS AND COM DECKS
 
 
*         DISPLAY MESSAGES
 
 
 TOFIWE   MESSAGE TOFIW 
          EQ     ABORT
 TONAME   MESSAGE TONAM 
          EQ     ABORT
 TOTYPE   MESSAGE TOTYP 
          EQ     ABORT
 TOACCE   MESSAGE TOACT 
          EQ     ABORT
 TOSIZX   MESSAGE TOSIZ 
          EQ     ABORT
 FFNAME   MESSAGE FFNAM 
          EQ     ABORT
 
 
 INMSG    DIS    ,* ERROR IN PARAMETERS.* 
 PROM     DIS    ,* ERROR IN PROCESSOR TABLE.*
 WRONG    DIS    ,* DUMP FILE ASSIGNED TO DISK* 
 BLANK    DIS    ,* DO NOT USE BLANK LABEL TAPE*
 PROFM    DIS    ,* TOO MANY FILES IN MASTER FILE.* 
 TOFIW    DIS    ,* FIW OF TO FILE NOT BACKUP TYPE* 
 TONAM    DIS    ,* NAMES OF TO FILES DOES NOT MATCH* 
 FFNAM    DIS    ,* NAMES OF FROM FILES DOES NOT MATCH* 
 TOTYP    DIS    ,* TO FILE TYPE NOT BACKUP*
 TOSIZ    DIS    ,* FILE SIZES DO NOT MATCH*
 TOACT    DIS    ,* FILE ACCOUNTS DO NOT MATCH* 
 TOOMF    DIS    ,* TOO MANY FILES SELECTED*
 NOFILE   DIS    ,* NO FILES SELECTED*
 NOTREQ   DATA   0           MASTER FILE NAME 
          DIS    ,* - MASTER FILE NOT REQUESTED*
 PROIE    DIS    ,* FROM FILE SIZE WRONG* 
 PROGM    DATA   0           FILE NAME
          DATA   30H - FILE NOT FOUND IN MASTER FI
 PROGM1   DATA   3LLE        MASTER FILE NAME ADDED HERE
          DATA   0
 TOOBIG   DIS    ,* FILE NOT COMPLETELY CONTAINED IN M.F.*
 RECOV    DATA   0           MASTER FILE NAME 
          DIS    ,* - MASTER FILE RECOVERED*
 REING    DATA   10HRESTORING 
          DATA   0,0
 PLINE    DATA   10HPARAMS -
          DATA   3HPN=
          DATA   4H DA= 
          DATA   3HMF=
          DATA   4L SL= 
 LINE1    DIS    ,= MASTER-  PACKNAME  FILE SLOT VSN(*) EST YY MM DD HH=
 LINE2    DIS    ,= FILE                         PACK=
 DMSA     DATA   0
 DMS      DATA   0
 DMSG     DATA   0,0         DEBUG MESSAGE AREA 
 
 
*         ARGUMENT TABLE
 
 
 ARGTBL   BSS    0
          VFD    12/1LV,18/ONE,30/VSNX
          VFD    12/1LZ,18/ONE,30/Z 
          VFD    12/2LFF,18/FF,30/FF
          VFD    12/2LTF,18/TF,30/TF
*          VFD    12/2LSP,18/PACK,30/PACK 
*          VFD    12/2LAP,18/APER,30/APER 
 ARGT     BSS    0
          VFD    12/2LPN,18/ZRO,30/PN 
          VFD    12/2LMF,18/ZRO,30/MF 
          VFD    12/2LGO,18/ONE,30/GO 
          VFD    12/2LSL,18/ONE,12/4000B,18/SLOT
          VFD    12/2LDA,18/ONE,12/4000B,18/DATE
 ARGTBLE  DATA   0           END OF TABLE 
 
 
* /---   BLOCK      DATA       00 000   80/11/17  11.01 
 
*         COUNTERS AND PARAMETERS 
 
 COUNT    DATA   0           BLOCK COUNT
 WCOUNT   DATA   0           BEGINNING WORD COUNT 
 ECOUNT   DATA   0           ENDING WORD COUNT
 MFNAME   DATA   0           MASTER FILE NAME 
 MFTYPE   DATA   0           MASTER FILE TYPE 
 NFILES   DATA   0           NUMBER OF FILES
 MFILES   DATA   0           MAX. NUMBER OF FILES 
 OFFSET   DATA   0           FILE OFFSET
 PACKNAM  DATA   0           PACKNAME 
 VSN      DATA   0           VSN NUMBER (ACTUAL)
 VSNX     DATA   0           VSN NUMBER (USER REQUEST)
 Z        DATA   0           EXTENDED PARAMETER FLAG
 ONE      DATA   1           CONSTANT ONE 
 ZRO      DATA   0           CONSTANT ZERO
 PN       DATA   0           USER PACK NAME FOR DUMPED FILE 
 FF       DATA   0           FROM FILE
 TF       DATA   0           TO FILE
 MFCT     DATA   0           MASTER FILE COUNT
 WCWANT   DATA   0           WORD COUNT WANTED
 BACKUP   DATA   10HBACKUP   )  BACKUP FILE TYPE
 TOSIZE   DATA   0           TO FILE SIZE (PARTS) 
 TOACCT   DATA   0           TO FILE ACCOUNT
 PACK     DATA   0           PACK NAME FOR ATTACHES 
 APER     DATA   5LAUDIT     PERMANENT FILE FOR AUDIT 
 MF       DATA   0           MASTER FILE NAME 
 SL       DATA   0           SLOT NUMBER
 SLOT     DATA   0           SLOT NUMBER/FLAG 
 DA       DATA   0           DATE 
 MO       DATA   0           MONTH
 DAY      DATA   0           DAY OF MONTH 
 DATE     DATA   0           DATE/FLAG
 GO       DATA   0           GO FLAG
 STACKPT  DATA   0           STACK POINTER
 STATUS   DATA   0           STATUS OF READ REQUEST 
 THISONE  DATA   0           POINTER TO CURRENT STACK ENTRY 
 MAXK     CON    MAXK545     MAX LINES ON K-DISPLAY 
 CMA      VFD    24/KBUF,18/RSCR,18/LSCR  K-SCREEN PARAMS 
 
*         RESERVE BUFFER SPACE
 
 WORK     BSSZ   WORKL       WORKING BUFFER 
 IBUF     BSSZ   LBUFL       INPUT CIRCULAR BUFFER
 TBUF     BSSZ   BUFL        TEMP CIRCULAR BUFFER 
 FILN     BSSZ   MAXFIL      FILE NAMES 
 FILI     BSSZ   MAXFIL      FILE INFO AND LOCATION 
 
*         SCREEN LOCATIONS
 
 RSCR     EQU    IBUF        RIGHT SCREEN 
 LSCR     EQU    RSCR+1000B  LEFT SCREEN
 KFILL    EQU    LSCR+1000B  KEYBOARD FILL IN COMMAND 
 KBUF     EQU    KFILL+1     KEYBOARD BUFFER
 KEND     EQU    KBUF+9      END OF KEYBOARD BUFFER 
 BUILD    EQU    KEND        BUILD AUDIT OUTPUT LINE
 BUFA     EQU    BUILD+6     READ AUDIT INFO
 BUFAL    EQU    3           LENGTH OF AUDIT INFO 
 BEND     EQU    BUFA+BUFAL  END OF BUFFERS 
 
*         STACK 
 
 STACK    EQU    FILN        REQUEST STACK
* /---   BLOCK      COMMONS    00 000   87/03/18  14.37 
 
*         COMMON DECKS. 
 
 
*CALL     COMCCIO 
*CALL     COMCRDS 
*CALL     COMCRDW 
*CALL     COMCSYS 
*CALL     COMCWTS 
*CALL     COMCWTW 
*CALL     COMCCDD 
*CALL     COMCWOD 
*CALL     COMCMVE 
*CALL     COMCSFN 
*CALL     COMCCPM 
*CALL     COMCPFM 
*CALL     COMCLFM 
*CALL     COMCDXB 
 
          ORG    RSCR+1 
          DIS    ,*  COPYPF PARAMETER HELP SEQUENCE*
          DIS    ,* * 
          DIS    ,* K.MF=MASTER FILE NAME*
          DIS    ,* K.PN=PACK NAME* 
          DIS    ,* K.SL=SLOT NUMBER* 
          DIS    ,* K.DA=DATE (MMDD FORMAT, MM=MONTH, DD=DATE)* 
          DIS    ,* * 
          DIS    ,* K.+ WILL ADVANCE THE ENTRIES OR START OVER* 
          DIS    ,* IF AT THE END OF THE ENTRIES* 
          DIS    ,* * 
          DIS    ,* K.GO WILL START THE PROCESSING* 
          DATA   0
 
          ORG    *
 
 
          END    COPYPF