*DECK COPY8P
          IDENT  COPY8P 
          LCC    OVERLAY(COPY8P,0,0)
          ENTRY  BEGIN
* 
* 
          DATA   50H COPYRIGHT CONTROL DATA CORP. 1971, 1975, 1976, 19
          DATA   10H77
* 
* WRITTEN BY MARC T. KAUFMAN. APRIL, 1971 
* 
*  UTILITY PROGRAM TO COPY AN IBM/360 FORMAT PRINT FILE TO A
*    DISK FILE IN EXTENDED CHARACTER SET FORM FOR PRINTING
* 
* 
          IPARAMS 
* 
****      ASSEMBLY PARAMETERS 
* 
 I8.IDC   SET    1           GENERATE NOS INTERNAL DISPLAY CODE 
                                                      0=NO, 1=YES 
 I8.IDC   SET    0                 DEFAULT IS NO IF NOT NOS, YES IF NOS 
  
          IFC    EQ,/"OS.NAME"/KRONOS/,1
 I8.IDC   SET    1
  
          IFC    EQ,/"OS.NAME"/NOS   /,1
 I8.IDC   SET    1
  
* 
          PURGMAC SYSCALL,CIOCALL,RECALL,CALL,FILEB 
* 
* MACROS
* 
 SYSCALL  MACRO 
          SA4    66B          CEJ FLAG
 +        SA5    B1           WAIT FOR RA+1 TO CLEAR
          NZ     X5,* 
          SA6    B1 
          PL     X4,*+2 
 +        XJ                  DO XJ IF WE CAN 
          BSS    0
          ENDM
* 
 CIOCALL  MACRO  R
          SA3    A3           PUT CIO CODE IN FET 
          MX0    42 
          BX3    X0*X3
          BX6    X3+X6
          SA6    A3 
 CI       IFC    NE,/R//
          SX3    4RCIOP/8 
 CI       ELSE
          SX3    3RCIO*8
 CI       ENDIF 
          LX3    60-24+3
          SX6    A3 
          BX6    X6+X3
          SYSCALL 
          ENDM
* 
 RECALL   MACRO 
          SX6    3RRCL
          LX6    60-18
          SYSCALL 
          ENDM
* 
 CALL     MACRO  S,P
          LOCAL  L
 CA       IFC    NE,/P//
          SB6    P
 CA       ELSE
          SB6    L
 CA       ENDIF 
          EQ     S
 L        BSS    0
          ENDM
* 
          MACRO  FILEB,LFN,WSA,SIZ,DUM,MRL
 LFN      VFD    42/0L_LFN,18/3 
          IFC    NE,//DUM/,2                                            0008   5
          VFD    42/2,18/WSA                                            0008   6
          ELSE   1                                                      0008   7
          CON    WSA                                                    0008   8
          CON    WSA,WSA,WSA+SIZ                                        0008   9
          IFC    NE,//DUM/,1
          CON    0,MRL
          ENDM
* 
* GENERATE HEXADECIMAL CONSTANTS
* 
 XA       ECHO   ,A=(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
 HA       MICRO  A,1,/0123456789ABCDEF/ 
 XB       ECHO   ,B=(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
 HB       MICRO  B,1,/0123456789ABCDEF/ 
 X"HA""HB"      EQU    16*A+B-17
 XB       ENDD
 XA       ENDD
* 
* 
*  GET ONE 8-BIT CHARACTER
* 
*         REGISTERS..  B1 = 1 
*                      B3 = RECORD COUNTER
*                   X1,A1 = BLOCK POINTER 
*                      B2 = BLOCK POINTER COUNT 
*                      X2 = RESULT (RIGHT JUSTIFIED)
*                      X0,X5 = SCRATCH
* 
 GETCHAR  SX5    B2-7 
          SB3    B3-1         COUNT DOWN CHARS REMAINING
          SB2    B2+1         COUNT UP INTERNAL COUNT 
          ZR     X5,GET.8     JP IF AT 7+1/2
          SX5    B2-16
          MX0    60-8 
          NZ     X5,GET.16    JP IF NOW NEW WORD NEEDED 
          SA1    A1+B1        GET NEXT WORD 
          SB2    B1 
 GET.16   LX1    8
          BX2    -X0*X1 
          JP     B6           RETURN
* 
 GET.8    MX0    60-4         7+1/2 SITUATION 
          LX1    4
          BX5    -X0*X1       TOP 4 BITS
          SA1    A1+B1
          LX5    4
          LX1    4
          BX2    -X0*X1       LOWER 4 BITS
          BX2    X2+X5
          JP     B6           RETURN
* 
*  STORE A 6 OR 12 BIT CHARACTER
* 
*         REGISTERS..  B1 = 1 
*                   X7,A7 = STORAGE POINTER 
*                      B7 = STORAGE COUNTER 
*                      X5 = SCRATCH 
*                      X2 = CHARACTER TO STORE
*                      B4 = FOLD FLAG (0=NO FOLD, 1=FOLD) 
* 
 STORCHR  BSS    0
          SB7    B7+1         CHAR POSITION 
          SX5    B7-11
          NZ     X5,STR.2    JP IF WORD NOT FULL
          SX5    A7-RECLIM
          ZR     X5,STR.X 
          IFEQ   I8.IDC,0,1 
          ZR     B4,STR.Y     JP IF NOT FOLDED
          MX5    60-12         FOLDED, CHECK FOR DOUBLE COLON 
          BX5    -X5*X7 
          NZ     X5,STR.Y     NO
          SX5    1R           YES, REPLACE SECOND BY BLANK
          BX7    X5+X7
 STR.Y    SA7    A7+B1        STORE FULL WORD 
 STR.X    SB7    1
          SX7    0
 STR.2    NZ     B4,STR.3     SHIFT TO MAKE ROOM
 IDC      IFEQ   I8.IDC,1 
          MX5    60-6 
          BX5    X5*X2       EXTRACT TOP 6 BITS OF 6/12 BIT CODE
          ZR     X5,STR.3    SHIFT ONCE IF 6 BIT CODE 
 IDC      ENDIF 
          LX7    6
          SB7    B7+B1
 STR.3    LX7    6
          BX7    X7+X2        STORE CHARACTER 
          JP     B6           RETURN
* 
* BEGIN RUN ... CRACK PARAMETERS AND OPEN INPUT FILE
* 
 BEGIN    SX7    A0-2 
          SA7    INPUT+4      NEW LIMIT FOR INPUT FILE
* 
          SB1    1
          SA1    B1+B1        PICK UP SOURCE FILE NAME
          MX0    42 
          SB4    B0           FOLD FLAG 
          SB5    B1          SOURCE FLAG
          ZR     X1,ERROR.3   NO SOURCE FILE
          BX1    X0*X1
          SX7    B1 
          IX7    X1+X7
          SA7    INPUT
          SA1    A1+B1        PICK UP DESTINATION FILE NAME 
          ZR     X1,BEG.D     NONE
          BX1    X0*X1
          SX7    B1 
          IX7    X1+X7
          SA7    PRINT
          MX0    60-4 
* 
 BEG.L    SA1    A1+B1        LOOP THRU PARAMETERS
          ZR     X1,BEG.D     DONE
          BX1    X0*X1
          SB2    B0 
 BEG.A    SA2    PTAB+B2
          ZR     X2,ERROR.4   NOT FOUND 
          BX3    X2-X1
          SB2    B2+B1
          NZ     X3,BEG.A 
          JP     FTAB-1+B2    ACTION BASED ON KEYWORD 
* 
 B$REC    SA1    A1+B1        GET FORMAT KEY
          SA2    VTAB 
          BX1    X0*X1
          LX1    12 
 B$REC1   SX3    X2 
          BX3    X3-X1
          ZR     X3,B$REC2    THIS ONE
          SA2    A2+B1
          NZ     X2,B$REC1
          EQ     ERROR.5
 B$REC2   AX2    30 
          SX6    X2 
          SA6    RECFM
          EQ     BEG.L
* 
 B$BLK    CALL   B$NNN
          SA6    BLKSIZE
          EQ     BEG.L
* 
 B$LRE    CALL   B$NNN
          SA6    LRECL
          EQ     BEG.L
* 
 B$NNN    SA1    A1+B1        CONVERT NUMERIC PARAM 
          SX6    B0 
          MX7    60-6 
          BX1    X1*X7
 B$NNN1   LX1    6
          BX2    -X7*X1       GET DIGIT 
          ZR     X2,B$NNNX    DONE
          IX5    X6+X6        *2
          LX6    3            *8
          IX6    X5+X6        *10 
          SX2    X2-33B 
          NG     X2,ERROR.6   NOT DIGIT 
          SX3    X2-10
          PL     X3,ERROR.6 
          IX6    X2+X6
          EQ     B$NNN1       LOOP
 B$NNNX   JP     B6 
* 
 B$COD    SA1    A1+B1
          BX1    X0*X1
          LX1    6
          SX1    X1-1RC 
          ZR     X1,BEG.L    EBCDIC IS DEFAULT
          SX1    X1+1RC-1RA 
          NZ     X1,ERROR.7   NOT A OR C
          SB5    B0 
          EQ     BEG.L
* 
 B$FMT    SA1    A1+B1
          BX1    X0*X1
          LX1    6
          MX7    60 
          SX1    X1-1RM 
          ZR     X1,B$FMT1    M SPECIFIED, FLAG WITH -0 
          SX1    X1+1RM-1RA 
          ZR     X1,BEG.L     A IS DEFAULT
          SB2    X1+1RA-1R1 
          NG     B2,ERROR.8   ILLEGAL VALUE 
          SB3    B2-3 
          PL     B3,ERROR.8 
          SA5    PRTAB+B2 
          BX7    X5 
 B$FMT1   SA7    FMT
          EQ     BEG.L
* 
 B$FOL    SB4    B1 
          EQ     BEG.L
* 
* 
 BEG.D    SA1    BLKSIZE      FIX UP LRECL AND BLKSIZE
          SA2    LRECL
          SX3    X1-32768 
          PL     X3,ERROR.9 
          IX4    X1-X2
          NG     X4,ERROR.A 
          NZ     X2,BEG.D1
          SX6    X1           LRECL = 0, SET TO BLKSIZE 
          SA6    A2 
 BEG.D1   SX7    X1           COMPUTE MRL 
          SX5    60 
          SX4    59 
          PX5    X5,B0
          LX7    3           BLKSIZE * 8
          NX5    X5 
          IX7    X7+X4        BITS+59 
          PX7    X7,B0
          NX7    X7 
          FX7    X7/X5        /60 
          UX7    X7,B7
          LX7    X7,B7        INTEGER 
          SA7    INPUT+6      MRLS
* 
          SA3    INPUT        OPEN THE INPUT FILE 
          SX6    102B         OPEN,NR,BINARY
          CIOCALL R 
 BEG.O    SA1    B1           WAIT
          NZ     X1,BEG.O 
          SA3    A3+B1        GET DEVICE TYPE 
          MX0    60-5 
          LX3    6
          PL     X3,BEG.X     NOT S OR L
          AX3    1
          BX3    -X0*X3 
          SX6    X3-20B 
          NZ     X6,BEG.X    NOT TAPE 
          SA6    TTYPE        S-TAPE
* 
 BEG.X    SX7    IBUF         RESET -IN- TO DROP LABEL FROM BUFFER
          SA7    INPUT+2
* 
* MAIN LOOP 
* 
*         REGISTERS.. B1 = 1
*                     B4 = FOLD FLAG (0=NO FOLD, 1=FOLD)
*                     B5 = SOURCE FLAG (0=ASCII, 1=EBCDIC)
*                     B6 = LINKAGE
* 
 LOOP     CALL   GETBLOC      GET NEXT BLOCK
          ZR     X6,EXIT      BLOCK LENGTH=0, DONE
          SA4    RECFM
          SA1    BLOCK        SET BLOCK POINTERS
          SB2    B0 
          PL     X4,MAIN      JP IF NOT TYPE V RECORDS
          CALL   GETCHAR      TYPE V, GET BLOCK LENGTH
          BX3    X2 
          LX3    8
          CALL   GETCHAR
          IX3    X3+X2        BLOCK SIZE HEADER 
          CALL   GETCHAR      SKIP NEXT TWO CHARACTERS
          CALL   GETCHAR
          IX2    X6-X3
          SX6    X3-4         RESIDUAL BLOCK SIZE 
          SB6    MAIN 
          NG     X2,ERROR.1   HEADER SIZE .GT. READIN SIZE
* 
 MAIN     PL     X4,MAIN.2    RECORD LOOP STARTS HERE 
          SX5    X6-5         V RECORD
          NG     X5,LOOP      NOT ENOUGH ROOM FOR ANOTHER RECORD
          CALL   GETCHAR      GET LENGTH
          BX3    X2 
          LX3    8
          CALL   GETCHAR
          IX3    X3+X2        RECORD LENGTH (+4)
          IX6    X6-X3        RESIDUAL BLOCK SIZE 
          SB6    MAIN.1 
          NG     X6,ERROR.2   RECORD LENGTH EXCEEDS BLOCK SIZE
 MAIN.1   CALL   GETCHAR      SKIP NEXT TWO BYTES 
          CALL   GETCHAR
          SB3    X3-4         SIZE OF RECORD
          NG     B3,ERROR.2 
          EQ     INN
* 
 MAIN.2   ZR     X4,MAIN.3
          SA3    LRECL        F RECORD
          IX6    X6-X3        RESIDUAL BLOCK SIZE 
          SB3    X3 
          NG     X6,LOOP      NOT ENOUGH ROOM, GET NEXT BLOCK 
          EQ     INN
* 
 MAIN.3   SB3    X6           U RECORD, USE WHOLE BLOCK 
          SX6    0
* 
 INN      SA7    RECORD-1     SET RECORD POINTERS 
          SA6    BLKSZR       SAVE RESIDUAL BLOCKSIZE 
          SA3    FMT          FORMAT CUE
          SB7    B0 
          SX7    B0 
          ZR     X3,INN.M0    JP IF NOT PRESET FORMAT 
          SX2    X3 
          EQ     INN.2        USE PRESET FORMAT 
 INN.M0   CALL   GETCHAR      COL.1 FORMAT
          PL     X3,INN.0     JP IF FMT(A)
* 
          SA3    MFMTAB       PROCESS FMT(M), LOOK UP CHAR
 INN.M    SX5    X3 
          ZR     X5,INN.M1    END OF TABLE
          BX5    X2-X5
          ZR     X5,INN.M1    THIS ONE
          SA3    A3+B1        TRY NEXT
          EQ     INN.M
 INN.M1   PL     X3,INN.M3    JP IF PRINTING CODE 
 INN.M2   ZR     B3,INN.M4    CONTROL, SKIP REST OF LINE
          CALL   GETCHAR,INN.M2 
* 
 INN.M4   SX5    A3-MNOP      CHECK FOR CONTROL NO-OP 
          ZR     X5,INN.Q      YES, IGNORE LINE 
          SX5    A3-MSKP      CHECK FOR CONTROL SKIP
          NZ     X5,INN.M3    NO, DO THE CODE 
          SA2    MFMT          YES, CHECK FOR 1403 GLITCH ON REPEATED 
          SX2    X2-X31        SKIPS
          ZR     X2,INN.Q     DON-T EXECUTE A CONTROL SKIP AFTER A SKIP 
* 
 INN.M3   SA2    MFMT         PRINT PREVIOUS FORMAT AND SAVE THIS ONE 
          AX3    30 
          SX6    X3 
          SA6    A2 
          EQ     INN.2
* 
 INN.0    ZR     B5,INN.1     PROCESS FMT(A)
          SA2    ETOA+X2      EBCDIC - ASCII
 INN.1    SX2    X2-X7F       TRUNCATE ASCII RANGE TO X20-X7E 
          PL     X2,INN.1A
          SX2    X2+X7F-X20 
          PL     X2,INN.1B
 INN.1A   SX2    0            USE BLANK IF OUT OF RANGE 
 INN.1B   SX2    X2+X20 
          SX3    X2-X20       CHECK FOR KNOWN TYPES 
          ZR     X3,INN.2 
          SX3    X2-X31      1
          ZR     X3,INN.2 
          SX3    X2-X2D      -
          ZR     X3,INN.2 
          SX3    X2-X30      0
          ZR     X3,INN.2 
          SX3    X2-X2B      +
          ZR     X3,INN.2 
          SX2    X20          BLANK IF NOT ONE OF THE ABOVE 
          EQ     INN.2
* 
 INNER    CALL   GETCHAR      DO NEXT CHARACTER (INNER LOOP)
          ZR     B5,INN.4 
          SA2    ETOA+X2      EBCDIC - ASCII
 INN.4    SX2    X2-X7E-1     TRUNCATE ASCII RANGE TO X20-X7E 
          PL     X2,INN.4A
          SX2    X2+X7E+1-X20 
          PL     X2,INN.4B
 INN.4A   SX2    0            USE BLANK IF OUT OF RANGE 
 INN.4B   SX2    X2+X20 
 INN.2    ZR     B4,INN.5 
          SA2    ATOD-X20+X2  ASCII - DISPLAY 
 IDC      IFEQ   I8.IDC,1 
          EQ     INN.5A 
 IDC      ENDIF 
 INN.5    BSS    0
 IDC      IFEQ   I8.IDC,1 
          SA2    ATOI-X20+X2  ASCII TO INTERNAL DISPLAY 
 INN.5A   BSS    0
 IDC      ENDIF 
          CALL   STORCHR
          NZ     B3,INNER 
* 
 INN.F    ZR     B4,INN.G     FILL OUT RECORD WITH ZERO BYTES 
          SX2    1R            TRAILING BLANK FOR 6-BIT STUFF 
          CALL   STORCHR,INN.6
 INN.G    BSS    0
 INN.6    SX5    B7-9 
          NZ     X5,INN.7 
          LX7    6            9 CHARS 
 INN.7    NG     X5,INN.8 
          SX5    A7-RECLIM
          ZR     X5,INN.P 
          SA7    A7+B1        9 OR 10, FILL AND ZERO
          SX7    B0 
          EQ     INN.9
 INN.8    SX5    X5+B1        8 OR LESS, FILL OUT WITH ZEROES 
          LX7    6
          NG     X5,INN.8 
          LX7    6
 INN.9    SX5    A7-RECLIM
          ZR     X5,INN.P 
          SA7    A7+B1
* 
 INN.P    CALL   PUTREC       PUT OUT THE RECORD
 INN.Q    SA3    BLKSZR       RESIDUAL BLOCK SIZE 
          SA4    RECFM
          SX6    X3 
          NZ     X6,MAIN      GET NEXT RECORD FROM BLOCK
          EQ     LOOP         GET NEXT BLOCK
* 
*  EXIT PROCESSING... FLUSH OUTPUT BUFFER 
* 
 EXIT     SA2    FMT          CHECK FOR FMT(M)
          PL     X2,EXIT.1    NO
          SA2    MFMT         YES, PUT OUT LAST CONTROL LINE
          LX2    60-6 
          BX7    X2 
          SA7    RECORD 
          CALL PUTREC 
* 
 EXIT.1   SA3    PRINT        WAIT FOR I/O TO FINISH
          LX3    59 
          NG     X3,EX.1
          RECALL
          EQ     EXIT.1 
 EX.1     SX6    026B         WRITER
          CIOCALL R           CALL CIO WITH RECALL
          SX6    3REND
          LX6    60-18
          SYSCALL             END RUN 
          PS
* 
* GET THE NEXT TAPE BLOCK FOR CONVERSION
* 
*         REGISTERS..  B1 = 1 
*                   B4,B5 = INVIOLATE 
*                      X6 = RETURN BLOCK SIZE, IN CHARACTERS
* 
 GETBLOC  SA1    TTYPE
          NZ     X1,GETBLOS   SCOPE FILE
 GET.1    SA1    INPUT+2      CHECK FOR DATA IN BUFFER
          SA2    A1+B1        OUT 
          IX0    X1-X2        IN-OUT
          NZ     X0,GET.A     MOVE IT OUT 
          SA3    INPUT        NO DATA, CHECK FOR I/O GOING
          LX3    59 
          NG     X3,GET.2     NO
          RECALL              YES, WAIT 
          EQ     GET.1
* 
 GET.2    SA1    A1           RECHECK FOR DATA
          SA2    A2 
          IX0    X1-X2
          NZ     X0,GET.A     YES,DATA
          SX4    30B          NO, CHECK FOR EOF 
          LX3    1
          BX3    X3*X4
          IX6    X3-X4
          ZR     X6,GET.X     YES, RETURN 
          SX6    262B         NO, START I/O 
          CIOCALL 
          EQ     GET.1
* 
 GET.A    SA5    X2           HAVE DATA, MOVE ONE BLOCK 
          SX4    X5           WORDS 
          AX5    24           UNUSED BITS 
          SX6    X4           W 
          LX6    4            W*16
          IX6    X6-X4        W*15
          LX6    2            W*60
          IX6    X6-X5        W*60 - UBC
          AX6    3            CHARACTERS
          SA3    A2+B1        LIMIT 
          SX2    X2+B1        STARTING -OUT-
          SX3    X3 
          IX0    X2-X3        OUT-LIMIT 
          SA7    BLOCK-1      STARTING BLOCK ADDRESS
          NG     X0,GET.A1
          SA1    INPUT+1      USE FIRST 
          SX2    X1 
* 
 GET.A1   SA5    X2           MOVE LOOP 
          SX2    X2+B1
          SX4    X4-1 
          IX0    X2-X3        OUT-LIMIT 
          BX7    X5 
          SA7    A7+B1
          NG     X0,GET.A2    CHECK FOR LIMIT 
          SA1    INPUT+1      USE FIRST 
          SX2    X1 
 GET.A2   NZ     X4,GET.A1
          SX7    X2           SAVE -OUT-
          SA7    A2 
* 
          SA3    INPUT        CHECK I/O 
          LX3    59 
          PL     X3,GET.X     GOING 
          SX4    30B          STOPPED, CHECK FOR EOF
          LX3    1
          BX3    X3*X4
          IX3    X3-X4
          ZR     X3,GET.X     YES 
          BX7    X6           NO, START I/O 
          SX6    262B 
          CIOCALL 
          BX6    X7 
          EQ     GET.X
* 
* 
* SCOPE FILE VERSION OF THE ABOVE 
* 
 GETBLOS  SA3    INPUT        CHECK I/O GOING 
          LX3    59 
          NG     X3,GET.3     NO
          RECALL              YES, WAIT FOR IT
          EQ     GETBLOS
* 
 GET.3    SA1    INPUT+2      ANY DATA
          SA2    A1+B1        OUT 
          IX0    X1-X2        IN-OUT
          NZ     X0,GET.B     MOVE IT OUT 
          SX4    30B          CHECK FOR EOF 
          LX3    1
          BX3    X3*X4
          IX6    X3-X4
          ZR     X6,GET.X     YES, RETURN 
          SX6    022B         NO, START IO
          CIOCALL 
          EQ     GETBLOS
* 
 GET.B    BX7    X0           MOVE BLOCK
          SB7    X0           BLOCK SIZE, SAVE IT 
          SA7    BLOCK-1      STARTING DESTINATION
 GET.B1   SA5    X2           LOOP
          SX0    X0-1 
          SX2    X2+B1
          BX7    X5 
          SA7    A7+B1
          NZ     X0,GET.B1
* 
          SX6    IBUF         EMPTY BUFFER AND START I/O
          SA6    A1 
          SX6    022B         READSKP 
          CIOCALL 
          SX6    B7           WORDS 
          SX7    B7 
          LX6    4            *16 
          IX6    X6-X7        *15 
          AX6    1            *60/8 = CHARACTERS
* 
 GET.X    SA5    BLKSIZE      MAXIMUM BLOCK SIZE
          IX4    X5-X6
          PL     X4,GET.Y     MAX .GE. THIS BLOCK 
          BX6    X5           USE MAX 
 GET.Y    JP     B6 
* 
* PUT RECORD INTO OUTPUT BUFFER 
* 
*         REGISTERS...  B1 = 1
*                       B4 = FOLD FLAG (0=NO FOLD, 1=FOLD)
*                       A7 = POINTER TO LAST WORD STORED
*              B5,X1,A1,B2 = INVIOLATE
* 
 PUTREC   NZ     B4,PUT.1     FIGURE OUT HOW MUCH TO PUT
          SA5    RECORD+1023       NOT FOLDED (SEE RECLIM)
          MX0    12*2 
          BX6    X0*X5
          EQ     PUT.2
 PUT.1    BSS    0
          SA5    RECORD+511        FOLDED (SEE RECLIM)
          MX0    6*7
          BX6    X0*X5
 PUT.2    SA6    A5 
          SX3    A5           MAX ALLOWABLE LWA 
          SX4    A7           ACTUAL LWA
          IX5    X3-X4
          PL     X5,PUT.3 
          SX4    X3           USE MAX ALLOWABLE LWA 
 PUT.3    SB3    RECORD       FWA RECORD
          SB7    X4-RECORD    NUMBER OF WORDS TO MOVE (-1)
* 
 PUT.4    SA2    PRINT+2      IN
          SA4    A2+B1        OUT 
          IX0    X2-X4        IN-OUT = -(SPACE LEFT)
          NG     X0,PUT.5     THERE IS SOME 
          SA5    A4+B1        NONE, TRY LIMIT 
          SX5    X5+B1
          IX0    X2-X5        IN-(LIMIT+1)=-(SPACE LEFT)
          SX4    X4-PBUF      IF OUT=FIRST
          NZ     X4,PUT.5 
          SX0    X0+1           THEN WE HAVE ONE WORD LESS
 PUT.5    SX0    X0+1         TRUE SPACE THAT CAN BE USED 
          NG     X0,PUT.L     ROOM EXISTS, MOVE SOME WORDS
* 
          SA3    PRINT        NO ROOM, START OR WAIT ON I/O 
          LX3    59 
          NG     X3,PUT.6     JP IF NOT BUSY
          RECALL              WAIT AND TRY AGAIN
          EQ     PUT.4
 PUT.6    SA4    A2+B1        I/O NOT BUSY, CHECK SPACE AGAIN 
          IX0    X2-X4        IN-OUT
          NG     X0,PUT.7 
          SA5    A4+B1
          SX5    X5+B1
          IX0    X2-X5        IN-(LIMIT+1)
          SX4    X4-PBUF
          NZ     X4,PUT.7 
          SX0    X0+1 
 PUT.7    SX0    X0+1 
          NG     X0,PUT.L     ROOM EXISTS, USE IT 
* 
          SX6    016B         MUST START I/O (WRITE)
          CIOCALL 
          EQ     PUT.4        LOOK FOR SPACE AGAIN
* 
 PUT.L    SA5    B3           PUT OUT A FEW WORDS 
          SB7    B7-B1        WORDS LEFT TO MOVE
          SX0    X0+B1        AVAILABLE SPACE 
          BX7    X5 
          SB3    B3+B1        NEXT SOURCE 
          SA7    X2 
          SX2    X2+B1        IN POINTER
          ZR     X0,PUT.8     JP IF NO MORE ROOM
          PL     B7,PUT.L     JP IF WORDS LEFT TO MOVE
* 
 PUT.8    SA5    PRINT+4      FIX UP -IN- POINTER 
          SX6    X2           IN
          SX5    X5 
          IX4    X2-X5
          NZ     X4,PUT.9 
          SX6    PBUF         USE FIRST IF AT LIMIT 
 PUT.9    SA6    A2 
          PL     B7,PUT.4     MOVE MORE, IF MORE TO MOVE
* 
          SA3    PRINT        CHECK FOR I/O RUNNING 
          LX3    59 
          PL     X3,PUT.X     YES, EXIT 
* 
          SA2    A2           COMPUTE NUMBER OF WORDS IN BUFFER 
          SA4    A2+B1        OUT 
          IX0    X2-X4
          PL     X0,PUT.10
          SA2    A2-B1        IF NEGATIVE, ADD LIMIT-FIRST
          SA4    A4+B1
          SX2    X2 
          SX4    X4 
          IX4    X4-X2
          IX0    X0+X4
 PUT.10   SX0    X0-1024      TRIGGER VALUE 
          NG     X0,PUT.X     NOT REACHED 
          SX6    016B         START I/O 
          CIOCALL 
* 
 PUT.X    JP     B6           EXIT
* 
* ERROR MESSAGE PROCESSING
* 
 ERROR.1  SX6    ERR.1
          EQ     ERROR
 ERROR.2  SX6    ERR.2
          EQ     ERROR
 ERROR.3  SX6    ERR.3
          EQ     ERROR
 ERROR.4  SX6    ERR.4
          EQ     ERROR
 ERROR.5  SX6    ERR.5
          EQ     ERROR
 ERROR.6  SX6    ERR.6
          EQ     ERROR
 ERROR.7  SX6    ERR.7
          EQ     ERROR
 ERROR.8  SX6    ERR.8
          EQ     ERROR
 ERROR.9  SX6    ERR.9
          EQ     ERROR
 ERROR.A  SX6    ERR.A
          EQ     ERROR
* 
 ERROR    SX5    3RMSG
          LX5    60-18
          BX6    X5+X6
          SYSCALL 
          SX6    3RABT
          LX6    60-18
          SYSCALL 
          PS
* 
* ERROR MESSAGES
* 
 ERR.1    DATA   26LCOPY8P- V-BLOCK HEADER BAD
 ERR.2    DATA   27LCOPY8P- V-RECORD HEADER BAD 
 ERR.3    DATA   22LCOPY8P- NO SOURCE FILE
 ERR.4    DATA   28LCOPY8P- UNRECOGNIZED KEYWORD
 ERR.5    DATA   27LCOPY8P- ILLEGAL RECFM FIELD 
 ERR.6    DATA   31LCOPY8P- NON-DIGIT IN SIZE FIELD 
 ERR.7    DATA   23LCOPY8P- CODE NOT A OR C 
 ERR.8    DATA   28LCOPY8P- ILLEGAL FORMAT VALUE
 ERR.9    DATA   23LCOPY8P- BLKSIZE TOO BIG 
 ERR.A    DATA   21LCOPY8P- LRECL TOO BIG 
* 
* SPECIAL TABLES
* 
 PTAB     DATA   5LRECFM
          DATA   7LBLKSIZE
          DATA   5LLRECL
          DATA   4LCODE 
          DATA   3LFMT
          DATA   4LFOLD 
          DATA   0
* 
 FTAB     EQ     B$REC
 +        EQ     B$BLK
 +        EQ     B$LRE
 +        EQ     B$COD
 +        EQ     B$FMT
 +        EQ     B$FOL
* 
 VTAB     VFD    30/1,30/1RF*64 
          VFD    30/1,30/2RFB 
          VFD    30/-1,30/1RV*64
          VFD    30/-1,30/2RVB
          VFD    30/0,30/1RU*64 
          DATA   0
* 
 PRTAB    CON    X20         BLANK  -SINGLE SPACE 
          CON    X30         0      -DOUBLE SPACE 
          CON    X2D         -      -TRIPLE SPACE 
* 
 MFMTAB   BSS    0            M- FORMATS
          VFD    1/0,29/X20,30/X09  WRITE, 1 SPACE
          VFD    1/1,29/X20,30/X0B         1 SPACE
          VFD    1/0,29/X31,30/X89  WRITE, PAGE EJECT 
 MSKP     VFD    1/1,29/X31,30/X8B         PAGE EJECT 
          VFD    1/0,29/X30,30/X11  WRITE, 2 SPACE
          VFD    1/1,29/X30,30/X13         2 SPACE
          VFD    1/0,29/X2D,30/X19  WRITE, 3 SPACE
          VFD    1/1,29/X2D,30/X1B         3 SPACE
          VFD    1/0,29/X2B,30/X01  WRITE, NO SPACE 
 MNOP     VFD    1/1,29/X2B,30/X03         NO OP
          VFD    1/0,29/X20,30/0        OTHER, =X09 
* 
*  DATA AREA
* 
 RECFM    DATA   0            0=U, -1=V, +1=F 
 BLKSIZE  DATA   137          MAXIMUM EXPECTED BLOCKSIZE
 LRECL    DATA   0            MAXIMUM LOGICAL RECORD SIZE 
 FMT      DATA   0            FORMAT CODE 
 MFMT     CON    X20          HOLDS LAST M-FORMAT CODE
 BLKSZR   DATA   0            RESIDUAL BLOCKSIZE
 TTYPE    DATA   1            TAPE TYPE (0=S, 1=SCOPE)
* 
* TABLE AREA
* 
 ETOA     BSS    0            EBCDIC TO ASCII 
*                          TO ASCII          FROM EBCDIC
          CON    X00          00 NUL              00 NUL           CTOA 
          CON    X01          01 SOH              01 SOH           CTOA 
          CON    X02          02 STX              02 STX           CTOA 
          CON    X03          03 ETX              03 ETX           CTOA 
          CON    X9C          9C                  04 PF            CTOA 
          CON    X09          09 HT               05 HT            CTOA 
          CON    X86          86                  06 LC            CTOA 
          CON    X7F          7F DEL              07 DEL           CTOA 
          CON    X97          97                  08 GE            CTOA 
          CON    X8D          8D                  09 RLF           CTOA 
          CON    X8E          8E                  0A SMM           CTOA 
          CON    X0B          0B VT               0B VT            CTOA 
          CON    X0C          0C FF               0C FF            CTOA 
          CON    X0D          0D CR               0D CR            CTOA 
          CON    X0E          0E SO               0E SO            CTOA 
          CON    X0F          0F SI               0F SI            CTOA 
          CON    X10          10 DLE              10 DLE           CTOA 
          CON    X11          11 DC1              11 DC1           CTOA 
          CON    X12          12 DC2              12 DC2           CTOA 
          CON    X13          13 DC3              13 TM            CTOA 
          CON    X9D          9D                  14 RES           CTOA 
          CON    X85          85                  15 NL            CTOA 
          CON    X08          08 BS               16 BS            CTOA 
          CON    X87          87                  17 IL            CTOA 
          CON    X18          18 CAN              18 CAN           CTOA 
          CON    X19          19 EM               19 EM            CTOA 
          CON    X92          92                  1A CC            CTOA 
          CON    X8F          8F                  1B CU1           CTOA 
          CON    X1C          1C FS               1C IFS           CTOA 
          CON    X1D          1D GS               1D IGS           CTOA 
          CON    X1E          1E RS               1E IRS           CTOA 
          CON    X1F          1F US               1F IUS           CTOA 
          CON    X80          80                  20 DS            CTOA 
          CON    X81          81                  21 SOS           CTOA 
          CON    X82          82                  22 FS            CTOA 
          CON    X83          83                  23               CTOA 
          CON    X84          84                  24 BYP           CTOA 
          CON    X0A          0A LF               25 LF            CTOA 
          CON    X17          17 ETB              26 ETB           CTOA 
          CON    X1B          1B ESC              27 ESC           CTOA 
          CON    X88          88                  28               CTOA 
          CON    X89          89                  29               CTOA 
          CON    X8A          8A                  2A SM            CTOA 
          CON    X8B          8B                  2B CU2           CTOA 
          CON    X8C          8C                  2C               CTOA 
          CON    X05          05 ENQ              2D ENQ           CTOA 
          CON    X06          06 ACK              2E ACK           CTOA 
          CON    X07          07 BEL              2F BEL           CTOA 
          CON    X90          90                  30               CTOA 
          CON    X91          91                  31               CTOA 
          CON    X16          16 SYN              32 SYN           CTOA 
          CON    X93          93                  33               CTOA 
          CON    X94          94                  34 PN            CTOA 
          CON    X95          95                  35 RS            CTOA 
          CON    X96          96                  36 UC            CTOA 
          CON    X04          04 EOT              37 EOT           CTOA 
          CON    X98          98                  38               CTOA 
          CON    X99          99                  39               CTOA 
          CON    X9A          9A                  3A               CTOA 
          CON    X9B          9B                  3B CU3           CTOA 
          CON    X14          14 DC4              3C DC4           CTOA 
          CON    X15          15 NAK              3D NAK           CTOA 
          CON    X9E          9E                  3E               CTOA 
          CON    X1A          1A SUB              3F SUB           CTOA 
          CON    X20          20 SP               40 SP            CTOA 
          CON    XA0          A0                  41               CTOA 
          CON    XA1          A1                  42               CTOA 
          CON    XA2          A2                  43               CTOA 
          CON    XA3          A3                  44               CTOA 
          CON    XA4          A4                  45               CTOA 
          CON    XA5          A5                  46               CTOA 
          CON    XA6          A6                  47               CTOA 
          CON    XA7          A7                  48               CTOA 
          CON    XA8          A8                  49               CTOA 
          CON    X5B          5B [                4A CENT          CTOA 
          CON    X2E          2E .                4B .             CTOA 
          CON    X3C          3C <                4C <             CTOA 
          CON    X28          28 (                4D (             CTOA 
          CON    X2B          2B +                4E +             CTOA 
          CON    X21          21 EXCLAM.PT        4F VERT.BAR      CTOA 
          CON    X26          26 AMPERSAND        50 AMPERSAND     CTOA 
          CON    XA9          A9                  51               CTOA 
          CON    XAA          AA                  52               CTOA 
          CON    XAB          AB                  53               CTOA 
          CON    XAC          AC                  54               CTOA 
          CON    XAD          AD                  55               CTOA 
          CON    XAE          AE                  56               CTOA 
          CON    XAF          AF                  57               CTOA 
          CON    XB0          B0                  58               CTOA 
          CON    XB1          B1                  59               CTOA 
          CON    X5D          5D ]                5A EXCLAM.PT     CTOA 
          CON    X24          24 $                5B $             CTOA 
          CON    X2A          2A *                5C *             CTOA 
          CON    X29          29 )                5D )             CTOA 
          CON    X3B          3B ;                5E ;             CTOA 
          CON    X5E          5E CIR.FLEX         5F NOT           CTOA 
          CON    X2D          2D -                60 -             CTOA 
          CON    X2F          2F /                61 /             CTOA 
          CON    XB2          B2                  62               CTOA 
          CON    XB3          B3                  63               CTOA 
          CON    XB4          B4                  64               CTOA 
          CON    XB5          B5                  65               CTOA 
          CON    XB6          B6                  66               CTOA 
          CON    XB7          B7                  67               CTOA 
          CON    XB8          B8                  68               CTOA 
          CON    XB9          B9                  69               CTOA 
          CON    X7C          7C VERT.BAR         6A VERT.BAR      CTOA 
          CON    X2C          2C ,                6B ,             CTOA 
          CON    X25          25 PERCENT          6C PERCENT       CTOA 
          CON    X5F          5F UNDERSCOR        6D UNDERSCOR     CTOA 
          CON    X3E          3E >                6E >             CTOA 
          CON    X3F          3F QUESTION         6F QUESTION      CTOA 
          CON    XBA          BA                  70               CTOA 
          CON    XBB          BB                  71               CTOA 
          CON    XBC          BC                  72               CTOA 
          CON    XBD          BD                  73               CTOA 
          CON    XBE          BE                  74               CTOA 
          CON    XBF          BF                  75               CTOA 
          CON    XC0          C0                  76               CTOA 
          CON    XC1          C1                  77               CTOA 
          CON    XC2          C2                  78               CTOA 
          CON    X60          60 GR.ACCENT        79 GR.ACCENT     CTOA 
          CON    X3A          3A COLON            7A COLON         CTOA 
          CON    X23          23 NUMBER           7B NUMBER        CTOA 
          CON    X40          40 COM.AT           7C COM.AT        CTOA 
          CON    X27          27 S.QUOTE          7D S.QUOTE       CTOA 
          CON    X3D          3D =                7E =             CTOA 
          CON    X22          22 D.QUOTE          7F D.QUOTE       CTOA 
          CON    XC3          C3                  80               CTOA 
          CON    X61          61 A - L.C.         81 A - L.C.      CTOA 
          CON    X62          62 B - L.C.         82 B - L.C.      CTOA 
          CON    X63          63 C - L.C.         83 C - L.C.      CTOA 
          CON    X64          64 F - L.C.         84 F - L.C.      CTOA 
          CON    X65          65 E - L.C.         85 E - L.C.      CTOA 
          CON    X66          66 F - L.C.         86 F - L.C.      CTOA 
          CON    X67          67 G - L.C.         87 G - L.C.      CTOA 
          CON    X68          68 H - L.C.         88 H - L.C.      CTOA 
          CON    X69          69 I - L.C.         89 I - L.C.      CTOA 
          CON    XC4          C4                  8A               CTOA 
          CON    XC5          C5                  8B               CTOA 
          CON    XC6          C6                  8C               CTOA 
          CON    XC7          C7                  8D               CTOA 
          CON    XC8          C8                  8E               CTOA 
          CON    XC9          C9                  8F               CTOA 
          CON    XCA          CA                  90               CTOA 
          CON    X6A          6A J - L.C.         91 J - L.C.      CTOA 
          CON    X6B          6B K - L.C.         92 K - L.C.      CTOA 
          CON    X6C          6C L - L.C.         93 L - L.C.      CTOA 
          CON    X6D          6D M - L.C.         94 M - L.C.      CTOA 
          CON    X6E          6E N - L.C.         95 N - L.C.      CTOA 
          CON    X6F          6F O - L.C.         96 O - L.C.      CTOA 
          CON    X70          70 P - L.C.         97 P - L.C.      CTOA 
          CON    X71          71 Q - L.C.         98 Q - L.C.      CTOA 
          CON    X72          72 R - L.C.         99 R - L.C.      CTOA 
          CON    XCB          CB                  9A               CTOA 
          CON    XCC          CC                  9B               CTOA 
          CON    XCD          CD                  9C               CTOA 
          CON    XCE          CE                  9D               CTOA 
          CON    XCF          CF                  9E               CTOA 
          CON    XD0          D0                  9F               CTOA 
          CON    XD1          D1                  A0               CTOA 
          CON    X7E          7E TILDE            A1 TILDE         CTOA 
          CON    X73          73 S - L.C.         A2 S - L.C.      CTOA 
          CON    X74          74 T - L.C.         A3 T - L.C.      CTOA 
          CON    X75          75 U - L.C.         A4 U - L.C.      CTOA 
          CON    X76          76 V - L.C.         A5 V - L.C.      CTOA 
          CON    X77          77 W - L.C.         A6 W - L.C.      CTOA 
          CON    X78          78 X - L.C.         A7 X - L.C.      CTOA 
          CON    X79          79 Y - L.C.         A8 Y - L.C.      CTOA 
          CON    X7A          7A Z - L.C.         A9 Z - L.C.      CTOA 
          CON    XD2          D2                  AA               CTOA 
          CON    XD3          D3                  AB               CTOA 
          CON    XD4          D4                  AC               CTOA 
          CON    XD5          D5                  AD               CTOA 
          CON    XD6          D6                  AE               CTOA 
          CON    XD7          D7                  AF               CTOA 
          CON    XD8          D8                  B0               CTOA 
          CON    XD9          D9                  B1               CTOA 
          CON    XDA          DA                  B2               CTOA 
          CON    XDB          DB                  B3               CTOA 
          CON    XDC          DC                  B4               CTOA 
          CON    XDD          DD                  B5               CTOA 
          CON    XDE          DE                  B6               CTOA 
          CON    XDF          DF                  B7               CTOA 
          CON    XE0          E0                  B8               CTOA 
          CON    XE1          E1                  B9               CTOA 
          CON    XE2          E2                  BA               CTOA 
          CON    XE3          E3                  BB               CTOA 
          CON    XE4          E4                  BC               CTOA 
          CON    XE5          E5                  BD               CTOA 
          CON    XE6          E6                  BE               CTOA 
          CON    XE7          E7                  BF               CTOA 
          CON    X7B          7B L.BRACE          C0 L.BRACE       CTOA 
          CON    X41          41 A                C1 A             CTOA 
          CON    X42          42 B                C2 B             CTOA 
          CON    X43          43 C                C3 C             CTOA 
          CON    X44          44 D                C4 D             CTOA 
          CON    X45          45 E                C5 E             CTOA 
          CON    X46          46 F                C6 F             CTOA 
          CON    X47          47 G                C7 G             CTOA 
          CON    X48          48 H                C8 H             CTOA 
          CON    X49          49 I                C9 I             CTOA 
          CON    XE8          E8                  CA               CTOA 
          CON    XE9          E9                  CB               CTOA 
          CON    XEA          EA                  CC HOOK          CTOA 
          CON    XEB          EB                  CD               CTOA 
          CON    XEC          EC                  CE FORK          CTOA 
          CON    XED          ED                  CF               CTOA 
          CON    X7D          7D R.BRACE          D0 R.BRACE       CTOA 
          CON    X4A          4A J                D1 J             CTOA 
          CON    X4B          4B K                D2 K             CTOA 
          CON    X4C          4C L                D3 L             CTOA 
          CON    X4D          4D M                D4 M             CTOA 
          CON    X4E          4E N                D5 N             CTOA 
          CON    X4F          4F O                D6 O             CTOA 
          CON    X50          50 P                D7 P             CTOA 
          CON    X51          51 Q                D8 Q             CTOA 
          CON    X52          52 R                D9 R             CTOA 
          CON    XEE          EE                  DA               CTOA 
          CON    XEF          EF                  DB               CTOA 
          CON    XF0          F0                  DC               CTOA 
          CON    XF1          F1                  DD               CTOA 
          CON    XF2          F2                  DE               CTOA 
          CON    XF3          F3                  DF               CTOA 
          CON    X5C          5C REV.SLASH        E0 REV.SLASH     CTOA 
          CON    X9F          9F                  E1               CTOA 
          CON    X53          53 S                E2 S             CTOA 
          CON    X54          54 T                E3 T             CTOA 
          CON    X55          55 U                E4 U             CTOA 
          CON    X56          56 V                E5 V             CTOA 
          CON    X57          57 W                E6 W             CTOA 
          CON    X58          58 X                E7 X             CTOA 
          CON    X59          59 Y                E8 Y             CTOA 
          CON    X5A          5A Z                E9 Z             CTOA 
          CON    XF4          F4                  EA               CTOA 
          CON    XF5          F5                  EB               CTOA 
          CON    XF6          F6                  EC CHAIR         CTOA 
          CON    XF7          F7                  ED               CTOA 
          CON    XF8          F8                  EE               CTOA 
          CON    XF9          F9                  EF               CTOA 
          CON    X30          30 0                F0 0             CTOA 
          CON    X31          31 1                F1 1             CTOA 
          CON    X32          32 2                F2 2             CTOA 
          CON    X33          33 3                F3 3             CTOA 
          CON    X34          34 4                F4 4             CTOA 
          CON    X35          35 5                F5 5             CTOA 
          CON    X36          36 6                F6 6             CTOA 
          CON    X37          37 7                F7 7             CTOA 
          CON    X38          38 8                F8 8             CTOA 
          CON    X39          39 9                F9 9             CTOA 
          CON    XFA          FA                  FA LVM           CTOA 
          CON    XFB          FB                  FB               CTOA 
          CON    XFC          FC                  FC               CTOA 
          CON    XFD          FD                  FD               CTOA 
          CON    XFE          FE                  FE               CTOA 
          CON    XFF          FF EO               FF               CTOA 
* 
 ATOD     BSS    0            ASCII TO DISPLAY CODE 
*                          TO DISPLAY CODE   FROM ASCII 
          DATA   55B          55 SP               20 SP            ATOX 
          DATA   66B          66 !                21 EXCLAM.PT     ATOX 
          DATA   64B          64 "                22 D.QUOTE       ATOX 
          DATA   60B          60 #                23 NUMBER        ATOX 
          DATA   53B          53 $                24 $             ATOX 
          DATA   63B          63 PERCENT          25 PERCENT       ATOX 
          DATA   67B          67 &                26 AMPERSAND     ATOX 
          DATA   70B          70 '                27 S.QUOTE       ATOX 
          DATA   51B          51 (                28 (             ATOX 
          DATA   52B          52 )                29 )             ATOX 
          DATA   47B          47 *                2A *             ATOX 
          DATA   45B          45 +                2B +             ATOX 
          DATA   56B          56 ,                2C ,             ATOX 
          DATA   46B          46 -                2D -             ATOX 
          DATA   57B          57 .                2E .             ATOX 
          DATA   50B          50 /                2F /             ATOX 
          DATA   33B          33 0                30 0             ATOX 
          DATA   34B          34 1                31 1             ATOX 
          DATA   35B          35 2                32 2             ATOX 
          DATA   36B          36 3                33 3             ATOX 
          DATA   37B          37 4                34 4             ATOX 
          DATA   40B          40 5                35 5             ATOX 
          DATA   41B          41 6                36 6             ATOX 
          DATA   42B          42 7                37 7             ATOX 
          DATA   43B          43 8                38 8             ATOX 
          DATA   44B          44 9                39 9             ATOX 
          DATA   00B          00 COLON            3A COLON         ATOX 
          DATA   77B          77 ;                3B ;             ATOX 
          DATA   72B          72 <                3C <             ATOX 
          DATA   54B          54 =                3D =             ATOX 
          DATA   73B          73 >                3E >             ATOX 
          DATA   71B          71 ?                3F QUESTION      ATOX 
          DATA   74B          74 @                40 COM.AT        ATOX 
          DATA   01B          01 A                41 A             ATOX 
          DATA   02B          02 B                42 B             ATOX 
          DATA   03B          03 C                43 C             ATOX 
          DATA   04B          04 D                44 D             ATOX 
          DATA   05B          05 E                45 E             ATOX 
          DATA   06B          06 F                46 F             ATOX 
          DATA   07B          07 G                47 G             ATOX 
          DATA   10B          10 H                48 H             ATOX 
          DATA   11B          11 I                49 I             ATOX 
          DATA   12B          12 J                4A J             ATOX 
          DATA   13B          13 K                4B K             ATOX 
          DATA   14B          14 L                4C L             ATOX 
          DATA   15B          15 M                4D M             ATOX 
          DATA   16B          16 N                4E N             ATOX 
          DATA   17B          17 O                4F O             ATOX 
          DATA   20B          20 P                50 P             ATOX 
          DATA   21B          21 Q                51 Q             ATOX 
          DATA   22B          22 R                52 R             ATOX 
          DATA   23B          23 S                53 S             ATOX 
          DATA   24B          24 T                54 T             ATOX 
          DATA   25B          25 U                55 U             ATOX 
          DATA   26B          26 V                56 V             ATOX 
          DATA   27B          27 W                57 W             ATOX 
          DATA   30B          30 X                58 X             ATOX 
          DATA   31B          31 Y                59 Y             ATOX 
          DATA   32B          32 Z                5A Z             ATOX 
          DATA   61B          61 [                5B [             ATOX 
          DATA   75B          75 \                5C REV.SLASH     ATOX 
          DATA   62B          62 ]                5D ]             ATOX 
          DATA   76B          76 ^                5E CIR.FLEX      ATOX 
          DATA   65B          65 _                5F UNDERSCOR     ATOX 
          DATA   74B          74 @                60 GR.ACCENT     ATOX 
          DATA   01B          01 A                61 A - L.C.      ATOX 
          DATA   02B          02 B                62 B - L.C.      ATOX 
          DATA   03B          03 C                63 C - L.C.      ATOX 
          DATA   04B          04 D                64 D - L.C.      ATOX 
          DATA   05B          05 E                65 E - L.C.      ATOX 
          DATA   06B          06 F                66 F - L.C.      ATOX 
          DATA   07B          07 G                67 G - L.C.      ATOX 
          DATA   10B          10 H                68 H - L.C.      ATOX 
          DATA   11B          11 I                69 I - L.C.      ATOX 
          DATA   12B          12 J                6A J - L.C.      ATOX 
          DATA   13B          13 K                6B K - L.C.      ATOX 
          DATA   14B          14 L                6C L - L.C.      ATOX 
          DATA   15B          15 M                6D M - L.C.      ATOX 
          DATA   16B          16 N                6E N - L.C.      ATOX 
          DATA   17B          17 O                6F O - L.C.      ATOX 
          DATA   20B          20 P                70 P - L.C.      ATOX 
          DATA   21B          21 Q                71 Q - L.C.      ATOX 
          DATA   22B          22 R                72 R - L.C.      ATOX 
          DATA   23B          23 S                73 S - L.C.      ATOX 
          DATA   24B          24 T                74 T - L.C.      ATOX 
          DATA   25B          25 U                75 U - L.C.      ATOX 
          DATA   26B          26 V                76 V - L.C.      ATOX 
          DATA   27B          27 W                77 W - L.C.      ATOX 
          DATA   30B          30 X                78 X - L.C.      ATOX 
          DATA   31B          31 Y                79 Y - L.C.      ATOX 
          DATA   32B          32 Z                7A Z - L.C.      ATOX 
          DATA   61B          61 [                7B L.BRACE       ATOX 
          DATA   75B          75 \                7C VERT.BAR      ATOX 
          DATA   62B          62 ]                7D R.BRACE       ATOX 
          DATA   76B          76 ^                7E TILDE         ATOX 
* 
 CH63     IF     DEF,IP.CSET
 CH63     IF     DEF,IP.C63 
 CH63     IFEQ   IP.CSET,IP.C63 
          ORG    ATOD+X25-X20    PER-CENT 
          DATA   55B             PRINTS AS SPACE
          BSS    ATOD+X3A-X20-*   COLON 
          DATA   63B             PRINTS AS COLON
 CH63     ENDIF 
* 
          BSS    ATOD+X7E+1-X20-* RESTORE LOCATION COUNTER
* 
 IDC      IFEQ   I8.IDC,1 
 ATOI     BSS    0           ASCII TO INTERNAL DISPLAY CODE 
*                          TO INTERNAL       FROM ASCII 
          DATA     55B                       20 SP                 ATOI 
          DATA     66B       !               21 EXCLAM.PT.         ATOI 
          DATA     64B       "               22 D.QUOTE            ATOI 
          DATA     60B       #               23 NUMBER             ATOI 
          DATA     53B       $               24 $                  ATOI 
          DATA     63B       PERCENT         25 PERCENT            ATOI 
          DATA     67B       &               26 AMPERSAND          ATOI 
          DATA     70B       '               27 S.QUOTE            ATOI 
          DATA     51B       (               28 (                  ATOI 
          DATA     52B       )               29 )                  ATOI 
          DATA     47B       *               2A *                  ATOI 
          DATA     45B       +               2B +                  ATOI 
          DATA     56B       ,               2C ,                  ATOI 
          DATA     46B       -               2D -                  ATOI 
          DATA     57B       .               2E .                  ATOI 
          DATA     50B       /               2F /                  ATOI 
          DATA     33B       0               30 0                  ATOI 
          DATA     34B       1               31 1                  ATOI 
          DATA     35B       2               32 2                  ATOI 
          DATA     36B       3               33 3                  ATOI 
          DATA     37B       4               34 4                  ATOI 
          DATA     40B       5               35 5                  ATOI 
          DATA     41B       6               36 6                  ATOI 
          DATA     42B       7               37 7                  ATOI 
          DATA     43B       8               38 8                  ATOI 
          DATA     44B       9               39 9                  ATOI 
          DATA     00B       COLON           3A COLON              ATOI 
          DATA     77B       ;               3B ;                  ATOI 
          DATA     72B       <               3C <                  ATOI 
          DATA     54B       =               3D =                  ATOI 
          DATA     73B       >               3E >                  ATOI 
          DATA     71B       ?               3F QUESTION           ATOI 
          DATA     74B       @               40 COM.AT             ATOI 
          DATA     01B       A               41 A                  ATOI 
          DATA     02B       B               42 B                  ATOI 
          DATA     03B       C               43 C                  ATOI 
          DATA     04B       D               44 D                  ATOI 
          DATA     05B       E               45 E                  ATOI 
          DATA     06B       F               46 F                  ATOI 
          DATA     07B       G               47 G                  ATOI 
          DATA     10B       H               48 J                  ATOI 
          DATA     11B       I               49 I                  ATOI 
          DATA     12B       J               4A J                  ATOI 
          DATA     13B       K               4B K                  ATOI 
          DATA     14B       L               4C L                  ATOI 
          DATA     15B       M               4D M                  ATOI 
          DATA     16B       N               4E N                  ATOI 
          DATA     17B       O               4F O                  ATOI 
          DATA     20B       P               50 P                  ATOI 
          DATA     21B       Q               51 Q                  ATOI 
          DATA     22B       R               52 R                  ATOI 
          DATA     23B       S               53 S                  ATOI 
          DATA     24B       T               54 T                  ATOI 
          DATA     25B       U               55 U                  ATOI 
          DATA     26B       V               56 V                  ATOI 
          DATA     27B       W               57 W                  ATOI 
          DATA     30B       X               58 X                  ATOI 
          DATA     31B       Y               59 Y                  ATOI 
          DATA     32B       Z               5A Z                  ATOI 
          DATA     61B       [               5B [                  ATOI 
          DATA     75B       \               5C REV.SLASH          ATOI 
          DATA     62B       ]               5D ]                  ATOI 
          DATA     76B       ^               5E CIR.FLEX           ATOI 
          DATA     65B       _               5F UNDERSCORE         ATOI 
          DATA   7600B                       60 GR.ACCENT          ATOI 
          DATA   7601B                       61 A - L.C.           ATOI 
          DATA   7602B                       62 B - L.C.           ATOI 
          DATA   7603B                       63 C - L.C.           ATOI 
          DATA   7604B                       64 D - L.C.           ATOI 
          DATA   7605B                       65 E - L.C.           ATOI 
          DATA   7606B                       66 F - L.C.           ATOI 
          DATA   7607B                       67 G - L.C.           ATOI 
          DATA   7610B                       68 H - L.C.           ATOI 
          DATA   7611B                       69 I - L.C.           ATOI 
          DATA   7612B                       6A J - L.C.           ATOI 
          DATA   7613B                       6B K - L.C.           ATOI 
          DATA   7614B                       6C L - L.C.           ATOI 
          DATA   7615B                       6D M - L.C.           ATOI 
          DATA   7616B                       6E N - L.C.           ATOI 
          DATA   7617B                       6F O - L.C.           ATOI 
          DATA   7620B                       70 P - L.C.           ATOI 
          DATA   7621B                       71 Q - L.C.           ATOI 
          DATA   7622B                       72 R - L.C.           ATOI 
          DATA   7623B                       73 S - L.C.           ATOI 
          DATA   7624B                       74 T - L.C.           ATOI 
          DATA   7625B                       75 U - L.C.           ATOI 
          DATA   7626B                       76 V - L.C.           ATOI 
          DATA   7627B                       77 W - L.C.           ATOI 
          DATA   7630B                       78 X - L.C.           ATOI 
          DATA   7631B                       79 Y - L.C.           ATOI 
          DATA   7632B                       7A Z - L.C.           ATOI 
          DATA   7633B                       7B L.BRACE            ATOI 
          DATA   7634B                       7C V ERT.BAR          ATOI 
          DATA   7635B                       7D R .BRACE           ATOI 
          DATA   7636B                       7E TILDE              ATOI 
 IDC      ENDIF 
* 
*  FILE AREA
* 
 PRINT    FILEB  PBUF,527 
 INPUT    FILEB  IBUF,2187,MLR=2185 
* 
 BLOCK1   BSSZ   2186         BLOCK STORAGE AREA  (32767 BYTES) 
 BLOCK    EQU    BLOCK1+1 
 REC1     BSSZ   1024+1            (5120 BYTES OUTPUT LINE LENGTH MAX)
 RECORD   EQU    REC1+1            (5120 BYTES OUTPUT LINE LENGTH MAX)
 RECLIM   EQU    RECORD+1023       (5120 BYTES OUTPUT LINE LENGTH MAX)
* 
 PBUF     BSSZ   527
 IBUF     BSSZ   2187         THIS BUFFER WILL EXPAND TO FL 
* 
          END    BEGIN
