*COMDECK,COPYCOM
**
*                COPYCOM COMDECK
**
          SPACE  2
**
* 
*         COPYCOM CONTAINS ALL THE CODE NEEDED FOR COPYBR, COPYCR,
*         COPYBF, AND COPYCF.  THE FOLLOWING SYMBOLS DEFINE HOW COPYCOM 
*         IS ASSEMBLED FOR THE PARTICULAR COPY OPERATION DESIRED: 
* 
*            FRFLAG    = 20B IF RECORD COPY 
*                      = 30B IF FILE COPY 
* 
*            CMODE     = 10B MODE OF COPY IS CODED
*                      = 12B MODE OF COPY IS BINARY 
* 
*         COPYCOM PERFORMS THE FOLLOWING TASKS: 
* 
*            A. CHECK PARAMETERS AND DEFAULT NULL ONES
* 
*            B. SET FET POINTERS/REGISTERS FOR BUFFER MANAGEMENT
*               (THE BUFFER IS DEPENDENT ON THE FIELD LENGTH MINUS
*                PROGRAM SIZE, ABOUT 600B.  ABOUT ONE HALF OF THE 
*                BUFFER IS IN USE AT ANY ONE TIME AND IS THE RESTRICTION
*                ON READING/WRITING L TAPES)
* 
*            C. OPEN THE FILES AND SET VARIOUS FLAGS/FIELDS 
* 
*            D. REFORM ACTUAL COPU USING ONE BUFFER CIRCULARLY BETWEEN
*               TWO I/O FETS
* 
*            E. TERMINATION AND MESSAGE ISSUING 
* 
* 
          SPACE  4
* 
*                DEFINTIONS AND MACROS
* 
          SPACE  1
*                FET WORD SYMBOLS 
CODE      EQU    0           CODE WORD
STATUS    EQU    0           STATUS WORD
FIRST     EQU    1           FIRST WORD 
DTYPE     EQU    1           DEVICE TYPE WORD 
FLAGS     EQU    1           FLAGS WORD 
IN        EQU    2           IN WORD
OUT       EQU    3           OUT WORD 
LIMIT     EQU    4           LIMIT WORD 
UBC       EQU    6           UBC WORD 
MLRS      EQU    6           MLRS WORD
LABINF    EQU    9           LABEL INFROMATION STARTING WORD
MFNAM     EQU    12D         MULTI-FILE NAME WORD 
          SPACE  1
          IFEQ   FRFLAG,30B  SET TYPE MICRO TO FILE/RECORD
TYPE      MICRO  1,,*FILE*
          ELSE
TYPE      MICRO  1,,*RECORD*
          ENDIF 
          SPACE  1
          IFEQ   CMODE,12B   SET ENTRY POINT NAME 
ENTRY     MICRO  1,6,*COPYB"TYPE"*
          ELSE
ENTRY     MICRO  1,6,*COPYC"TYPE"*
          ENDIF 
          SPACE  4
*         CENM --- CENTRAL ENTRY/EXIT MACRO 
* 
*         DEFINES CELL  FOR RETURN JUMP INTO A SUBROUTINE 
* 
          SPACE  1
CENM      MACRO 
          SB0    A0-0        SET CELL UNINITIALIZED 
          JP     400000B+*   .
CENM      ENDM
          SPACE  4
*         CHKDT --- CHECK DEVICE TYPE AND TRANSFER
* 
*         THIS MACRO TAKES AS INPUT  A SERIES OF &DEVICE TYPE PAIR& 
*         PARAMETERS AND GENERATES CODE TO CHECK FOR PARTICULAR DEVICE
*         OR DEVICE RANGES.  IF THE DEVICE TYPE FOUND IN X2 MATCHES THE 
*         GIVEN CRITERION THEN A JUMP IS TAKEN TO &ADR& FOR THE GIVEN 
*         &DEVICE TYPE PAIR&.  IF &ADR& IS NULL, THE LAST NON-NULL &ADR&
*         GIVEN IN A &DEVICE TYPE PAIR& WILL BE USED. 
* 
*         A &DEVICE TYPE PAIR& IS OF THE FORMS: 
* 
*            (NN,ADR)        CHECK FOR DEVICE TYPE NN 
*            (@NN,ADR)       CHECK FOR DEVICE TYPE @NN
*            (\NN,ADR)       CHECK FOR DEVICE TYPE \NN
*            (NN-MM,ADR)     CHECK FOR DEVICE TYPE \NN BUT @MM
* 
*            WHERE NN OR MM IS TWO OCTAL DIGITS 
* 
*         &CHKDT& IS CALL AS ONE OF THE FOLLOWING:  
* 
*            CHKDT  ((DEVICE TYPE PAIR))
* 
*            CHKDT  ((DEVICE TYPE PAIR 1)),,,(DEVICE TYPE PAIR N))
* 
*         GENERATED CODE USES X6 FOR SCRATCH. 
          SPACE  1
CHKDT     MACRO  DTPAIR 
*         LOOP ON EACH DEVICE TYPE PAIR 
          IRP    DTPAIR 
          PRODTP DTPAIR 
          IRP 
CHKDT     ENDM
          SPACE  4
*         PRODTP --- PROCESS DEVICE TYPE PAIR 
* 
*         THIS MACRO HANDLES EACH &DEVICE TYPE PAIR& GIVEN IT BY
*         THE &CHKDT& MACRO ABOVE.
* 
          SPACE  1
PRODTP    MACRO  DTRNG,ADR
          LOCAL  CHAR,VAL,VAL1
*         SET UP JUMP ADDRESS 
          IFC    NE,,ADR,,,1
*         NON-NULL ADR GIVEN , SET MICRO TO IT
JADR      MICRO  1,,,ADR, 
*         GET FIRST CHAR OF DEVICE TYPE RANGE EXPRESSION
CHAR      MICRO  1,1,,DTRNG,
*         CHECK AND DO @ NN CASE
          IFC    EQ,,"CHAR",@,,4
VAL       MICRO  2,2,,DTRNG,
          SX6    X2-"VAL"B-1
          NG     X6,"JADR"
          SKIP   5+9+2
*         CHECK AND DO \NN CASE 
          IFC    EQ,,"CHAR",\,,4
VAL       MICRO  2,2,,DTRNG,
          SXL    X2-"VAL"B
          PL     X2,"JADR"
          SKIP   9+2
*         CHECK AND DO NN-MM CASE 
CHAR      MICRO  3,1,,DTRNG,
          IFC    EQ,,"CHAR",-,,7
VAL       MICRO  1,2,,DTRNG,
VAL1      MICRO  4,2,,DTRNG,
+         SX6    X2-"VAL1"B-1 
          PL     X6,*+2 
+         SX6    X2-"VAL"B
          PL     X6,"JADR"
          SKIP   2
*         DO NN CASE
          SX6    X2-DTRNG_B 
          ZR     X6,"JADR"
PRODTP    ENDM
          SPACE  2
JADR      MICRO  1,,*UNDEFINED*        INITIALIZE JADR MICRO
          SPACE  4
* 
*                PROGRAM ENTRY
* 
          SPACE  1
"ENTRY"   BSS    0           COPYXX ENTRY 
          TITLE  DEFAULT PARAMTERS
  
  
          SPACE  4
*         THIS CODE CHECKS FOR CONTINUATION OF PARAMETER FROM 
*         ONE CM WORD TO THE NEXT,INDICATING IT IS LONGER 
*         THAN 7 CHARACTERS.
          SA1    64B
          SB3    X1 
          SB4    1
          LT     B3,B4,GOAHEAD
          SA4    2
          SX2    17B
          BX3    X4*X2
          SB2    X3 
          EQ     B0,B2,ERR0        LFN GT 7 CHARACTERS
          SA1    64B
          SB3    X1 
          SB4    2
          LT     B3,B4,GOAHEAD
          SA4    3
          BX3    X4*X2
          SB2    X3 
          EQ     B0,B2,ERR0        LFN GT 7 CHARACTERS
* 
* 
*DEFAULT. THE FOLLOWING OPEN SUBROUTINE SUPPLIES DEFAULT VALUES 
*         (TABLE DEFAULT) TO THE PARAMETER LIST (PARAM) AT RA+2 
* 
GOAHEAD   SA1    64B
          SB1    X1 
          MX0    42 
GRUNCH    SA1    B1+1 
          BX6    X0*X1
          SA6    A1 
          SB1    B1-1 
          PL     B1,GRUNCH         WIPE OUT ALL GARBAGE 
          SB2    NDFLT             LENGTH, TABLE DEFAULT
          SA1    64B
          SB1    X1                PARAMETER COUNT
DFLT1     GE     B1,B2,DFLT2
          SA2    B1+DEFAULT 
          BX6    X2 
          SA6    B1+PARAM          DEFAULT VALUE TO PARAMETER LIST
          SB1    B1+1 
          EQ     DFLT1
DFLT2     EQ     B2,B0,DFLTOUT
          SB2    B2-1 
          SA1    B2+PARAM 
          NZ     X1,DFLT2          TEST FOR NULL PARAMETER
          SA2    B2+DEFAULT        NULL FOUND 
          BX6    X2 
          SA6    B2+PARAM          DEFAULT VALUE TO PARAMETER LIST
          EQ     DFLT2
* 
PARAM     EQU    2           START OF PARAMETER LIST IN LOW CORE
LFNIN     EQU    2           INPUT FILE NAME
LFNOUT    EQU    3           OUTPUT FILE NAME 
N         EQU    4           RECORD/FILE COUNT IN DISPLAY CODE
* 
NDFLT     EQU       3              LENGTH OF DEFAULT TABLE
DEFAULT   DATA      L*INPUT*
          DATA      L*OUTPUT* 
          DATA      L*1*
* 
DFLTOUT   BSS    0
*DEFAULT. END 
          TITLE  SET FET POINTERS AND "TYPE" COUNT
  
  
* 
*                SET SEVERAL REGISTER CONSTANTS 
* 
          SPACE  1
          SB1    1           B1 = ONE 
          MX0    42          X0 = 42 BIT MASK 
          SPACE  4
* 
*                SET FET POINTERS 
* 
          SPACE  1
          SX6    A0          GET PROGRAM FIELD LENGTH 
          SA6    OPENIL      SET OPEN FET LIMITS
          SA6    OPENOL      .
          SPACE  1
          SX1    BUF         GET PROGRAM SIZE 
          SB5    X6          B5 = FL = BUFFER LIMIT 
          SX6    B5          .
          IX2    X6-X1       X2 = FL-PROG SIZE = BUFFER SIZE(EVEN)
          AX2    1           1/2 BUFFER SIZE = (FL-PROG SIZE)/2 
          SX3    X2-513D     1/2 BUF SIZE MUST BE \ 513D(SCOPE TAPE PRU)
          NG     X3,ERR1     ERROR,INSUFFICIENT FIELD LENGTH
          SPACE  1
          SB3    X2          B3 = BUFFER SIZE/2 
          SB4    X1          B4 = BUFFER FIRST
          SA6    FET1+LIMIT  SET READ FET LIMIT = FL
          SA6    FET2+LIMIT  SET WRITE FET LIMIT = FL 
          SX6    B4+B3       SET READ FET OUT TO DELIMIT READ 
          SA6    FET1+OUT    TO MIDDLE OF BUFFER
          SPACE  4
* 
*                 CONVERT RECORD/FILE COUNT TO BINARY 
* 
           SPACE 1
          SX5    B0          SET UP REGISTERS TO CONVERT
          SX2    77B         DISPLAY CODE COUNT TO BINARY 
          SA1    N           GET DISPLAY CODE COUNT 
          SPACE  1
CVRTL     LX1    6           GET HIGH ORDER CHAR AT TOP OF WORD 
          BX3    X2*X1       .
          ZR     X3,CVRTF    NONE,CONVERSION DONE 
          SX4    X3-1R9-1    CHECK CHAR 
          PL     X4,ERR2     ERROR IF CHAR > 9
          SX3    X3-1R0      .
          NG     X3,ERR2     ERROR IF CHAR < 0
          BX4    X5          VALUE TO X4
          LX5    2           VALUE*4
          IX5    X5+X4       VALUE*4+VALUE = 5*VALUE
          LX5    1           (VALUE*4+VALUE)*2 = 10* VALUE
          IX5    X5+X3       VALUE = 10*VALUE+NEXT DIGIT
          EQ     CVRTL       LOOP 
          SPACE  1
CVRTF     SB2    X5          *** SAVE FILE/RECORD COUNT IN B2 *** 
          EQ     B2,B0,ERR2  ERROR IF COUNT IS ZERO 
          SX6    B2          GO SAVE COUNT IN MEMORY
          BX6    -X0*X6      .
          SA6    A1          .
          IX6    X5-X6       CHECK FOR COUNT GT 2**18-1 
          NZ     X6,ERR2A    ERROR IF COUNT TO HIGH 
          TITLE  OPEN FILE PROCESSING 
  
  
* 
*                 OPEN INPUT FILE 
* 
           SPACE 1
OPENIN    BSS    0           OPEN INPUT FILE
          SA1    LFNIN       GET FILENAME 
          SX2    120B        PLUS CODE
          BX1    X0*X1       .
          BX7    X1+X2       GOES 
          SA7    OPENI       OPEN INPUT FET 
          SX2    CMODE       THE FILENAME PLUS COPY MODE
          BX6    X1+X2       GOES 
          SA6    A1          BACK TO &LFNIN&
          SA1    CIOOPE      FORM CIO REQUEST FOR OPEN
          SX2    A7          .
          IX5    X1+X2       .
          RJ     CALL        ISSUE OPEN 
          SPACE  1
          SA1    A7+FLAGS    MOVE FLAGS SET BY OPEN TO READ FET 
          MX2    12          .
          LX2    60-12       .
          SA5    FET1+FLAGS  .
          BX3    X2*X1       .
          BX6    X5+X3       .
          SA6    A5          .
DTYPE     EQU    FLAGS       .
          MX2    6           NOW GET INPUT FILE DEVICE TYPE 
          BX2    X1*X2       .
          LX2    6           .
          CHKDT  ((@37,OPENOUT))                 IF ALLOCATABLE,CONTINUE
          CHKDT  ((@41,TAPEIN),(@43,MFITAPE))    GO PROCESS TAPE DEVICES
          CHKDT  ((60,OPENOUT))        IF UNIT REC DEVICES,CONTINUE 
          CHKDT  ((61,OPENOUT))    IF A CONNECTED FILE CONTINUE 
          EQ     ERR3        ERROR, ILLEGAL DEVICE
          SPACE  1
MFITAPE   SX6    B1          SET MULTI-FILE FLAG FOR MULTI-FILE 
          SA6    MFTFLG      INPUT TAPE FILE
          SPACE  1
TAPEIN    LX1    12          IS TAPE LABELED
          SX2    14B         .
          BX3    X1*X2       .
          ZR     X3,TAPEIN1  NO,CONTINUE
          BX3    X3-X2       .
          ZR     X3,ERR3     ERROR,ILLEGAL DEVICE - UNKNOWN LABEL CODE
          SB6    LABINF      SET UP TO MOVE OPEN INPUT FET LABEL INFORM.
          SB7    4           TO OUTPUT OPEN FET IN CASE THAT FILE N LABL
MOVLAB    SA2    OPENI+B6    MOVE WORD
          BX6    X2          .
          SA6    OPENO+B6    .
          SB7    B7-B1       CORRECT INDICES
          SB6    B6+B1       .
          NZ     B7,MOVLAB   LOOP 
          MX3    36D         NOW MASK OUT MULTI-FILE NAME FIELD 
          SA2    OPENO+MFNAM .
          BX7    -X3*X2      .
          SA7    A2          .
          SPACE  1
TAPEIN1   SX2    60B         DETERMINE TYPE OF TAPE 
          BX3    X1*X2       .
          ZR     X3,OPENOUT  SCOPE TAPE, CONTINUE 
          SX3    X3-40B      .
          ZR     X3,TAPEIN9  S TAPE, CHECK FOR 9 TRACK CODED
          NG     X3,ERR3     ERROR, INVALID TYPE
          SX6    B3-B1       L TAPE, SET MLRS FIELD IN READ FET 
          SA6    FET1+MLRS      TO 1/2 BUFSIZE - 1
          SPACE  1
TAPEIN9   BSS    0           HAVE S/L TAPE INPUT
          IFEQ   CMODE,10B   IF THIS COPYCX 
          SX2    100B        CHECK FOR TAPE BEING 9 TRACK TAPE
          BX3    X1*X2       BY SEEING IF DEVICE TYPE ODD 
          ZR     X3,OPENOUT  NOT 9 TRACK TAPE, CONTINUE 
          SX6    B1          HAVE 9 TRACK S/L TAPE INPUT, SET FLAG FOR
          SA6    SL9TRACK    CONVERSION-COMPRESSION MESSAGE 
          ENDIF 
           SPACE 4
* 
*                 OPEN OUTPUT FILE
* 
           SPACE 1
OPENOUT   BSS    0           OPEN OUTPUT FET
          SA1    LFNOUT      GET FILENAME 
          SX2    104B        PLUS CODE
          BX7    X0*X1       .
          SA7    A1          (SAVE LFN SIN LOWER 18 BITS) 
          BX7    X7+X2       GOES 
          SA7    OPENO       TO OPEN OUTPUT FET 
          SA1    CIOOPE      FORM CIO REQUEST FOR OPEN
          SX2    A7          .
          IX5    X1+X2       .
          RJ     CALL        ISSUE OPEN 
          SPACE  1
          SA1    A7+DTYPE    GET OUTPUT FILE DEVICE TYPE
          MX2    6           .
          BX2    X1*X2       .
          LX2    6           .
          CHKDT  ((@37,COPYL))         IF ALLOCATABLE,CONTINUE
          CHKDT  ((40-43,TAPEOUT))     GO PROCESS TAPE DEVICES
          CHKDT  ((50-52,COPYL),(70,)) IF UNIT REC DEVICES, CONTINUE
          CHKDT  ((61,COPYL))      IF A CONNECTED FILE CONTINUE 
          EQ     ERR4        ERROR,ILLEGAL DEVICE 
          SPACE  1
TAPEOUT   LX1    12          DETERMINE TYPE OF TAPE 
          SX2    60B         .
          BX3    X1*X2       .
          ZR     X3,COPYL    CONTINUE IF SCOPE TAPE 
          SX6    B1          SET X6 = 1 
          SX3    X3-40B      .
          ZR     X3,SSLFLG   IS S TAPE
          NG     X3,ERR4     IS ERROR,  INVALID TAPE TYPE 
          SX6    X6+B1       IS L TAPE, X6 = 2
SSLFLG    SA6    OSLFLG      SET S/L OUTPUT TAPE FLAG 
           SPACE 1
          BSS    0           HAVE S/L TAPE OUTPUT 
          IFEQ   CMODE,10B   IS THIS COPYCX 
          SX2    100B        CHECK FOR TAPE BEING 9 TRACK TAPE
          BX3    X1*X2       BY SEEING IF DEVICE TYPE ODD 
          ZR     X3,COPYL    NOT 9 TRACK TAPE, CONTINUE 
          SA3    SL9TRACK    HAVE 9 TRACK S/L TAPE OUTPUT, SET FLAG FOR 
          SX6    X3+B1       CONVERSION-COMPRESSION MESSAGE 
          SX6    X6+B1       .
          SA6    A3          .
          ENDIF 
          TITLE  MAIN COPY LOOP 
  
  
* 
*                MAIN COPY LOOP 
* 
          SPACE  1
* 
*         THIS IS THE HEART OF &COPYCOM&.  THE COPY TECHNIQUE IS TO USE 
*         TWO FETS, ONE FOR THE INPUT FILE AND ONE FOR THE OUTPUT FILE, 
*         AND ONE CIRCULAR BUFFER.  AFTER THE FIRST READ , ONE MERELY 
*         UPDATES THE FET POINTERS AND ISSUES THE WRITE AND NEXT READ;
*         THUS THE WRITES CHASE THE READS CIRCULARLY IN THE BUFFER.  THE
*         READ IS RESTRICTED TO WHAT IS LEFT IN THE BUFFER OR 1/2 THE 
*         BUFFER SIZE.  THIS POSES NO RESTRICTION ON READING/WRITING A
*         L TAPE SINCE EACH READ/WRITE IS A PHYSICAL(LOGICAL) RECORD ON 
*         L TAPE AND THE MLRS FIELD KEEPS THE PHYSICAL RECORD SIZE TO 
*         1/2 OF THE BUFFER SIZE.  THIS METHOD HAS NO RESTRICTIONS ON 
*         THE FILE&S DEVICE TYPE AS LONG AS IT FOLLOWS CIRCULAR I/O 
*         CONVENTIONS.
* 
*         AFTER EACH READ IS COMPLETED, ITS STATUS AND VARIOUS FLAGS
*         ARE CHECK TO SEE: 
* 
*           A. IF THE LOGICAL RECORD IS CONTAINED IN THE BUFFER WHEN
*              THE OUTPUT FILE IS S OR L TAPE 
* 
*           B. IF RECORD/FILE IS COUNT EXHAUSTED, IN WHICH CASE SET 
*              FINAL WRITE FLAG AND BYPASS READ PHASE 
* 
* 
          SPACE  1
COPYL     BSS    0           START OF MAIN COPY CODE
          SPACE  1
COPYL0    SA5    CIOINR      ISSUE FIRST BUFFER READ WILL AUTO-RECALL 
          SPACE  2
COPYL1    BSS    0           ISSUE READ ON A BUFFER 
          SA1    LFNIN       SET FILENAME AND FUNCTION(CODED/BINARY)
          BX7    X1          IN READ FET
          SA7    FET1+CODE   (A7 = ADDRESS OF READ FET) 
          RJ     CALL        CALL CIO 
          SPACE  2
          LX5    19D         WAS READ DONE WITH RECALL
          NG     X5,COPYCKR  YES,GO CHECK READ STATUS 
          SPACE  2
COPYLW    BSS    0           ISSUE WRITE ON A BUFFER
          SA1    LFNOUT      SET FILENAME PLUS PREVIOUS READ STATUS ON
          SA2    WTFUNC      BUFFER TURNED INTO WRITE 
          IX6    X1+X2       INTO 
          SA6    FET2+CODE   WRITE FET
          SA5    CIOOUTR     .
          RJ     CALL        ISSUE WRITE WITH AUTO-RECALL ON WRITE FET
          SA1    CHECK             PICK PU CHECK
          SX6    X1+B1             ADD ONE TO IT FOR EOI CHECK
          SA6    A1                RESTORE IT 
          SPACE  2
          SA1    ENDFLG      IS THIS TERMINATION WRITE
          NZ     X1,FIN      YES, GO FINISH UP COPYXX 
          SA1    A7          IS READ COMPLETE 
          LX1    59          .
          NG     X1,COPYCKR  YES
          SA5    RCLPIN      NO, ISSUE AUTO-RECALL ON READ FET
          RJ     CALL        .
          SPACE  2
COPYCKR   BSS    0           READ COMPLETED,CHECK STATUS
          SA1    A7          GET STATUS WORD
          SX2    740077B     MASK TO GET FUNCTION CODE
          BX6    X1*X2       AND LEVEL NUMBER 
          SX6    X6+3        CHANGE FUCNTION TO WRITE 
          BX6    -X0*X6      FINAL MASK TO 18 BITS
          SA6    WTFUNC      SAVE 
          SPACE  1
          SA2    OSLFLG      IS WRITE TO S/L TAPE 
          ZR     X2,CKR3     NO 
          SX3    1020B       YES,READ MUST HAVE EOR/EOF/EOI SINCE INPUT 
          BX3    X1*X3       LOGICAL REC MUST BE CONTAINED IN ONE BUFFER
          ZR     X3,ERR5     LOGICAL RECORD TOO BIG,GO ISSUE ERROR MSG
          SX2    X2-1        IS OUTPUT S TAPE 
          NZ     X2,CKR2     NO 
          SA2    FET1+IN     YES, FOR S TAPE LOGICAL RECORD MUST
          SA3    FET2+OUT    LESS THAN OR EQUAL 512 WORDS 
          IX3    X2-X3       .
          SX2    B3+B3       (X2 = BUFFER SIZE) 
          PL     X3,CKR1     .
          IX3    X3+X2       (&IN& PTR BEFORE &OUT& IN BUF,ADD BUF SIZE)
CKR1      SX3    X3-512-1    .
          PL     X3,ERR6     ERROR IF LOGICAL RECORD > 512D 
CKR2      AX6    14          LOOK AT LEVEL NUMBER , IF ANYTHING 
          ZR     X6,CKR3     OTHER THAN O OR 17B
          SX6    X6-17B      .
          ZR     X6,CKR3     .
          SA6    LEVFLG      SET FLAG FOR WARNING 
          SPACE  1
CKR3      SX6    B1          SET X6 TO ONE FOR SETTING OF FLAGS 
          SX2    37000B      GET ERROR FIELD OF STATUS
          BX2    X2*X1       IS THERE EOI 
          SX2    X2-1000B    .
          ZR     X2,EOI      YES, PROCESS EOI 
          SX2    30B         ISOLATE EOR/EOF BITS IN X2 
          BX2    X2*X1       .
          SX3    X2-20B      IS THERE EOR/EOF THIS READ 
          ZR     X3,EOR      EOR FOUND, PROCESS IT
          SX3    X2-30B      .
          ZR     X3,EOF      EOF FOUND, PROCESS IT
          SPACE  1
COPYL2    BSS    0           RETURN FROM EOR/EOF PROCESSING 
          SPACE  1
          RJ     SETPTR      SET READ AND WRITE FET POINTERS
          SA5    CIOIN       ON BUFFER AND
          EQ     COPYL1      LOOP ISSUEING READ WITHOUT AUTO-RECALL 
          TITLE  PROCESS EOR/EOF/EOI
  
  
* 
*                PROCESS EOR/EOF/EOI
* 
          SPACE  1
*         ENTRY POINTS ASSUME X6 = 1
          SPACE  1
*                            EOR FOUND
          IFEQ   FRFLAG,30B  IS THIS COPYXF 
EOR       SA1    RECCNT      YES, COUNT RECORDS WITHIN THIS FILE
          IX6    X6+X1       .
          SA6    A1          .
          EQ     COPYL2      THEN CONTINUE COPY LOOP
          ELSE
EOR       BSS    0           IS COPYXR, REDUCE RECORD COUNT 
          ENDIF 
          SPACE  2
RCNT      SB2    B2-B1       REDUCE RECORD/FILE COUNT 
          NZ     B2,COPYL2   IF NOT ZERO, CONTINUE COPY LOOP
          SPACE  2
SENDF     SA6    ENDFLG      SET END COPY FLAG
          RJ     SETPTR      SET WRITE FET POINTERS 
          EQ     COPYLW      GO DO WRITE
          SPACE  2
*                            EOF FOUND
          IFEQ   FRFLAG,30B  IS THIS COPYXF 
EOF       SX7    B0          YES, CLEAR RECORD COUNT FOR FILE 
          SA7    RECCNT      .
          EQ     RCNT        THEN GO REDUCE FILE COUNT
          ELSE
EOF       SA6    BKSFLG      NO,RECORD COPY, SET BACKSPACE FLAG 
          SA6    EOFFLG      EOF FOUND FLAG 
          EQ     SENDF       GO SET END COPY FLAG AND FORCE EOF TO BE 
                                   WRITTEN ON WRITE FILE
          ENDIF 
          SPACE  2
EOI       BSS    0           EOI FOUND
          IFEQ   FRFLAG,30B  IS THIS COPYXF 
          SA1    MFTFLG      YES, IS THIS MULTI-FILE TAPE INPUT FILE
          ZR     X1,EOI1     NO 
          SB2    B2-B1       YES, REDUCE FILE COUNT 
          SX7    B0          .
          ZR     B2,EOI2     .
          SA6    OPEFLG      IF NOT ZERO, SET OPEN FLAG AND 
          SA7    RECCNT      CLEAR RECORD COUNT FOR FILE
          ENDIF 
EOI1      SA6    EOIFLG      SET EOI FOUND FLAG 
EOI2      SA6    CLSFLG      SET CLOSE FLAG 
          EQ     SENDF       GO SET END COPY FLAG AND FORCE EOF TO BE 
                                   WRITTEN ON WRITE FILE SINCE EOI HAS
                                   LEVEL 17 ASSOCIATED WITH IT
          TITLE  TERMINATION PROCEDURE
  
  
* 
*                FINISH COPY
* 
          SPACE  1
FIN       BSS    0           COPY IS FINISH 
          SA1    BKSFLG      BACKSPACE FLAG SET 
          ZR     X1,FIN1     NO 
          SX5    OPENO       YES,BACKSPACE OUTPUT FILE
          RJ     BKS         .
          SPACE  1
FIN1      SA1    CLSFLG      CLOSE FLAG SET 
          ZR     X1,FIN2     NO 
          SX5    OPENO       YES, CLOSE OUTPUT
          RJ     CLSF        .
          SX5    OPENI       CLOSE INPUT
          RJ     CLSF        .
          SPACE  1
FIN2      SA1    OPEFLG      OPEN FLAG SET
          ZR     X1,FIN3     NO 
          SX6    B0          YES,CLEAR VARIOUS FLAGS
          SA6    ENDFLG      .
          SA6    BKSFLG      .
          SA6    CLSFLG      .
          SA6    EOIFLG      .
          SA6    OPEFLG      .
          EQ     OPENIN      AND GO OPEN INPUT FILE AGAIN 
          SPACE  1
FIN3      SA1    LEVFLG      LEVEL CANNOT BE COPY WARNING 
          ZR     X1,FIN4     NO 
          SX5    IMSG0       YES,ISSUE MESSAGE
          RJ     IMSG        .
          SPACE  1
FIN4      SA1    UBCFLG      UBC BITS CLEARED FOR SCOPE OUTPUT FILE 
          ZR     X1,FIN5     .
          SX5    IMSG1       YES,ISSUE MESSAGE
          RJ     IMSG        .
          SPACE  1
          SPACE  1
          IFEQ   CMODE,10B   IS THIS COPYCX 
FIN5      SA1    SL9TRACK    WAS THERE 9 TRACK S/L TAPE ENVOLVED
          ZR     X1,FIN6     NO, CONTINUE 
          SX2    X1-2        DETERMINED TYPE OF ENVOLVEMENT 
          ZR     X2,FIN5A    ONLY OUTPUT
          SX5    IMSG3       .
          PL     X2,FIN5B    BOTH INPUT AND OUTPUT MESSAGE
          SX5    IMSG2A      ISSUE MESSAGES FOR INPUT ONLY
          RJ     IMSG        .
          SX5    IMSG2B      .
          EQ     FIN5B       .
FIN5A     SX5    IMSG2C      ISSUE MESSAGES FOR OUTPUT ONLY 
          RJ     IMSG        .
          SX5    IMSG2D      .
FIN5B     RJ     IMSG        .
  
          ELSE
  
FIN5      BSS    0
          ENDIF 
          SPACE  1
FIN6      BSS    0           OTHER TERMINATING CONDITIONS 
          SPACE  2
*                EOF/EOI MESSAGES SHOULD BE LAST TO BE ISSUED 
          SPACE  1
          IFEQ   FRFLAG,20B  IS THIS COPYXR 
FIN20     SA1    EOFFLG      EOF FOUND ON RECORD COPY 
          ZR     X1,FIN21    .
FIN20A    SA1    COUNT       YES
          SX2    B2          FIND NUMBER OF RECORDS COPIED
          IX1    X1-X2       .
          SX5    IMSG20B     .
          SA3    CHECK             IF CHECK=0 THEN AN EOI ENCOUNTERED 
          ZR     X3,FIN20B         IMMEDIATELY, GO TO FIN20B
          RJ     CDEC        CONVERT NON-ZERO COUNT TO STRING 
          LX7    60-6        GIVE LEADING BLANK 
          SA7    IMSG20A+5   STORE COUNT
          SX5    IMSG20A     SET MESSAGE START
FIN20B    RJ     IMSG        ISSUE MESSAGE
          EQ     FINX        GO END COPY
  
FIN21     SA1    EOIFLG      IS EOI FLAG SET FOR COPYXR 
          ZR     X1,FINX     NO, GO END COPY
          SX1    3LEOI-3LEOF YES, CHANGE EOF MESSAGES TO EOI
          SA2    IMSG20A     MESSAGES SINCE COPYXR CAN ONLY HAVE
          SA3    IMSG20B     EOF OR EOI MESSAGE AT ONE TIME 
          LX1    60-3*6      .
          IX6    X2+X1       .
          IX7    X3+X1       .
          SA6    A2          .
          SA7    A3          .
          EQ     FIN20A      GO INTO FIN20 TO ISSUE MESSAGE 
  
          ELSE
  
FIN20     BSS    0           .
  
FIN21     SA1    EOIFLG      COPYXF CAN HAVE ONLY EOI MESSAGE 
          ZR     X1,FINX     EOI FOUND ON FILE COPY 
          SA1    COUNT       YES, FIND NUMBER OF FILES COPIED 
          SX2    B2          .
          IX1    X1-X2       .
          SA2    RECCNT      AND DON&T FORGET RECORDS WITHIN A FILE 
          IX6    X1+X2       .
          SX5    IMSG21B     .
          SA3    CHECK             IF CHECK=0 THEN AN EOI ENCOUNTERED 
          ZR     X3,FIN21C         IMMEDIATELY, GO TO FIN21C
          RJ     CDEC        CONVERT FILE COUNT TO STRING 
          BX6    X7          SAVE THE STRING AS IS
          SX5    IMSG21A     (SET MESSAGE ADDRESS)
FIN21A    BX3    -X4*X7      JUSTIFIED STRING TO RIGHT DIGIT
          SX3    X3-1R       .
          LX7    60-6        .
          ZR     X3,FIN21A   .
          LX7    6           .
          SA7    IMSG21A+4   STORE STRING AWAY
          SA1    A2          GET RECORDS LEFT OF PARTIAL FILE IF
          NZ     X1,FIN21B   ANY
          SA1    A7-B1       NONE LEFT, POSITION MESSAGE
          SA6    A7+B1       PART DEALING WITH FILE COUNT 
          BX7    X1          SO IT WILL STAND OUT 
          LX7    5*6         .
          SA7    A7          .
          SA1    A3          (SET BLANK WORD) 
          BX7    X1          .
          SA7    A7-B1       .
          EQ     FIN21C      GO ISSUE CONSTRUCTED MESSAGE 
FIN21B    RJ     CDEC        CONVERT RECORD COUNT TO STRING 
          SA7    IMSG21A+6   STORE IT IN MESSAGE
          SX5    IMSG21A     ISSUE EOI MESSAGE AFTER FILES COPIED 
FIN21C    RJ     IMSG        ISSUE INDICATED MESSAGE
          ENDIF 
          SPACE  2
FINX      SX5    3REND       SET TO END COPYXX
          LX5    42          .
FINISH    RJ     CALL        TERMINATE COPYXX PROGRAM 
          PS     0           .
          TITLE  ERROR PROCESSING 
  
  
* 
*                ERROR PROCESSING 
* 
          SPACE  1
ERR0      SX5    EMSG0       INVALID FILENAME 
          EQ     ERROR       .
          SPACE  1
ERR1      SX5    EMSG1       INSUFFICENT FIELD LENGTH 
          EQ     ERROR       .
          SPACE  1
ERR2      SX5    EMSG2       NON-NUMERIC COUNT
          EQ     ERROR       .
ERR2A     SX5    EMSG2A      COUNT GT THAN 2**18 - 1
          EQ     ERROR
          SPACE  1
ERR3      SX5    EMSG3       ILLEGAL INPUT DEVICE 
          EQ     ERROR       .
          SPACE  1
ERR4      SX5    EMSG4       ILLEGAL OUTPUT DEVICE
          EQ     ERROR       .
          SPACE  1
ERR5      SX5    EMSG5       BUFFER NOT CONTAIN LOGICAL RECORD
          EQ     ERROR       FOR S/L OUTPUT TPAE
          SPACE  1
ERR6      SX5    EMSG6       LOGICAL REC GT 512 FOR S OUTPUT TAPE 
          EQ     ERROR       .
          SPACE  1
          BSS    0           OTHER ERROR CODES ADDED HERE 
          SPACE  2
ERROR     RJ     IMSG        ISSUE ERROR MESSAGE
          SX5    3RABT       AND
          LX5    42          ABORT JOB-STEP 
          EQ     FINISH      GO POST ABT
          TITLE  COPYCOM UTILITIES
  
  
* 
*                COPYCOM UTILITIES
* 
          SPACE  2
**        BKS---BACKSPACE FILE
* 
*         ENTRY  X5 = ADDRESS OF GET FOR FILE 
*                X0 = 42 BIT MASK 
* 
*         EXIT   ---
* 
*         USES   (A1,A6),(X1,X6)
* 
*         CALLS  CALL 
* 
BKS       CENM                     ENTRY/EXIT 
          SA1    X5          GET FET CODE WORD
          BX6    X0*X1       ISOLATE LFN
          SX1    44B         ADD IN BACKSPACE CODE
          IX6    X6+X1       .
          SA6    X5          SET BACK IN FET
          SA1    CIOBKS      GET CIO WORD FOR BACKSPACE 
          IX5    X1+X5       ADD FET ADDRESS
          RJ     CALL        ISSUE CIO CALL 
          EQ     BKS         RETURN 
          SPACE  4
**        CALL---ISSUE MTR FUNCTION 
* 
*         ENTRY  X5 = MTR FUNCTION TO BE ISSUED 
*                B1 = ONE 
* 
*         EXIT   X6 = X5 = AS ON ENTRY
*                X1 = 0 
*                FUNCTION ISSUED VIA RA+1 AND ACCEPTED BY MTR 
* 
*         USES   (A1,A6),(X1) 
* 
*         CALLS  ---
* 
CALL      CENM                     ENTRY/EXIT 
          BX6    X5          SET FUNCTION INTO RA+1 
          RJ     CALLPP                                                 000240
          EQ     CALL                                                   000250
*CALL CALLPP                                                            000260
          SPACE  4
**        CDEC---CONVERT FIX POINT NUMBER TO DECIMAL STRING 
* 
*         ENTRY  X1 = FIX POINT NUMBER @ 9,999,999,999
* 
*         EXIT   X4 = 54 BIT MASK 
*                X7 = NUMBER CONVERTED TO DECIMAL STRING OF DIGITS
*                       LEFT JUSTIFIED, BLANK FILL
*                A3 = ADDRESS OF WORD OF BLANKS 
* 
*         USES   (A3),(B7),(X0,X1,X2,X3,X4,X5,X7) 
* 
*         CALLS  ---
* 
CDEC      CENM               ENTRY/EXIT 
          SA3    BLANKS      SET CONSTRUCTION WORD TO BLANKS
          BX7    X3          .
          SX0    10          SET PACKED CONSTANT 10 
          PX0    X0          .
          NX3    X0          SET FLOATING POINT CONSTANT 10 
          MX4    60-6        SET LOW ORDER CHAR OUT MASK
CDEC.L    PX2    X1          FIX(NUM/10) WHERE X1 = NUM 
          NX2    X2          .
          FX2    X2/X3       .
          UX2    X2,B7       .
          LX2    X2,B7       X2=FIX(NUM/10) 
          PX5    X2          FIX(NUM/10)*10 
          DX5    X5*X0       .
          UX5    X5          .
          IX5    X1-X5       NUM-FIX(NUM/10)*10=RIGHTMOST DECIMAL DIGIT 
          BX1    X2          NUM=FIX(NUM/10)
          SX5    X5+1R0      TAKE DIGIT TO DISPLAY CODE 
          BX7    X7*X4       CLEAR RIGHTMOST CHAR OF BLANK
          LX7    60-6        POSITION WORD TO INSERT NEXT CHAR AT LEFT
          LX5    60-6        POSITION DIGIT 
          BX7    X5+X7       ADD NEW DIGIT TO STRING ON LEFT
          NZ     X1,CDEC.L   LOOP IF NUM NOT ZERO YET 
          EQ     CDEC        RETURN 
          SPACE  1
BLANKS    DATA   10H
          SPACE  4
**        CLSF---CLOSE FILE 
* 
*         ENTRY  X5 = ADDRESS OF FET FOR FILE 
*                X0 = 42 BIT MASK 
* 
*         EXIT   ---
* 
*         USES   (A1,A6),(X1,X6)
* 
*         CALLS  CALL 
* 
CLSF      CENM                     ENTRY/EXIT 
          SA1    X5          GET FET CODE WORD
          BX6    X0*X1       ISOLATE LFN
          SX1    130B        ADD IN CLOSE CODE
          IX6    X6+X1       .
          SA6    X5          SET BACK IN FET
          SA1    CIOCLS      GET MTR REQUEST WORD FOR CLOSE 
          IX5    X1+X5       ADD FET ADDRESS
          RJ     CALL        ISSUE MTR CALL 
          EQ     CLSF        RETURN 
          SPACE  4
**        IMSG---ISSUE MESSAGE
* 
*         ENTRY  X5 = ADDRESS OF MESSAGE
* 
*         EXIT   ---
* 
*         USES   (A1,A6),(X1,X5,X6) 
* 
*         CALLS  CALL 
* 
IMSG      CENM                     ENTRY/EXIT 
          BX6    X5          PLACE MESSAGE ADDRESS
          LX6    30          IN MSG INDIRECT STATUS WORD
          SA6    MSGADR      .
          SA1    MSG         GET MSG WORD FOR MTR REQUEST 
          BX5    X1          .
          RJ     CALL        ISSUE MTR REQUEST
          EQ     IMSG        RETURN 
          SPACE  1
MSGADR    BSSZ   1           MSG STATUS WORD
          SPACE  4
**        SETPTR---SET FET POINTERS 
* 
*         ENTRY  B3 = BUFFER SIZE/2 
*                B4 = BUFFER FIRST
*                B5 = BUFFER LIMIT
* 
*         EXIT   ---
* 
*         USES   (A1,A2,A6),(B6,B7),(X1,X2,X3,X6) 
* 
*         CALLS  ---
* 
*         ROUTINE SETS THE POINTERS FOR THE NEXT READ AND WRITE.
*         THE POINTERS ARE SET AS FOLLOWS:  
* 
*              FET2(WRITE) &IN& = FET1(READ) &IN& 
*              FET2(WRITE) &OUT& MOVES NATURALLY
* 
*              FET1(READ) &IN& MOVES NATURALLY
*              FET1(READ) &OUT& = MIN(1/2 BUF SIZE,AMOUNT OF SPACE
*                                                     LEFT FOR READ)
* 
*         SINCE ONE KNOWS AMOUNT OF SPACE LEFT FOR READ, ONE COULD
*         DESIGN A MORE SOPHISTICATED ALGORITHM FOR OPTIMALLY SETTING 
*         THE READ&S &OUT& POINTER. 
* 
SETPTR    CENM                     ENTRY/EXIT 
          SPACE  1
          SA1    FET1+IN     MOVE READ FET &IN& PTR 
          BX6    X1          TO WRITE FET &IN& PTR TO DELIMIT 
          SA6    FET2+IN     NEXT WRITE;  WRITE &OUT& PTR MOVES NORMALLY
          SPACE  1
          SB6    X1          B6 = READ FET &IN& PTR 
          SA2    A6+B1       GET WRITE FET &OUT& PTR IN X2
          SPACE  1
          SB7    X2          DETERMINE AMOUNT OF BUFFER LEFT FOR
          SB7    B7-B6       NEXT READ, TAKE WRITE &OUT& - READ &IN&
          NG     B7,SETPTR0  AND IF &OUT& BEFORE &IN& IN BUFFER 
          NZ     B7,SETPTR1  OR IF &OUT& = &IN& 
SETPTR0   SB7    B7+B3       ADD BUFFER SIZE TO DIFFERENCE TO DETERMINE 
          SB7    B7+B3       AMOUNT LEFT (REM: B3 = 1/2 BUF SIZE) 
          SPACE  1
SETPTR1   BSS    0           AT THIS POINT HAVE IN B7 AMOUNT OF BUFFER
*                LEFT FOR READ.  INSTEAD OF THE FOLLOWING SIMPLE METHOD 
*                ONE COUND ELECT AT THIS POINT TO DO FULL BUFFER POINTER
*                CHASING BY DETERMINING HOW TO OPTIMALLY MOVE THE BUFFER
*                POINTERS GIVEN THE INPUT/OUTPUT MEDIA AND THE PRU SIZES
*                ETC..
          SPACE  1
          LT     B7,B3,SETPTR2    IS 1/2 BUFFER LEFT FOR NEXT READ
*                                    IF NOT, NEW READ &OUT&=WRITE &OUT& 
          SB7    B6+B3       YES,SET READ &OUT& PTR TO BE 1/2 BUF SIZE
          SX2    B7          AWAY FROM &IN& PTR TO DELIMIT NEXT READ
          LT     B7,B5,SETPTR2    DOES NEW READ FET &OUT& EXCEED LIMIT
          SB7    B7-B5       YES, TAKE EXCESS AND ADD IT
          SX2    B7+B4       TO FIRST FOR NEW READ FET &OUT& PTR
          SPACE  1
SETPTR2   BX7    X2          STORE NEW READ FET &OUT& PTR 
          SA7    A1+B1       (NOTE: READ &IN& PTR MOVES NORMALLY) 
          SPACE  1
          SA1    FET1+UBC    GET READ FET UBC FIELD 
          MX2    6           .
          LX2    30          .
          BX6    X2*X1       .
          SA6    FET2+UBC    WRITE FET UBC = READ FET UBC 
          SPACE  1
          AX6    24          WAS THERE NON-ZERO UBC 
          ZR     X6,SETPTR   NO,RETURN
          SB7    X6          UBC TO B7
          SX2    B1          1 TO X2
          NE     B6,B4,SETPTR3     IS READ &IN& PTR AT FIRST
          SB6    B5          YES, SET IT BACK TO LIMIT
SETPTR3   SA1    B6-B1       GET LAST DATA WORD DELIVERED 
          LX3    X2,B7       FORM MASK FOR UNUSED BITS
          IX2    X3-X2       .
          BX6    -X2*X1      ZERO UNUSED BITS IN DATA WORD
          SA6    A1          .
          SPACE  1
          SA1    OSLFLG      IS OUTPUT S/L TAPE 
          NZ     X1,SETPTR   YES, RETURN
          SX6    B1          NO, SCOPE FILE OUTPUT , SET FLAG 
          SA6    UBCFLG      FOR WARNING MESSAGE
          EQ     SETPTR      RETURN 
          TITLE  VARIALBES,MESSAGES,FETS,BUFFER 
  
  
* 
*                VARIABLES AND FLAGS
* 
          SPACE  1
COUNT     EQU    N           RECORD/FILE COUNT IN BINARY
 CHECK    DATA   -1 
          IFEQ   FRFLAG,30B,1      IS THIS COPYXF 
RECCNT    BSSZ   1           COUNT OF RECORDS WITHIN A FILE 
WTFUNC    BSSZ   1           FUNCTION CODE FOR NEXT WRITE 
          SPACE  1
BKSFLG    BSSZ   1           SET WHEN OUTPUT FILE TO BE BACKSPACE 
CLSFLG    BSSZ   1           SET WHEN THE FILES ARE TO BE CLOSED
ENDFLG    BSSZ   1           SET FOR LAST WRITE 
          IFEQ   FRFLAG,20B,1      IS THIS COPYXR 
EOFFLG    BSSZ   1           SET WHEN EOF FOUND BEFORE REC COUNT 0
EOIFLG    BSSZ   1           SET WHEN EOI FOUND BEFORE REC/FILE COUNT 0 
LEVFLG    BSSZ   1           SET WHEN NON 0 OR 17 LEVEL TRY GO S/L TAPE 
MFTFLG    BSSZ   1           SET WHEN INPUT FILE MULTI-FILE TAPE
OPEFLG    BSSZ   1           SET WHEN WNAT TO REOPEN ON MULTI-FILE TAPE 
OSLFLG    BSSZ   1           OUTPUT FILE S(1) OR L(2) TAPE
          IFEQ   CMODE,10B   IS THIS COPYCX 
SL9TRACK  BSSZ   1           FLAG WORD FOR 9 TRACK S/L ENVOLVEMENT
                                   0 = NO S/L 9 TRACK TAPE USED 
                                   1 = 9 TRACK S/L TAPE AS INPUT
                                   2 = 9 TRACK S/L TAPE AS OUTPUT 
                                   3 = 9 TRACK S/L TAPE FOR BOTH FILES
          ENDIF 
UBCFLG    BSSZ   1           SET WHEN UNUSED BITS CLEARED ON SCOPE FILE 
          SPACE  4
* 
*                MONITOR FUNCTIONS
* 
          SPACE  1
CIOP      VFD    18/0HCIO,3/2,21/0,18/**         CIO WITH RECALL MTRFUNC
CIOBKS    EQU    CIOP                  .
CIOCLS    EQU    CIOP                  .
CIOOPE    EQU    CIOP                  .
CIOOPE    EQU    CIOP                  .
          SPACE  1
CIOIN     VFD    18/0HCIO,24/0,18/FET1
CIOINR    VFD    18/0HCIO,3/2,21/0,18/FET1
CIOOUTR   VFD    18/0HCIO,3/2,21/0,18/FET2
MSG       VFD    18/3LMSG,3/2,15/0,6/1,18/MSGADR
RCLPIN    VFD    18/0HRCL,3/2,21/0,18/FET1
          SPACE  4
* 
*                MESSAGES 
* 
          SPACE  1
*                ERROR MESSAGES 
* 
EMSG0     DIS    0,/***LFN GREATER THAN 7 CHARACTERS***/
  
EMSG1     DIS    0,/***INSUFFICIENT FIELD LENGTH***/
  
EMSG2     DIS    0,/***NON-NUMERIC OR ZERO "TYPE" COUNT***/ 
  
EMSG2A    DIS    0,/***"TYPE" COUNT GT 2**18 - 1***/
  
EMSG3     DIS    0,/***ILLEGAL INPUT DEVICE***/ 
  
EMSG4     DIS    0,/***ILLEGAL OUTPUT DEVICE***/
  
EMSG5     DIS    0,$*BUFFER INSUFFICIENT FOR INPUT LOGICAL *     **RECOR
,D FOR S/L TAPE OUTPUT**$ 
  
EMSG6     DIS    0,/***INPUT LOGICAL RECORD GT 512 WORDS ***         **F
,OR S TAPE OUTPUT**/
          SPACE  2
*                INFORMATIVE MESSAGES 
* 
IMSG0     DIS    0,$A REC LEVEL 1-16 LOST TO S/L TAPE OUTPUT$ 
  
IMSG1     DIS    0,$PARTIAL WORD FOUND ON S/L TAPE COPY TO    SCOPE FILE
, -- UNUSED BITS CLEARED$ 
  
          IFEQ   CMODE,10B
IMSG2A     DIS   0,$CODED 9 TRACK S/L TAPE INPUT -- 4 8-BIT$
IMSG2B     DIS   0,$   CHARACTERS GO TO 4 6-BIT CHARACTERS     WITH OPTI
,ONED CHARACTER CONVERSION$ 
  
IMSG2C     DIS   0,$CODED 9 TRACK S/L TAPE OUTPUT -- 4 6-BIT$ 
IMSG2D     DIS   0,$   CHARACTERS GO TO 4 8-BIT CHARACTERS     WITH OPTI
,ONED CHARACTER CONVERSION$ 
  
IMSG3     DIS    0,$CODED 9 TRACK S/L TAPE FOR INPUT+OUTPUT, OPTIONED CH
,ARACTER CONVERSION RESULTS$
          ENDIF 
  
          IFEQ   FRFLAG,20B 
IMSG20A   DIS    0,$EOF ENCOUNTERED AFTER COPY OF               RECORD
,        $
  
IMSG20B   DIS    0,$EOF ENCOUNTERED IMMEDIATELY BY "ENTRY"$ 
          ELSE
  
IMSG21A   DIS    0,$EOI ENCOUNTERED AFTER COPY OF FILE                , 
,RECORD            $
  
IMSG21B   DIS    0,$EOI ENCOUNTERED IMMEDIATELY BY "ENTRY"$ 
          ENDIF 
          SPACE  4
* 
*                FETS AND BUFFERS 
* 
          SPACE  1
*                READ FET 
 FET1     VFD    42/**,18/** FILENAME AND FUCNTION
          VFD    42/2,18/BUF FLAGS AND FIRST
          VFD    42/0,18/BUF IN POINTER 
          VFD    42/0,18/**  OUT POINTER = IN + (FL-PROGSIZE)/2 
          VFD    42/0,18/**  MORE FIELDS AND LIMIT = FL 
          BSSZ   2
          SPACE  1
*                WRITE FET
 FET2     VFD    42/**,18/** FILENAME AND FUNCTION
          VFD    42/2,18/BUF FLAGS AND FIRST
          VFD    42/0,18/**  IN POINTER = READ FET IN POINTER 
          VFD    42/0,18/BUF OUT POINTER
          VFD    42/0,18/**  MORE FIELDS AND LIMIT = FL 
          BSSZ   2
 OPENI    DATA   0
          VFD    42/10B,18/BUF
          VFD    60/BUF 
          VFD    60/BUF 
 OPENIL   VFD    60/**       ** = FL
          BSSZ   8
 OPENO    DATA   0
          VFD    42/10B,18/BUF
          VFD    60/BUF 
          VFD    60/BUF 
 OPENOL   VFD    60/**       ** = FL
          BSSZ   8
          SPACE  1
*                BUFFER AREA
          BSSZ   *-*/2*2     FORCE BUFFER TO EVEN CELL BOUNDARY 
 BUF      DATA   0
