Retro1.org codex

          IDENT  MODIFY,FETS,MODIFY
          ABS
          ENTRY  MODIFY
          ENTRY  RFL=
          SYSCOM B1
 MODIFY   TITLE  MODIFY - SOURCE LIBRARY EDITING PROGRAM.
*COMMENT  MODIFY - SOURCE LIBRARY EDITING PROGRAM.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 DOC      SPACE  4
***       MODIFY - SOURCE LIBRARY EDITING PROGRAM.
*         G. R. MANSFIELD.   69/06/22.
*         A. D. FORET.       74/12/05.
*         A. D. FORET.       76/08/04.
          SPACE  4,20
***              MODIFY IS A SOURCE LIBRARY EDITING PROGRAM
*         DESIGNED TO AID IN THE DEVELOPMENT AND MAINTENANCE
*         OF A SYSTEM OF PROGRAMS OR DECKS.  THE SOURCE LINES
*         ARE MAINTAINED IN SUCH A MANNER THAT EACH DIRECTIVE HAS
*         PERMANENT SEQUENCING INFORMATION AS LONG AS THE LINE
*         REMAINS ON THE PROGRAM LIBRARY.
 CARD     SPACE  4,20
***       COMMAND CALL.
*
*         MODIFY(P1,P2,P3...PN)
*
*         *PN*  MAY BE ONE OF THE FOLLOWING -
*
*         SECOND DEFAULT IS THE VALUE OF THE PARAMETER IF IT IS NOT
*         EQUATED.  IF NO SECOUND DEFAULT IS SPECIFIED IT IS THE SAME
*         AS THE FIRST DEFAULT.
*
*         PN     DESCRIPTION
*
*         I      DIRECTIVE INPUT.  DEFAULT IS  *INPUT*.
*
*         P      PROGRAM LIBRARY FILE.  DEFAULT IS  *OPL*.
*
*         C      COMPILE FILE OUTPUT.  DEFAULT IS  *COMPILE*.
*
*         N      NEW PROGRAM LIBRARY.  DEFAULT IS NOT SELECTED.
*                            SECOND DEFAULT IS  *NPL*.
*
*         S      SOURCE FILE.  DEFAULT IS NOT SELECTED.
*                            SECOND DEFAULT IS  *SOURCE*.
*
*         L      LIST OUTPUT FILE.  DEFAULT IS  *OUTPUT*.
*
*         LO     LIST OPTIONS.  DEFAULT IS *E* IF LIST OUTPUT FILE IS
*                ASSIGNED TO THE TERMINAL, OTHERWISE DEFAULT IS
*                *ECTMWDS*.
*
*                OPTION      DESCRIPTION
*
*                E           ERRORS.
*                C           DIRECTIVES OTHER THAN  *INSERT*,
*                               *DELETE*, AND  *RESTORE*.
*                T           INPUT TEXT.
*                M           MODIFICATIONS PERFORMED.
*                W           COMPILE FILE DIRECTIVES.
*                D           DECK STATUS.
*                S           STATISTICS.
*                I           INACTIVE LINES.
*                A           ACTIVE LINES.
*
*
*         A      WRITE COMPRESSED COMPILE.  DEFAULT IS NOT SELECTED.
*
*         BL     BURSTABLE LISTING.  GENERATE OUTPUT LISTING EASILY
*                SEPARABLE INTO COMPONENTS.  A NEW PAGE WILL BE
*                STARTED ON THE OUTPUT LISTING FOR EACH INDIVIDUAL
*                DECK.  DEFAULT IS NOT SELECTED.
*
*         D      IGNORE ALL ERRORS. DEFAULT IS NOT SELECTED.
*
*         F      MODIFY ALL DECKS.  DEFAULT IS NOT SELECTED.
*
*         U      MODIFY ONLY DECKS MENTIONED ON *DECK* DIRECTIVES.
*                            DEFAULT IS NOT SELECTED.
*
*         NR     NO REWIND ON COMPILE.  DEFAULT IS NOT SELECTED.
*
*         X      REWIND  *INPUT*  AND  *OUTPUT*  FILES, SET  *A*
*                            OPTION AND CALL SPECIFIED PROGRAM WHEN
*                            MODIFICATION IS COMPLETE.  DEFAULT PROGRAM
*                            IS  *COMPASS*.  DEFAULT IS NOT SELECTED.
*
*         Q      SAME AS  *X*  EXCEPT THAT  *INPUT*  AND  *OUTPUT*
*                            ARE NOT REWOUND.
*
*         Z      TAKE DIRECTIVES ONLY FROM COMMAND.  DEFAULT IS
*                            NOT SELECTED.
*                EXAMPLE -   MODIFY(...Z...)XDDDDDXDDDXDDD
*                            X  IS ANY CHARACTER NOT IN  *D*.
*                            D  IS A MODIFY DIRECTIVE.
*
*         CV     CONVERSION OPTION. DEFAULT NOT SELECTED.
*                *CV* MAY BE EITHER 63 OR 64.
*                CV=MAD64 INDICATES THAT MODIFY SHOULD CONVERT THE
*                OLD *MADIFY* COMPRESSION CODES TO THE MODIFY CODE.
*
*         IF  *X*  OR  *Q*  OPTIONS ARE SELECTED THE FOLLOWING
*                ADDITIONAL OPTIONS APPLY.
*
*         CB     SET ASSEMBLER  *B*  ARGUMENT.  DEFAULT IS  *LGO*.
*
*         CS     SET ASSEMBLER  *S*  ARGUMENT.  DEFAULT IS  *SYSTEXT*.
*
*         CG     SET ASSEMBLER  *G*  ARGUMENT.  DEFAULT IS  *0*.
*                            SECOND DEFAULT IS *SYSTEXT*.
*
*         CL     SET ASSEMBLER  *L*  ARGUMENT.  DEFAULT IS  *0*.
*                            SECOND DEFAULT IS  *OUTPUT*.
 DAYFILE  SPACE  4,25
***       DAYFILE MESSAGES.
*
*
*         * MODIFICATION COMPLETE.* - NORMAL COMPLETION MESSAGE.
*
*         * MODIFICATION ERRORS.* - ERRORS ENCOUNTERED WHILE
*                PROCESSING DIRECTIVES.
*
*         * ERROR IN MODIFY ARGUMENTS.* - AN INCORRECT COMMAND
*                OPTION WAS ENCOUNTERED.
*
*         * FILE NAME CONFLICT.* - TWO OR MORE FILES HAVE THE SAME
*                NAME.
*
*         * DIRECTIVE ERRORS.* - INCORRECT DIRECTIVES WERE ENCOUNTERED.
*
*         * NO DIRECTIVES.* - INPUT FILE WAS EMPTY, AND DIRECTIVES
*                WERE REQUIRED.
*
*         * ERROR IN DIRECTORY.* - THE DIRECTORY ON THE PROGRAM
*                LIBRARY WAS NOT IN THE PROPER FORMAT.
*
*         * PL ERROR IN DECK DECKNAM* - AN ERROR WAS ENCOUNTERED
*                DURING PROCESSING OF DECK  *DECKNAM*.
*
*         * PROGRAM LIBRARY EMPTY.* - THE SPECIFIED OPL FILE CONTAINED
*                NO DATA.
*
*         * -LO- ERROR, MUST BE IN -ECTMWDSIA-.* -  *LO*  OPTION
*                SPECIFIED NOT VALID.
*
*         *       NNNN ERRORS IN DECKNAM - * - DECK  *DECKNAM*
*                CONTAINED  *NNNN*  ERRORS.
*
*         * S OPTION INCORRECT WITH A, X OR Q.* - COMPRESSED COMPILE
*                AND SOURCE OUTPUT NOT ALLOWED SIMULTANEOUSLY.
*
*         * X OR Q INCORRECT WITHOUT COMPILE.* - SELECTION OF *X*
*                OR *Q* OPTIONS WITHOUT WRITING A COMPILE FILE
*                IS NOT PERMITTED.
*
*         * DECKNAM - INCORRECT CS, 63 ASSUMED.* - CHARACTER SET
*                IDENTIFICATION FOR DECK  *DECKNAM*  DID NOT INDICATE
*                IT WAS EITHER 63 OR 64 CHARACTER SET.  MODIFY
*                ASSUMES IT TO BE 63 CHARACTER SET AND MAKES IT
*                SUCH ON A NEW PROGRAM LIBRARY, IF ONE IS BEING
*                CREATED.
*
*         * DECKNAM - MIXED CHARACTER SET DETECTED.* - UPON EDITING
*                THE INDICATED DECK MODIFY DETECTED THAT THE CHARACTER
*                SET OF THIS DECK WAS DIFFERENT FROM THOSE ALREADY
*                PROCESSED.  PROGRAM LIBRARIES CONTAINING RECORDS OF
*                MORE THAN ONE CHARACTER SET ARE INCORRECT.
*
*         * REDUNDANT CONVERSION IGNORED.* - CONVERSION TO THE
*                DESIRED CHARACTER SET IS REDUNDANT SINCE THE
*                OLD PROGRAM LIBRARY IS ALREADY IN THE SPECIFIED
*                RESULTANT CHARACTER SET MODE.
*
*         *INCORRECT CS ON INPUT.* - A 64 CHARACTER INPUT WAS
*                DETECTED WHILE THE PL IS 63.  THIS MIXED MODE
*                IS NOT ALLOWED.  A 63 CHARACTER SET ZERO CHARACTER
*                IS NOT DEFINED.
*
*         * CSET - UNKNOWN CHARACTER SET.* - AN UNKNOWN CHARACTER
*                SET WAS SPECIFIED.
*
*         * DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK*
*                A REDUNDANT NESTED CALL WAS FOUND.  A CALL, CALLC,
*                NIFCALL, OR IFCALL CALLS A COMMON DECK WHICH HAS
*                HAS ALREADY BEEN CALLED IN THE CURRENT NESTING
*                SEQUENCE.
 
 OPERATOR SPACE  4,15
***       OPERATOR MESSAGES.
*
*         * MODIFY / DECKNAM * -  DECK  *DECKNAM*  IS CURRENTLY HAVING
*                MODIFICATIONS PROCESSED AGAINST IT.
*
*         * CREATE / DECKNAM * - DECK  *DECKNAM*  IS CURRENTLY BEING
*                TRANSFORMED FROM SOURCE TO COMPRESSED FORMAT.
*
*         * IGNORE / DECKNAM * - MODIFICATIONS TO DECK  *DECKNAM*
*                ARE BEING IGNORED, IN RESPONSE TO AN  *IGNORE*
*                DIRECTIVE.
*
*         * SKIP  / RECNAME * - RECORD  *RECNAME*  IS BEING SKIPPED.
 MODIFY   TITLE  GENERAL DESCRIPTION.
***       THE MODIFY EDITING PROCESS IS CONTROLLED BY THE USE OF
*         DIRECTIVE LINES, WHICH ARE NORMALLY READ FROM THE JOB
*         INPUT FILE.  A DIRECTIVE CONSISTS OF A PREFIX CHARACTER
*         IN COLUMN ONE FOLLOWED IMMEDIATELY BY A DIRECTIVE NAME.  THE
*         PREFIX CHARACTER IS PRESET TO  -*-, BUT MAY BE CHANGED VIA A
*         DIRECTIVE. THE DIRECTIVE IS TERMINATED BY ANY CHARACTER
*         WITH A DISPLAY CODE VALUE .GE. 55B.  THE MAXIMUM LENGTH OF
*         ANY MODIFY NAME IS SEVEN CHARACTERS.
*
*         OUTPUT FROM MODIFY IS PLACED ON A FILE CALLED  *COMPILE*  FOR
*         FURTHER PROCESSING BY OTHER PROGRAMS.  THESE LINES CONTAIN
*         SEQUENCING INFORMATION AFTER THE LAST CHARACTER OF SOURCE
*         DATA.  THIS INFORMATION MAY BE SUPPRESSED OR IT,S POSITION
*         CHANGED VIA DIRECTIVES. THE  *COMPILE*  MAY ALSO BE DIVIDED
*         INTO LOGICAL RECORDS OR FILES.
*
*         THE PROGRAM LIBRARY CONSISTS OF TWO OR MORE LOGICAL RECORDS
*         OF SOURCE LINES WHICH ARE REFERRED TO AS DECKS. THE USUAL
*         DECKS CONSISTS OF A SINGLE PROGRAM.  CERTAIN DECKS MAY BE
*         *COMMON*  DECKS.  COMMON DECKS MAY BE CALLED FROM OTHER DECKS
*         FOR INSERTION OF THE TEXT OF THE  *COMMON*  DECK INTO THE
*         COMPILE FILE.  THIS FEATURE ALLOWS SEVERAL ROUTINES TO SHARE
*         IDENTICAL SUBROUTINES OR DATA BLOCKS. *COMMON* DECKS MAY ALSO
*         BE CALLED FROM OTHER *COMMON* DECKS.
*
*         THE PROGRAM LIBRARY IS TREATED AS A RANDOM ACCESS FILE AND
*         AS SUCH, MUST RESIDE ON MASS STORAGE. A DIRECTIVE IS PROVIDED
*         FOR COPYING THE PROGRAM LIBRARY ONTO MASS STORAGE.
*
*         DECKS MAY REMOVED, REPLACED, OR INSERTED INTO THE PROGRAM
*         LIBRARY BY USE OF COPY UTILITIES SUCH AS  *COPYX*, *COPYBR*,
*         OR  *LIBEDIT*.
*
*         DECKS MAY BE MODIFIED BY INSERTION, DELETION, AND RESTORATION
*         OF LINES VIA DIRECTIVE.  DELETED LINES ARE MARKED INACTIVE,
*         BUT NOT DELETED FROM THE PROGRAM LIBRARY.  THE LINE MAY BE
*         REACTIVATED BY RESTORATION.
*
*         FACILITIES INCLUDED IN MODIFY ARE -
*
*         PREPARATION OF PROGRAM LIBRARY FROM SOURCE.
*         MODIFICATION OF DECKS BY INSERTION, DELETION, AND RESTORATION.
*         PRODUCTION OF SOURCE FROM THE PROGRAM LIBRARY.
*         GENERATION OF PROGRAM LIBRARIES.
*         COMPREHENSIVE LIST OUTPUT OF THE MODIFICATION PROCESS.
*         COMPREHENSIVE LIST OUTPUT OF THE STATUS OF THE LIBRARY.
*         CONTROL OF MODIFIED OUTPUT FOR PROCESSING BY OTHER PROCESSORS.
*         ABILITY TO PROCESS INPUT FROM ALTERNATE INPUT FILES.
*         PROCESSING OF DIRECTIVES FROM THE MODIFY COMMAND.
*         DIVISION OF COMPILE FILE INTO RECORDS AND FILES.
*         ABILITY TO SIMULTANEOUSLY PROCESS MORE THAN ONE LIBRARY.
*         SUPPORT OF 63 OR 64 CHARACTER SET PROGRAM LIBRARIES.
*         CONDITIONAL PROCESSING OF OUTPUT TO COMPILE FILE.
 FILES    TITLE  FILE FORMATS.
**        FILE FORMATS.
*
*         SOURCE.
*                THE SOURCE FILE CONSISTS OF ONE OR MORE RECORDS
*         REPRESENTING THE DECKS.  EACH DECK IS PRECEEDED BY ONE OR TWO
*         LINES WHICH ARE USED FOR DECK GENERATION. THE FIRST
*         CONTAINS THE NAME OF THE DECK BEGINNING IN COLUMN ONE.
*         THE SECOND LINE, IF IT CONTAINS THE NAME *COMMON* BEGINNING
*         IN COLUMN ONE, SIGNIFIES THAT THE DECK WILL BE GIVEN COMMON
*         STATUS ON THE PROGRAM LIBRARY.  THESE LINE(S) ARE NOT PART
*         OF THE DECK RECORD WHEN PLACED ON THE PROGRAM LIBRARY.
*
*
*         PROGRAM LIBRARY.
*
*                THE PROGRAM LIBRARY CONTAINS TWO OR MORE RECORDS.
*         THE LAST RECORD IS A DIRECTORY OF ALL PRECEEDING RECORDS.
*         EACH DECK RECORD IS OF THE FOLLOWING FORMAT -
*
*         WORD   CONTENTS
*
*         PREFIX TABLE.
*
*T ID     12/7700,12/0016,36/
*T,ID+1   42/DECKNAM,18/
*T,ID+2   60/CREATION DATE
*T,ID+3   60/LAST MODIFICATION DATE
*T,ID+4   60/
*T,ID+5   60/
*T,ID+6   60/
*T,ID+7   60/
*T,ID+10  60/
*T,ID+11  60/
*T,ID+12  60/
*T,ID+13  60/
*T,ID+14  60/
*T,ID+15  60/
*T,ID+16  48/,6/A,6/CS
*
*         A      ASCII CHARACTER SET FLAG.
*                1  =  ASCII 6/12 CHARACTER SET.
*                0  =  DISPLAY CODE.
*
*         CS     CHARACTER SET OF RECORD.
*                64 = 64 CHARACTER SET.
*                0  = 63 CHARACTER SET.
*                OTHER, IMPLIES 63 CHARACTER SET.
*
*
*         MODIFIER TABLE, N+1 WORDS LONG.
*
*T  MT    12/TYPE,36/,12/N
*T, MT+1  42/MODNAM,1/,1/Y,16/
*
*         TYPE   7001, IF NORMAL DECK.
*                7002, IF COMMON DECK.
*         N      NUMBER OF MODIFIERS.
*         Y      YANK FLAG.
*
*         MODNAM MODIFIER NAME.
*
*         CONTROL INFORMATION FOR EACH LINE.
*
*T CARD   1/A,5/WC,18/SEQ,18/MHB,18/MHB
*T,CARD+1 6/,18/MHB,18/MHB,18/MHB
*T,CARD+2 6/,18/MHB,18/MHB,18/END
*T,LINE+N 60/TEXT OF COMPRESSED LINE
*
*         A      IF SET, LINE IS ACTIVE.
*         WC     WORD COUNT OF COMPRESSED LINE.
*         SEQ    LINE SEQUENCE NUMBER.
*         END    THE LIST OF MHB-S IS TERMINATED BY ONE TO FIVE ZERO
*                            BYTES, AS REQUIRED TO FILL THE WORD.
*
*         MODIFICATION HISTORY BYTE.
*
*T MHB    1/,1/A,16/MOD
*
*         MOD    ORDINAL INTO MODIFIER TABLE OF THE MODIFIER THAT
*                            CAUSED THIS STATUS CHANGE FOR THE LINE.
*                0, IF ORIGINAL LINE.
*         A      SET IF THE MODIFIER ACTIVATED THE LINE.
*
*         PROGRAM LIBRARY DIRECTORY.
*
*         THE PREFIX TABLE FOR THE PROGRAM LIBRARY DIRECTORY
*         IS IN STANDARD KRONOS PREFIX TABLE FORMAT.
*
*         DIRECTORY TABLE.
*
*T DIR       12/7000,30/,18/L
*T DIR+1     42/DECK NAME 1,18/TYPE
*T DIR+2     30/,30/RANDOM ADDRESS 1
*T DIR+3     42/DECK NAME 2,18/TYPE
*T DIR+4     30/,30/RANDOM ADDRESS 2
*T DIR+N*2   42/ DECK NAME N,18/TYPE
*T DIR+N*2+1 30/,30/RANDOM ADDRESS N
*
*         L      LENGTH IN WORDS.
*         TYPE   7001, IF NORMAL DECK
*                7002, IF COMMON DECK.
          TITLE  ASSEMBLY CONSTANTS AND MACRO DEFINITIONS.
 ASSEMBLY SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 OBUFL    EQU    4004B       OUTPUT BUFFER LENGTH
 CBUFL    EQU    10022B      COMPILE FILE BUFFER LENGTH
 SBUFL    EQU    4004B       SOURCE FILE BUFFER LENGTH
 MBUFL    EQU    10022B      SCRATCH FILE BUFFER LENGTH
 PBUFL    EQU    16044B      OPL FILE BUFFER LENGTH
 NBUFL    EQU    10022B      NPL FILE BUFFER LENGTH
 TBUFL    EQU    4004B       SCRATCH BUFFER (MULTIPLE OF 1001B)
 IWMACS   EQU    150         MAXIMUM INPUT LINE WIDTH 150 CHARACTERS
 IWMAX    EQU    IWMACS*2    MAXIMUM INPUT WIDTH BUFFER SIZE
 BUFL     EQU    IWMAX+1     BUFFER LENGTH
 FLINL    EQU    2000B       FIELD LENGTH INCREMENT
 MTBSL    EQU    14000B      NOMINAL TABLE LENGTH
 MXCCL    EQU    37B         MAXIMUM LENGTH OF COMPRESSED LINE
 CMFL     EQU    600B        *COMPASS* DEFAULT FL
 FETLEN   EQU    10          ALL FETS MUST BE 10 WORDS LONG
 FETODL   EQU    16          LENGTH OF OD FET EXTENSION
 
****
 COMMON   SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSSRT
 MACROS   SPACE  4,20
**        MACRO DEFINITIONS.
 
 
 ADDWRD SPACE    4,10
**        ADDWRD - ADD WORD TO TABLE.
*
*         ADDWRD TNAM,WORD
*
*         TNAM   NAME OF TABLE.
*         WORD   WORD TO ADD.
*
*         CALLS  ADW.
 
 
          PURGMAC ADDWRD
 
 ADDWRD   MACRO T,W
  IFC NE,$X1$W$,1
  BX1 W
  R= A0,T
  RJ ADW
  ENDM
 CARD     SPACE  4,20
**        CARD - GENERATE LIST AND CALL FOR DIRECTIVE TRANSLATION.
*
*         CARD   NAME,ADDR
*
*         NAME   DIRECTIVE NAME.
*         ADDR   ADDRESS OF DIRECTIVE PROCESSOR
*                IF  *ADDR*  NOT SPECIFIED, EXECUTION BEGINS
*                AT  *NAME*.
*
*         CALLS  CKC.
 
 
          NOREF  .X
          PURGMAC CARD
 
 CARD     MACRO  N,AD
  LOCAL A,B,C
  IF DEF,//.X,1
 D IFNE //.X,*
  RMT
  CON 0
 A BSS 0
  RMT
  SA0 A
  RJ CKC
  QUAL
 B BSS 0
 .X SET B
  QUAL *
 D ENDIF
  RMT
 C SET AD N
  CON 0L_N+C
  RMT
  ENDM
 ALLOC    SPACE  4,10
**        ALLOC - ALLOCATE  *N*  ADDITIONAL WORDS TO TABLE  *TNAM*.
*
*         ALLOC  TNAM,N,S
*
*         TNAM   TABLE NAME.
*         N      NUMBER OF WORDS TO ALLOCATE.
*         S      ALLOCATE TABLE SLACK ROOM ONLY.
*
*         CALLS  ATS, ATX.
 
 
          PURGMAC ALLOC
 
 ALLOC    MACRO  T,N,S
  R= X1,N
  R= A0,T
  IFC EQ,$S$$
  RJ ATS
  ELSE
  RJ ATX
  ENDIF
  ENDM
 PRINT    SPACE  4,10
**        PRINT - PRINT LINE.
*
*         PRINT  FWA,N
*
*         FWA    FWA OF LINE.
*         N      WORD COUNT OF LINE IN  *S*  FORMAT.  IF MISSING
*                LINE IN  *C*  FORMAT.
*
*         CALLS  WOF.
 
 
          PURGMAC PRINT
 
 PRINT    MACRO  F,N
  SX1 F
  IFC NE,$N$$
  R= X2,N
  ELSE
  BX2 X2-X2
  ENDIF
  RJ WOF
  ENDM
 SEARCH   SPACE  4,20
**        SEARCH - SEARCH TABLE  *TNAM*  FOR  *ENTRY*.
*
*         SEARCH TNAM,ENTRY,BITS
*
*         TNAM   TABLE NAME.
*         ENTRY  ENTRY TO SEARCH FOR.
*         BITS   ADDITIONAL BITS FROM 0 - 16.
*
*         CALLS  STB.
 
 
          PURGMAC SEARCH
 
 SEARCH   MACRO  T,E,B
  R= A0,T
  IFC NE,$X6$E$,1
  BX6 E
  MX1 42
  IFC NE,$B$$,2
  R= X2,B
  BX1 X1+X2
  RJ STB
  ENDM
 TABLE    SPACE  4,15
**        TABLE - GENERATE MANAGED TABLE.
*
*         TABLE  TNAM
*
*         TNAM   NAME OF TABLE.
*
*         EXIT   F.TNAM - NAME OF WORD CONTAINING TABLE FWA.
*                L.TNAM - NAME OF WORD CONTAINING TABLE LENGTH.
 
 
          PURGMAC TABLE
 
          MACRO  TABLE,T,N
 T EQU *
  CON MTBS
 F.T EQU FTAB+T
  RMT
 L.T EQU LTAB+T
  ORG L.T
  CON 0
  ORG NTAB+T
  CON N
  RMT
  ENDM
 LISTOP   SPACE  4,15
**        LISTOP - CHECK LIST OPTION.
*
*         LISTOP TYPE,ADDR,INS,REG
*
*         TYPE   OPTION LETTER.
*         ADDR   ADDRESS TO JUMP TO.
*         INS    ALTERNATE INSTRUCTION TO EXECUTE, DEFAULT IS  *PL*.
*         REG    ALTERNATE REGISTER TO USE, DEFAULT IS  *X1*.
 
 
          PURGMAC LISTOP
 
 LISTOP   MACRO  T,A,I,R
 .INS MICRO 1,2,*I_PL*
 .REG MICRO 1,1,*R_1*
  SA".REG" LO
  LX".REG" 59-LO.T
  ".INS" X".REG",A
  ENDM
 OPTION   SPACE  4,15
**        OPTION - DEFINE BIT VALUE OF OPTION.
*
*         OPTION TYPE
*
*         TYPE   OPTION LETTER.
*
*         THE SYMBOL LO.X IS GENERATED, WHERE X IS THE OPTION BIT
*                CORRESPONDING TO THE LETTER  *X*.
 
 
 .OPT     SET    0
          NOREF  .OPT
          PURGMAC OPTION
 
 OPTION   MACRO  T
 LO.T EQU .OPT
 .OPT SET .OPT+1
 OPTION RMT
  CON 0R_T
 OPTION RMT
 LO.T DECMIC LO.T
  ENDM
 READK    SPACE  4
***       READK - READ CODED LINE TO WORKING BUFFER.
*
*
*         READK  FILE,BUF,N
*
*         WORDS ARE UNPACKED AND STORED IN THE WORKING BUFFER ONE 6/12
*         CHARACTER/WORD UNTIL THE END OF LINE (0000) BYTE IS SENSED.
*         IF THE CODED LINE TERMINATES BEFORE *N* CHARACTERS ARE
*         STORED, THE WORKING BUFFER IS FILLED WITH SPACE CODES.
*
*         CALLS  SSR.
 
 
          PURGMAC READK
 
 READK    MACRO  F,S,N
  R= B6,S
  R= B7,N
  R= X2,F
  RJ =XSSR
  ENDM
 WRITEK   SPACE  4,10
***       WRITEK - WRITE CODED LINE FROM LINE BUFFER.
*
*
*         WRITEK FILE,BUF,N
*
*         6/12 CHARACTERS ARE PACKED FROM THE WORKING BUFFER 5-10
*         CHARACTERS PER WORD.
*         TRAILING CODES ARE DELETED BEFORE CHARACTERS ARE PACKED.
*
*         CALLS  SSW.
 
 
          PURGMAC WRITEK
 
 WRITEK   MACRO  F,S,N
  R= B6,S
  R= B7,N
  R= X2,F
  RJ =XSSW
  ENDM
 QUAL     SPACE  4
**        DEFINE QUAL BLOCK ORDER.
 
 
          QUAL
          QUAL   DIRECT
          QUAL   PRESET
          QUAL   MACRO$
          QUAL
 FETS     TITLE  FILE DEFINITIONS.
**        FILE DEFINITIONS.
 
 
          ORG    110B
 FETS     BSS    0           ALL FETS ARE 26 WORDS LONG
 
 I        BSS    0           DIRECTIVE INPUT FILE
 INPUT    FILEC  SBUF,SBUFL,FET=10
          BSSZ   FETODL
 
 O        BSS    0           LIST OUTPUT FILE
 OUTPUT   FILEC  OBUF,OBUFL,FET=10
          BSSZ   FETODL
 
 C        BSS    0           COMPILE FILE
 COMPILE  FILEC  CBUF,CBUFL+SBUFL,FET=10
          BSSZ   FETODL
 
 S        BSS    0           SOURCE FILE
 SOURCE   FILEC  SBUF,SBUFL,FET=10
          ORG    S
          CON    0
          ORG    S+FETLEN
          BSSZ   FETODL
 
 M        BSS    0           SCRATCH FILE
 ZZZZZG0  RFILEB MBUF,MBUFL,FET=10
          ORG    M+7
          CON    0LSCR1+3
          ORG    M+FETLEN
          BSSZ   FETODL
 
 P        BSS    0           PROGRAM LIBRARY FILE
 OPL      RFILEB PBUF,PBUFL,FET=10
          ORG    P+7
          CON    0LOPL+3
          ORG    P+FETLEN
          BSSZ   FETODL
 
 N        BSS    0           NEW PROGRAM LIBRARY FILE
 NPL      RFILEB NBUF,NBUFL,FET=10
          ORG    N
          CON    0
          ORG    N+8
          ORG    N+FETLEN
          BSSZ   FETODL
 
 A        BSS    0           SCRATCH FILE
 ZZZZZG1  RFILEC CBUF,CBUFL,FET=10
          ORG    A+7
          CON    0LSCR2+3
          ORG    A+FETLEN
          BSSZ   FETODL
 
 T        BSS    0           INSERTION TEXT OVERFLOW FILE
 ZZZZZG2  RFILEB TBUF,TBUFL,FET=10
          ORG    T
          CON    0
          ORG    T+7
          CON    0LSCR3+3
          ORG    T+FETLEN
          BSSZ   FETODL
 
 
 FETSL    BSS    0
          TITLE  MANAGED TABLE DEFINITIONS.
 TABLES   SPACE  4,10
**        MODIFY MANAGED TABLES.
*
*         MANAGED TABLES ARE REFERENCED BY TABLE NUMBER  *TNAM*.
*
*         F.TNAM FWA OF TABLE.
*         L.TNAM LENGTH OF TABLE.
*
*         *TABLE*  MACRO GENERATES THE ABOVE SYMBOLS.
 
 
 FTAB     BSS    0
          LOC    0
 TDKN     SPACE  4,10
**        TDKN - TABLE OF DECK NAMES.
*
*T TDKN   42/DECK NAME,18/
*T,TDKN+1 24/ADDRESS OF FILE NAME,36/RANDOM ADDRESS OF RECORD
 
 
 TDKN     TABLE  10          TABLE OF DECK NAMES
 TNME     SPACE  4,15
**        TNME - TABLE OF NAMES MENTIONED ON DIRECTIVE LINES.
*
*T TNME   42/ NAME, 1/, 1/ U, 1/ Y, 1/, 1/ I, 12/, 1/ A
*
*         NAME   NAME MENTIONED ON DIRECTIVE LINE.
*         U      IF NOT SET, INDICATED  *UNYANK*.  SET FOR  *YANK*.
*         Y      SET FOR  *YANK*  OR  *UNYANK*.
*         I      SET IF IDENT NAME.
*         A      ALL AFTER FLAG.
*
*         SET TO  -*******-  ON INITIAL ENTRY.
 
 
 TNME     TABLE  10          TABLE OF NAMES
 TMOD     SPACE  4,20
**        TMOD - TABLE OF MODIFICATIONS.
*
*T TMOD   1/I,1/R,4/,18/AFC,18/NFC,18/NEXT
*T,TMOD+1 1/E,5/,18/ALC,18/NLC,18/EC
*T,TMOD+2 2/,16/IMN,18/NCI,24/AIT
*
*         I      SET IF INSERT. NOT SET IF DELETE.
*         R      SET IF RESTORE.
*         AFC    ADDRESS OF MODIFIER OF FIRST LINE FOR MODIFICATION.
*         NFC    NUMBER OF FIRST LINE FOR MODIFICATION.
*         NEXT   ADDRESS OF NEXT MODIFICATION.
*         E      SET IF ERROR.
*         ALC    ADDRESS OF MODIFIER OF LAST LINE FOR MODIFICATION.
*         NLC    NUMBER OF LAST LINE FOR MODIFICATION.
*         EC     ERROR CODE.
*         IMN    INDEX OF MODIFIER NAME FOR MODIFICATION.
*         NCI    NUMBER OF LINES TO INSERT.
*         AIT    ADDRESS OF INSERTION TEXT.
 
 
 TMOD     TABLE  30          TABLE OF MODIFICATIONS
 TDKI     SPACE  4,12
**        TDKI - TABLE OF DECK IDENTIFIERS.
*
*         WHEN PROCESSING DIRECTIVES -
*
*T TDKI   42/DECK NAME,18/
*
*         WHEN PROCESSING MODIFICATIONS -
*
*T TDKI   42/IDENTIFIER,1/Y,17/CARD NUMBER
*
*         Y      YANK FLAG.
 
 
 TDKI     TABLE  10          TABLE OF DECK IDENTIFIERS
 TNCD     SPACE  4,10
**        TNCD - TABLE OF NEXT LINES.
*
*         TABLE PARALLELS  *TDKI*.
*
*T TNCD   42/,18/NEXT
*
*         NEXT   NEXT LINE TO BE PROCESSED.
 
 
 TNCD     TABLE  10          TABLE OF NEXT LINES
 TEDT     SPACE  4,12
**        TEDT - TABLE OF DECKS TO BE EDITED.
*
*T TEDT   42/DECK NAME,18/AFM
*T TEDT+1 42/,18/ADK
*
*         AFM    ADDRESS OF FIRST MODIFICATION.
*         ADK    ADDRESS OF DECK IN  *TDKN*.
 
 
 TEDT     TABLE  10          TABLE OF DECKS TO BE EDITED
 TNDK     SPACE  4,10
**        TNDK - TABLE OF NEW DECKS.
*
*         SEE  *TDKN*  TABLE FORMAT.
 
 
 TNDK     TABLE  10          TABLE OF NEW DECKS
 TECD     SPACE  4,10
**        TECD - TABLE OF EDITED COMMON DECKS.
*
*         SEE  *TDKN*  TABLE FORMAT.
 
 
 TECD     TABLE  10          TABLE OF EDITED COMMON DECKS
 TDEF     SPACE  4,10
**        TDEF - TABLE OF DEFINED NAMES.
*
*T DEF    42/ DEFINED NAME, 1/ I, 1/ , 16/ VALUE
*
*         I      DEFINITION OF SYMBOL ENCOUNTERED ON INPUT. IF THIS
*                BIT IS SET COMPILE FILE DEFINITIONS OF THE SAME
*                SYMBOL WILL BE IGNORED.
 
 
 TDEF     TABLE  10          TABLE OF DEFINED NAMES
 TIGD     SPACE  4,10
**        TIGD - TABLE OF DECKS TO BE IGNORED.
*
*T TIGD   42/DECK NAME,18/
 
 
 TIGD     TABLE  10          TABLE OF DECKS TO BE IGNORED
 TMVE     SPACE  4,10
**        TMVE - TABLE OF MOVE AND PURGE DIRECTIVES.
*
*T TMVE   1/P,23/,18/DNR,18/DNP
*
*         P      PURGE BIT.
*         DNR    DECK NAME INDEX OF MOVE REFERENCE.
*         DNP    DECK NAME INDEX OF PURGE/MOVE.
 
 
 TMVE     TABLE  10          TABLE OF MOVE AND PURGE DIRECTIVES
 TNCC     SPACE  4,10
**        TNCC - TABLE OF NESTED COMMON DECK CALLS.
*
*T TNCC   42/DECK NAME,18/SKIP COUNT
 
 
 TNCC     TABLE  50          TABLE OF NESTED COMMON DECK CALLS
 TCCD     SPACE  4,10
**        TCCD - TABLE OF CALLED COMMON DECKS.
*
*T TCCD   42/DECK NAME,18/0
 
 
 TCCD     TABLE  200         TABLE OF CALLED COMMON DECKS
 TTXT     SPACE  4,10
**        TXTT - TABLE OF INSERTION TEXT.
*
*         VARIABLE LENGTH ENTRIES.
*
*         COMPRESSED LINE TEXT.
 
 
 TTXT     TABLE  IWMAX       TABLE OF INSERTION TEXT
 TCDK     SPACE  4,10
**        TCDK - TABLE OF COMMON DECKS.
*
*         SEE   *TXTT*  TABLE FORMAT.
 
 
 TCDK     TABLE  0           TABLE OF COMMON DECKS
          SPACE  4
*         MANAGED TABLES VALUES.
 
 
 FTABL    BSS    0
          LOC    *O
          CON    MTBS        LWA+1 OF ALL TABLES
 LTAB     BSS    0
 NTAB     EQU    LTAB+FTABL
          HERE
 OPTION   SPACE  4,10
**        OPTION - LIST OPTION TABLE.
 
 
          OPTION E           ERRORS
          OPTION C           OTHER INPUT DIRECTIVES
          OPTION T           INPUT TEXT
          OPTION M           MODIFICATIONS
          OPTION W           COMPILE FILE DIRECTIVES
          OPTION D           DECK STATUS
          OPTION S           STATISTICS
          OPTION I           INACTIVE LINES
          OPTION A           ACTIVE LINES
          TITLE  TEMPORARY STORAGE ASSIGNMENTS.
 COMMON   SPACE  4
**        COMMON DATA.
 
 
 T1       CON    0           TEMPORARY STORAGE
 T2       CON    0           TEMPORARY STORAGE
 FL       CON    0           FIELD LENGTH
 DL       CON    -0          LENGTH OF ORIGINAL DECK TABLE
 PC       CON    1R*         DIRECTIVE PREFIX CHARACTER
 PCC      CON    1R*         COMPILE PREFIX CHARACTER
 CH       CON    0           CHARACTER POINTER
 SC       CON    72          SEQUENCE NUMBER COLUMN - 1
          CON    0           CURRENT VALUE OF SC (RESET FOR EACH DECK)
 PL       CON    0LOPL       PROGRAM LIBRARY NAME
 NC       CON    0           LINES WRITTEN TO COMPILE THIS RECORD
          CON    0           TOTAL NUMBER OF LINES ON COMPILE FILE
 RI       CON    0           RANDOM INDEX RETURN
          CON    0
 IW       CON    72          DEFAULT INPUT LINE WIDTH
 DISCOL   CON    00B         DISPLAY CODE COLON CHARACTER
 DISPER   CON    63B         DISPLAY CODE PERCENT CHARACTER
 SFL      CON    0           STORE FL
 EFL      CON    0           *ECS* FIELD LENGTH
 CDC      CON    0           OPLC LINE COUNT - RESET FOR EACH DECK
 CDS      CON    0           OPLC SKIP COUNT - RESET FOR EACH DECK
          SPACE  4
**        MODIFICATION CONTROLS.
 
 
 EI       CON    0           EDIT TABLE INDEX
 MA       CON    0           MODIFICATION ADDRESS
          CON    0           DELETE MODIFICATION ADDRESS
          CON    0           INSERT MODIFICATION ADDRESS
 DN       CON    0           CURRENT DECK NAME
 DA       CON    0           CURRENT DECK ADDRESS
 EC       CON    0           DECK ERROR COUNTER
 CC       CON    0           INACTIVE LINE COUNTER
          CON    0           ACTIVE LINE COUNTER
          CON    0           INSERTED LINE COUNTER
          SPACE  4
**        LIST CONTROLS.
 
 
 BL       CON    0           BURSTABLE LISTING FLAG
 ERRM     CON    0           ADDRESS OF ERROR MESSAGE
 LO       CON    0           LIST OPTIONS
 LC       CON    99999       LINE COUNT
 LL       CON    0           LINE LIMIT
          ERRNZ  LL-LC-1     LOCATIONS MUST BE CONTIGUOUS
 PN       CON    1           PAGE NUMBER
 TL       CON    TLT         ADDRESS OF TITLE TEXT
 TO       CON    0           TERMINAL OUTPUT FORMAT FLAG
 TI       CON    1           TERMINAL INPUT  FORMAT FLAG
 FLAGS    SPACE  4,6
**        FLAGS.
 
 
 EF       CON    0           ERROR (TOTAL ERRORS DURING MODIFICATION)
 DE       CON    0           DIRECTIVE ERROR COUNT
 EA       CON    DE          DIRECTIVE ERROR COUNTER ADDRESS
 CD       CON    0           COMMON DECK
 LF       CON    0           SET IF DATA TRANSMITTED TO LIST FILE
 YK       CON    0           YANK IN DIRECTIVES
 YD       CON    0           YANK IN DECK
 UP       CON    0           *UPDATE* FLAG FOR INSERTION LINE NUMBERS
 COPL     CON    -1          CHARACTER SET OF OPL
 CNPL     CON    -1          CHARACTER SET OF NPL
 CVT      CON    0           CONVERSION OPTION
 MADCV    CON    0           MADIFY CONVERSION FLAG
 IG       CON    0           IGNORE DIRECTIVES PRESENT
 IFIP     CON    0           *IF IN PROGRESS FLAG
*                            .EQ. 0 IMPLIES NO IF IN PROGRESS
*                            .LT. 0 IMPLIES FALSE CONDITION PRESENT
*                            .GT. 0 IMPLIES TRUE CONTITION PRESENT
          SPACE  4,6
**        FLAGS SET BY COMMAND PARAMETERS.
 
 
 CL       CON    0           LINE LISTED
          CON    0           LINE TO BE LISTED FLAG
 DB       CON    0           DEBUG
 NR       CON    0           NO REWIND FOR PROGRAM LIBRARY
 NS       CON    0           NO SEQUENCE NUMBERS ON COMPILE FILE
          CON    0           CURRENT NO SEQUENCE FLAG (RESET EACH DECK)
 SS       CON    0           SEQUENCE NUMBERS ON SOURCE FILE
 AM       CON    0           *A* MODE
          CON    0           FIRST LINE OF RECORD FLAG
 FM       CON    0           *F* MODE
 QM       CON    0           *Q* MODE
 UM       CON    0           *U* MODE
 XM       CON    0           *X* MODE
 ZM       CON    0           *Z* MODE
 CMNF     CON    1           COMMENTS NEEDED FLAG
 CSR      CON    -0          CHARACTER SET REQUEST (*EC*)
 CSD      SPACE  4,10
*         CHARACTER SET DEFINITIONS.
 
 .DIS     EQU    0           DISPLAY CODE 63/64
 .AS612   EQU    1           ASCII 6/12 (63/64)
 
 TCST     SPACE  4,10
**        TABLE OF SYMBOLIC NAMES OF CHARACTER SETS.
*
*T TCST   42/ CS NAME,18/ CS ORDINAL
*
 
 TCST     BSS    0
          CON    0LDISPLAY+.DIS        DISPLAY
          CON    0LASCII+.AS612        ASCII (6/12)
          CON    0                     MAXIMUM CHARACTER SETS
 
*         CHARACTER SET CONTROLS.
 
 CSC      CON    .AS612      CURRENT CHARACTER SET
 SETC     CON    -1          NEG = USE CHARACTER SET OF DECK
*                            0   = USE DISPLAY SET (FOLD IF NECESSARY)
*                            1   = USE 6/12 ASCII SET
 
 MODIFY   TITLE  MODIFY - MAIN PROGRAM.
**        MODIFY - MAIN PROGRAM.
 
 
 MODIFY   SB1    1           (B1) = 1
          RJ     /PRESET/PRS PRESET PROGRAM
          RJ     /DIRECT/PDC PROCESS DIRECTIVE LINES
          RJ     /DIRECT/IMP INITIALIZE MODIFICATION PASS
          RJ     /DIRECT/PMP PROCESS  *MOVE*  AND  *PURDECK*
          SX6    EC          SET MODIFICATION ERROR COUNTER ADDRESS
          SA6    EA
          EQ     MOD6        BEGIN NEXT DECK
 
*         PROCESS MODIFICATIONS.
 
 MOD1     BX6    X6-X6       CLEAR LINE LIST
          SA5    MA+2        CHECK MODIFICATIONS
          SA6    CL
          SA6    CL+1
          SA6    CDAC        CLEAR LINE ACTIVITY
          ZR     X5,MOD2     IF NO MODIFICATIONS
          RJ     INS         PROCESS INSERT
          SA5    MA          CHECK MODIFICATIONS
          EQ     MOD3
 
 MOD2     SA0    P           READ LINE FROM PROGRAM LIBRARY
          RJ     RPF         READ PROGRAM FILE
          NZ     X1,MOD5     IF EOR
          SA5    MA+1        CHECK MODIFICATION ADDRESS
 MOD3     ZR     X5,MOD4     IF NO MODIFICATIONS
          RJ     DEL         PROCESS DELETE/RESTORE
 MOD4     RJ     SCS         SET LINE STATUS
          RJ     WRC         WRITE LINE
          SA1    CL+1
          ZR     X1,MOD1     IF NO LIST
          RJ     LCS         LIST LINE STATUS
          EQ     MOD1        LOOP
 
*         COMPLETE PROCESSING.
 
 MOD5     RJ     CDK         COMPLETE DECK
 MOD6     RJ     BDK         BEGIN NEXT DECK
          NZ     X7,MOD1     IF DECK TO BE PROCESSED
          SA0    N           WRITE DIRECTORY
          RJ     WDR         WRITE DIRECTORY
          RJ     LST         LIST STATISTICS
          RJ     CMF         COMPLETE FILES
          SA1    EF
          SA2    DB
          SA3    DE          DIRECTIVE ERROR COUNT
          SA0    =C* MODIFICATION/DIRECTIVE ERRORS.*
          NZ     X3,MOD8     IF DEBUG AND AT LEAST DIRECTIVE ERRORS
          ZR     X1,MOD7     IF NO MODIFICATION ERRORS
          SA0    =C* MODIFICATION ERRORS.*
          ZR     X2,ABT1     IF DEBUG NOT SET AND MODIFICATION ERRORS
          EQ     MOD8        ISSUE MESSAGE
 
 MOD7     SA0    =C* MODIFICATION COMPLETE.*
 MOD8     MESSAGE A0
          RJ     CAS         CALL ASSEMBLER
          ENDRUN
 BDK      SPACE  4,20
**        BDK - BEGIN DECK.
*
*         EXIT   (X7) .NE. 0, IF DECK READY FOR PROCESSING.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2.
*
*         CALLS  LDS, RMT, SFN, SNC.
 
 
 BDK      SUBR               ENTRY/EXIT
          SA1    EI          CHECK EDIT TABLE
          SA2    L.TEDT
          IX7    X2-X1
          SX6    X1+2        ADVANCE EDIT INDEX
          ZR     X7,BDKX     IF END OF TABLE - RETURN
          SA3    F.TEDT      LOOK UP EDIT TABLE ENTRY
          SB2    X1
          SA2    X3+B2
          SA6    A1
          MX4    -17         SET MODIFICATION ADDRESS
          BX7    -X4*X2
          MX0    42          MASK DECK NAME
          SA7    MA
          BX6    X0*X2
          SA1    A2+B1       SET DECK ADDRESS
          BX7    X1
          SA6    A2          CLEAR MODIFICATION POINTER
          SA6    DN          SET DECK NAME
          SA6    BDKA+1      ENTER DECK NAME IN MESSAGE
          SA7    DA
          BX1    X6
          RJ     SFN         ENTER DECK NAME IN SUBTITLE
          SA6    SBTL+2
          SA1    BL
          ZR     X1,BDK1     IF BURSTABLE LISTING NOT SPECIFIED
          SX7    99999       FORCE PAGE EJECT
          SA7    LC
 BDK1     BX7    X7-X7       CLEAR DECK IDENTIFIER TABLE LENGTH
          SA7    L.TDKI
          SA7    L.TCCD      CLEAR TABLE OF CALLED COMMON DECKS
          SA7    L.TNCC      CLEAR TABLE OF NESTED COMMON DECK CALLS
          SA7    CD          CLEAR COMMON DECK FLAG
          SA7    L.TNCD      CLEAR NEXT LINE TABLE
          SA7    IFIP        CLEAR *IF CONDITION FLAG
          RJ     RMT         READ MODIFIER TABLE
          MESSAGE BDKA,1     ISSUE CONSOLE MESSAGE
          SA1    S
          ZR     X1,BDK1.2   IF NO SOURCE
          RECALL A1
          WRITEW S,DN,1      WRITE DECK NAME
          SA1    CSC
          ZR     X1,BDK1.1   IF NOT AN ASCII DECK
          WRITEW X2,(=0LASCII),1
 BDK1.1   SA1    CD
          ZR     X1,BDK1.2   IF NOT COMMON DECK
          WRITEW X2,(=0LCOMMON),1
 BDK1.2   SA1    SC          RESET SEQUENCE COLUMN
          SA2    NS          RESET NO SEQUENCE FLAG
          BX6    X1
          LX7    X2
          SA6    A1+B1
          SA7    A2+B1
          SA3    BDKB
          ZR     X3,BDK2     IF NO PREVIOUS USE OF SCRATCH FILE
          RECALL M
          BX6    X6-X6       CLEAR NEW PROGRAM LIBRARY
          SA6    A3
          SA6    M
 BDK2     SA1    CD
          ZR     X1,BDK3     IF NOT COMMON DECK
          SA3    MA
          SA4    YD
          IX5    X3+X4
          ZR     X5,BDK3     IF NO MODIFICATIONS
          SA1    M+7         USE SCRATCH FILE FOR COMMON DECK
          BX6    X1
          SX7    B1          SET NEW PROGRAM LIBRARY FLAG
          SA6    M
          SA7    BDKB
 BDK3     SA1    N
          SA2    M
          BX1    X1+X2
          ZR     X1,BDK4     IF NO NEW PROGRAM LIBRARY
          RJ     WMT         WRITE MODIFIER TABLE
          SA2    M
          ZR     X2,BDK4     IF NO SCRATCH NPL
          SA1    F.TNDK
          SA2    L.TNDK
          IX3    X1+X2
          SA1    X3-1
          ADDWRD TECD,X1     ENTER DECK NAME
 BDK4     RJ     LDS         LIST DECK STATUS
          SA1    CD
          SA2    AM
          NZ     X1,BDK5     IF COMMON DECK
          ZR     X2,BDK5     IF NOT *A* MODE
          SA1    C
          ZR     X1,BDK5     IF NO COMPILE FILE
          SA2    A2+B1
          NZ     X2,BDK5     IF NOT FIRST DECK
          SX6    B1
          SA6    A2
          WRITEW C,CIDT,1    WRITE  *A*  MODE FLAG
 BDK5     BX6    X6-X6       CLEAR LINE COUNTS
          SA6    CC
          SA6    A6+B1
          SA6    A6+B1
          RJ     SNC         SET NEXT LINES
          SA1    MA          FORCE INITIAL MODIFICATION
          SX6    X1
          SX7    B1
          SA6    A1+B1
          EQ     BDKX        RETURN
 
 BDKA     CON    10H MODIFY /
          CON    0
 BDKB     CON    0           NEW PROGRAM LIBRARY FLAG FOR COMMON DECK
 CDK      SPACE  4,20
**        CDK - COMPLETE DECK.
*
*         ISSUE ERROR MESSAGE IF APPROPRIATE, COMPLETE DECK
*         ON NEW PROGRAM LIBRARY IF SELECTED AND RESET
*         MISCELLANEOUS FLAGS.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 7.
*
*         CALLS  ADW, CDD, LUM, WOF.
 
 
 CDK      SUBR               ENTRY/EXIT
          SA5    MA
          ZR     X5,CDK1     IF NO MODIFICATIONS
          RJ     LUM         LIST UNPROCESSED MODIFICATIONS
 CDK1     SA2    EF          PROPAGATE ERRORS
          SA1    EC
          BX7    X7-X7       CLEAR ERROR COUNT
          IX6    X2+X1
          SA7    A1
          SA6    A2
          SA7    CD          CLEAR COMMON DECK FLAG
          SX6    -B1
          SA6    SETC        CLEAR *CSET INDICATOR
          ZR     X1,CDK3     IF NO ERRORS
          SA2    SBTL+2
          SB7    X1
          BX6    X2
          SA2    =10H ERRORS IN
          NE     B7,B1,CDK2  IF MORE THAN 1
          SA2    =10H ERROR IN
          LX6    6           SHIFT NAME
 CDK2     BX7    X2
          LX6    -6
          SA7    CDKA+1
          SA6    A7+B1
          SX1    B7          CONVERT COUNT
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SA6    A7-B1
          MESSAGE A6,3
 CDK3     SA1    N
          ZR     X1,CDK4     IF NO NPL
          WRITER N,R
          SA1    RI          ENTER RANDOM INDEX
          SX2    N+7
          LX2    36
          ADDWRD TNDK,X2+X1
 CDK4     SA1    M
          ZR     X1,CDK5     IF NO SCRATCH NPL
          WRITER M,R
          SA1    RI+1
          SX2    M+7
          LX2    36
          ADDWRD TECD,X2+X1
 CDK5     WRITER S
          LISTOP D,CDKX      IF  *D*  OPTION OFF
          PRINT  (=C*  *)
          SA1    CC          INACTIVE LINE COUNT
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SA6    CDKC
          SA1    A1+1        ACTIVE LINE COUNT
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SA6    CDKB+1
          SA1    A1+1        INSERTED LINE COUNT
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SA6    CDKD
          PRINT  CDKB
          SA1    MA
          SA2    YD
          IX6    X1+X2
          ZR     X6,CDK      IF NO MODIFICATIONS - RETURN
          SX6    99999       FORCE PAGE EJECT
          SA6    LC
          EQ     CDKX        RETURN
 
 CDKA     DATA   10H
          DATA   10HERRORS IN
          DATA   10H
          DATA   0
 
 CDKB     DATA   10H
          DATA   10H
          DATA   20H ACTIVE LINE(S).
 
 CDKC     DATA   10H
          DATA   20H INACTIVE LINE(S).
 
 CDKD     DATA   10H
          DATA   20H INSERTED LINE(S).
          DATA   0
 INS      TITLE  MODIFICATION PROCESSORS.
 INS      SPACE  4,20
**        INS - PROCESS INSERTIONS.
*
*         ENTRY  (A5) = INSERT POINTER ADDRESS.
*                (X5) = INSERT ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 4.
*
*         CALLS  RTF.
 
 
 INS      SUBR               ENTRY/EXIT
          SA5    X5+
          SA5    X5+2        READ TEXT
          RJ     RTF         READ TEXT FILE
          LX5    -42         EXTRACT IDENTIFIER ADDRESS
          SA1    X5+B1       ADVANCE LINE COUNT
          SX2    B1
          IX7    X1+X2
          SA7    A1
          LX2    24          DECREMENT INSERTION COUNT
          IX6    X6-X2
          SA6    A5
          AX6    24          CHECK FOR END OF TEXT
          SB2    X6
          NZ     B2,INS1     IF NOT END OF TEXT
          SA2    MA+2        UNLINK INSERT
          BX6    X6-X6
          MX0    -18
          SA6    A2          CLEAR INSERT
          SA2    X2
          SA3    X2
          BX6    X0*X2
          BX0    -X0*X3
          IX6    X6+X0
          SB4    A2-MA-1
          SA6    A2
          NZ     B4,INS1     IF NOT FIRST INSERT
          SA6    A2-B1
 INS1     LX1    -24         SET IDENTIFIER INDEX
          SA2    F.TDKI
          SB2    X1
          SA3    X2+B2       MERGE DECK IDENTIFIER AND LINE NUMBER
          MX0    44
          SX6    X7
          BX1    X0*X3
          IX6    X1+X6
          SX7    B2+1S16     SET FIRST MHB RESTORED
          SA6    A3          SET LINE COUNTER
          SA7    TMHB
          SA6    CDID        SET LINE ID
          SX7    B1          SET MHB COUNT = 1
          SA7    A7-B1
          EQ     INSX        RETURN
 DEL      SPACE  4,15
**        DEL - PROCESS DELETIONS.
*
*         ENTRY  (A5) = MODIFICATION TABLE ADDRESS.
*                (X5) = ADDRESS OF MODIFICATION ADDRESS TABLE.
*
*         USES   ALL.
 
 
 DEL11    SX6    X5          SET INSERT ADDRESS
          BX7    X7-X7       CLEAR MODIFICATION INDICATOR
          SA6    MA+2
          NZ     X0,DELX     IF MODIFICATIONS REMAIN
          SA7    MA+1
 
 DEL      SUBR               ENTRY/EXIT
          SA1    L.TNCD
          SA2    F.TNCD
          SB3    B0
          SB4    X1
          SX7    1S16
 DEL0     SA7    X2+B3       SET HIGH LINE NUMBER
          SB3    B3+B1
          NE     B3,B4,DEL0  IF NOT COMPLETE
          SA1    F.TDKI      (B7) = TABLE DIFFERENCE
          IX6    X2-X1
          SB7    X6
          SB2    X5
          BX0    X0-X0
          MX5    0
          SA1    A5          SET POINTER ADDRESS
 DEL1     ZR     B2,DEL11    IF END OF MODIFICATION TABLE
          SA0    A1          SAVE POINTER ADDRESS
          SA1    B2          CHECK NEXT ENTRY
          SA2    B2+B1       (B4) = LAST LIMIT LINE COUNTER
          SB2    X1          SET NEXT INDEX
          MI     X2,DEL1     IF ERROR FLAG SET
          LX1    -18         (B3) = FIRST LIMIT LINE NUMBER
          SB3    X1
          LX1    -18         (B5) = CURRENT LINE NUMBER
          SA4    X1
          SA3    X1+B7       (B6) = MINIMUM LINE NUMBER
          SB5    X4
          SB6    X3
          LX2    -18
          GT     B3,B6,DEL2  IF LAST MODIFICATION LOWER
          SX6    B3
          SA6    A3
 DEL2     LT     B5,B3,DEL1  IF FIRST LIMIT NOT REACHED
 
*         PROCESS ACTIVE INSERT OR DELETE.
 
          LX1    36
          SB4    X2
          SX7    1S16
          BX4    X7*X4
          NZ     X4,DEL9     IF MOD TO YANKED IDENT
          PL     X1,DEL5     IF NOT INSERT
 DEL3     SA2    A1+2        CHECK TEXT STATUS
          AX2    24
          SB4    X2
          SX0    X0+B1
          ZR     B4,DEL4     IF NO TEXT
          SX5    A0          UPDATE MODIFICATON INDEX
          EQ     DEL1        LOOP
 
 DEL4     MX7    -18         UNLINK INSERT
          SA1    A1
          BX6    -X7*X1
          SA1    A0
          BX7    X7*X1
          IX6    X6+X7
          SB4    A0-MA-1
          SA6    A0
          NZ     B4,DEL1     IF NOT FIRST INSERT
          SA6    A0-B1
          EQ     DEL1        LOOP
 
*         PROCESS DELETE.
 
 DEL5     LX2    -18         (B6) = CURRENT LINE NUMBER
          SA3    X2
          SB6    X3
          SX0    X0+B1       COUNT DELETION
          GT     B6,B4,DEL8  IF CURRENT LINE BEYOND LAST LIMIT
          SA3    A2+B1       EXTRACT MODIFICATION SET INDEX
          LX3    -42
          SA4    X3+B1
          LX4    -24
          SX6    X4
          LX1    59-57
          SA4    NMHB        (X4) = INDEX OF LAST MHB
          PL     X1,DEL6     IF MODIFICATION IS DELETION
          SX6    X6+1S16     SET RESTORE BIT
 DEL6     SA6    X4+TMHB     STORE LAST MHB
          MX7    -16         CHECK PREVIOUS MHB
          SA3    A6-B1
          BX3    -X7*X3
          BX6    -X7*X6
          IX2    X6-X3
          ZR     X2,DEL8     IF SAME IDENTIFIER
          MI     X2,DEL7     IF PREVIOUS MODIFIER
          SX6    X4+1
          SA6    A4+
 DEL7     NE     B4,B6,DEL1  IF LAST LIMIT NOT REACHED
          SA2    A2          CONVERT TO INSERT AT LAST LIMIT
          MX1    1
          SX7    B2
          IX2    X2+X7
          BX7    X1+X2
          SA7    A2-B1
          EQ     DEL3        LOOP
 
*         NOTE- IF (X2) = 0, ERROR IS OVERLAP.
 
 DEL8     SX7    B1+B1       SET OVERLAP
          ZR     X2,DEL10    IF OVERLAP
          SX7    X7+B1       SET RANGE ERROR
          NE     B3,B4,DEL10 IF RANGE ERROR
          NE     B5,B6,DEL10 IF NOT SAME LINE
 DEL9     SX7    B0+         SET DIRECTIVE NOT REACHED
 DEL10    SA2    A2          ADD ERROR CODE TO WORD 2
          MX1    1
          BX7    X1+X7
          BX7    X7+X2
          SA7    A2
          EQ     DEL1        LOOP
 SCS      SPACE  4,20
**        SCS - SET LINE STATUS.
*
*         SET LINE ACTIVITY ACCORDING TO LAST MHB AND YANK
*         STATUS.  LIST MODIFICATION TO LINE.
*
*         ENTRY  (NMHB) = MHB COUNT.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 2, 3.
*
*         CALLS  ECD.
 
 
 SCS      SUBR               ENTRY/EXIT
          SA1    NMHB        (B2) = MHB COUNT
          SA2    F.TDKI      (B3) = FWA DECK IDENTIFIER TABLE
          MX0    -16         MHB INDEX MASK
          SB2    X1
          SB3    X2
          BX7    X7-X7       CLEAR STATUS
          SA2    A1+B1       FIRST MHB
          BX3    -X0*X2
          ZR     X3,SCS1     IF ORIGINAL LINE
          SA2    CC+2        ADVANCE INSERTED LINE COUNT
          SX6    X2+B1
          SA6    A2
 SCS1     SA1    A1+B1       NEXT MHB
          BX3    -X0*X1      SET MODIFIER INDEX
          SB2    B2-B1       COUNT MHB
          SA2    X3+B3
          LX2    59-16       CHECK YANK
          MI     X2,SCS2     IF MODIFIER YANKED
          BX7    X1          STATUS = MHB STATUS
 SCS2     NZ     B2,SCS1     IF NOT END OF MHB,S
          SA3    CDAC        COMPARE STATUS
          LX7    59-16
          BX6    X7-X3
          SA7    A3          SET NEW STATUS
          SX1    B1
          LX7    1
          BX2    X1*X7
          SA3    CC+X2       COUNT LINE
          SX7    X3+B1
          SA7    A3
          PL     X6,SCSX     IF UNCHANGED - RETURN
          LISTOP M,SCSX      IF NO LIST FOR MODIFICATION - RETURN
          RJ     ECD         EXPAND LINE
          SA3    CDAC        CHECK STATUS
          SX6    1RA
          SX7    1R
          MI     X3,SCS3     IF ACTIVE
          SX6    1R
          SX7    1RD
 SCS3     SA6    CHSP+5
          SA7    A6+1
          SA6    CL+1
          EQ     SCSX        RETURN
 SNC      SPACE  4,10
**        SNC - SET NEXT LINES.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6.
*                B - 2, 3, 4, 6, 7.
 
 
 SNC      SUBR               ENTRY/EXIT
          SA1    L.TNCD
          SA2    F.TNCD
          SB3    B0
          SB4    X1
          SX7    1S16
          SX2    X2+
          SB2    2
 SNC1     SA7    X2+B3       SET HIGH LINE NUMBER
          SB3    B3+B1
          NE     B3,B4,SNC1  IF END OF TABLE NOT REACHED
          SA1    MA
          SA4    F.TDKI      (B7) = TABLE DIFFERENCE
          SB2    X1+
          IX6    X2-X4
          SB7    X6
 SNC2     ZR     B2,SNCX     IF END OF MODIFICATION TABLE - RETURN
          SA0    A1          SAVE POINTER ADDRESS
          SA1    B2          CHECK NEXT ENTRY
          SA4    B2+B1
          SB2    X1          SET NEXT ENTRY
          LX1    -18         (B3) = FIRST LIMIT LINE NUMBER
          SB3    X1
          LX1    -18         (B6) = MINIMUM LINE NUMBER
          MI     X4,SNC2     IF ERROR FLAG SET
          SA3    X1+B7
          SB6    X3+
          GT     B3,B6,SNC3  IF LAST MODIFICATION LOWER
          SX6    B3+         UPDATE MINIMUM LINE NUMBER
          SA6    A3+
 SNC3     NZ     B3,SNC2     IF FIRST LIMIT NOT REACHED
 
*         PROCESS ACTIVE INSERT OR DELETE.
 
          LX1    36
          PL     X1,SNC2     IF NOT INSERT
          SA2    A1+2
          AX2    24
          SB4    X2
          ZR     B4,SNC4     IF NO TEXT
          SX6    A0+
          SA6    MA+2
          EQ     SNC2        LOOP
 
 SNC4     MX7    -18         UNLINK INSERT
          SA1    A1
          BX6    -X7*X1
          SA1    A0
          BX7    X7*X1
          IX6    X6+X7
          SA6    A0+
          EQ     SNC2        LOOP
          TITLE  WRITE COMPILE FILE PROCESSORS.
**        WRC - WRITE LINE.
*
*         WRITE LINE TO NEW PROGRAM LIBRARY, SOURCE, COMPILE, AND
*         LIST OUTPUT AS REQUIRED.
*         *WRC* WILL CALL *WCC* IF A COMPRESSED COMPILE FILE IS TO
*         BE WRITTEN.  FOR NON-COMPRESSED COMPILE FILE GENERATION
*         *WCF* WILL BE CALLED.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*
*         CALLS  WCC, WNF, WSC.
 
 
 WRC2     RJ     WSC         WRITE STANDARD COMPILE FILE
 
 WRC      SUBR               ENTRY/EXIT
          SA1    N
          SA2    M
          BX1    X1+X2
          ZR     X1,WRC1     IF NO NEW PROGRAM LIBRARY
          RJ     WNF         WRITE NEW PROGRAM LIBRARY
 WRC1     SA1    AM
          SA2    CD
          ZR     X1,WRC2     IF NOT *A* MODE
          NZ     X2,WRCX     IF COMMON DECK - RETURN
          RJ     WCC         WRITE COMPRESSED COMPILE FILE
          EQ     WRCX        RETURN
 WCC      SPACE  4,10
**        WCC - WRITE COMPRESSED COMPILE FILE.
*
*         ENTRY  (PCC) = PREFIX CHARACTER.
*                (CDTX) = FIRST WORD OF LINE TEXT.
*
*         EXIT   (X1) = 0, IF COMMENT LINE AND COMMENTS NOT NEEDED.
*                COMPRESSED LINE WRITTEN TO COMPILE FILE.
*                IF SUSPECTED COMPILE FILE DIRECTIVE ENCOUNTERED
*                *WSC* WILL BE CALLED TO PROCESS THE INTERESTING LINE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3.
*
*         CALLS  WSC, WTW=.
 
 
 
 WCC2     SA1    CMNF        CHECK FOR COMMENTS NEEDED
          ZR     X1,WCCX     IF NO COMMENTS NEEDED
 
*         WRITE LINE TO COMPILE FILE.
 
 WCC3     SA2    IFIP        *IF CONDITION FLAG
          MI     X2,WCC4     IF INACTIVE SEQUENCE IN PROGRESS
          SA2    CSC         GET CHARACTER SET OF COMDECK
          SA1    SETC        CHECK FOR *CSET
          NG     X1,WCC3.1   IF NO *CSET
          NZ     X1,WCC3.1   IF *CSET,ASCII
          ZR     X2,WCC3.1   IF DISPLAY COMMON DECK AND *CSET DISPLAY
          RJ     ECD         EXPAND AND CONVERT ASCII LINE
          RJ     RCL         RE-COMPRESS CONVERTED LINE
 WCC3.1   SA1    CDWC        WRITE IDENTIFICATION + COMPRESSED LINE
          WRITEW C,A1+B1,X1+B1
          SA1    NC          ADVANCE LINE COUNT
          SX2    B1
          IX6    X1+X2
          SA6    A1+
 WCC4     SX1    B1+         SET NOT COMMENT LINE FLAG
 
 WCC      SUBR               ENTRY/EXIT
          SA1    CDAC        CHECK LINE ACTIVITY
          SA2    C           CHECK FOR COMPILE FILE BEING WRITTEN
          PL     X1,WCCX     IF LINE NOT ACTIVE
          ZR     X2,WCCX     IF NO COMPILE FILE BEING WRITTEN
          SA1    CDTX        FIRST WORD OF COMPRESSED LINE
          SA4    WCCA        COMPILE FILE PREFIX CHARACTER
          BX3    X1-X4       COMPARE FIRST CHARACTER AGAINST PREFIX
          AX3    54
          NZ     X3,WCC3     IF NOT COMMENT LINE
          NG     X3,WCC3     IF NOT COMMENT LINE
          MX0    -12
 
*         CHECK FOR SUSPECTED COMPILE FILE DIRECTIVES.
 
          SA2    CD          CHECK FOR COMMON DECK
          ZR     X2,WCC1     IF NOT COMMON DECK
          SA4    WCCB        BEGIN SEARCH AFTER CALLS FOR COMMON DECKS
 WCC1     BX3    X4-X1       COMPARE DATA
          BX2    -X0*X4
          ZR     X4,WCC2     IF AT END OF DIRECTIVES AND COMMENT LINE
          SB2    X2+
          AX3    X3,B2
          SA4    A4+B1
          NZ     X3,WCC1     IF NO MATCH - LOOP FOR NEXT DIRECTIVE
          RJ     WSC         WRITE COMPILE FILE
          SX1    B1
          EQ     WCCX        RETURN
 
 WCCA     BSS    0                         DECK TABLE FWA
          VFD    6/0,42/0LCALL,12/5*6      *CALL
          VFD    6/0,42/0LCALLC,12/4*6     *CALLC
          VFD    6/0,42/0LCALLALL,12/2*6   *CALLALL
          VFD    6/0,42/0LIFCALL,12/3*6    *IFCALL
          VFD    6/0,42/0LNIFCALL,12/2*6   *NIFCALL
 
 WCCB     BSS    0                         COMMON DECK/DECK TABLE FWA
          VFD    6/0,42/0LCOMMENT,12/2*6   *COMMENT
          VFD    6/0,42/0LCSET,12/5*6      *CSET
          VFD    6/0,42/0LCWEOR,12/4*6     *CWEOR
          VFD    6/0,42/0LDEFINE,12/3*6    *DEFINE
          VFD    6/0,42/0LELSE,12/5*6      *ELSE
          VFD    6/0,42/0LENDIF,12/4*6     *ENDIF
          VFD    6/0,42/0LIF,12/7*6        *IF
          VFD    6/0,42/0LNOSEQ,12/4*6     *NOSEQ
          VFD    6/0,42/0LSEQ,12/6*6       *SEQ
          VFD    6/0,42/0LWEOF,12/5*6      *WEOF
          VFD    6/0,42/0LWEOR,12/5*6      *WEOR
          VFD    6/0,42/0LWIDTH,12/4*6     *WIDTH
 
          CON    0                         TABLE TERMINATOR
 WCF      SPACE  4,10
**        WCF - WRITE COMPILE FILE.
*
*         ENTRY  (CHAR) = FWA OF CHARACTER STRING BUFFER.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  LCS.
 
 
 WCFX     LISTOP W,WCF       IF NO LIST FOR DIRECTIVE
          RJ     LCS         LIST LINE STATUS
 
 WCF      PS     0           ENTRY/EXIT
 
*         PROCESS POSSIBLE *IF CONDITION ALTERATION.
 
          CARD   ELSE
          CARD   ENDIF
 
*         PROCESS ALL OTHER POSSIBLE COMPILE FILE DIRECTIVES.
 
 WCF1     SA1    IFIP        CHECK *IF CONDITION
          MI     X1,WCF      IF INACTIVE SEQUENCE IN PROGRESS
          CARD   COMMENT
          CARD   CWEOR
          CARD   DEFINE
          CARD   IF,IFX
          CARD   NOSEQ,NSQ
          CARD   SEQ
          CARD   WEOF
          CARD   WEOR
          CARD   WIDTH,WDH
 WCF2     SA2    NS+1
          SA1    AM
          NZ     X1,WCF5     IF *A* MODE
 
*         *WCF3* AND *WCF4* ENTERED FROM *COMMENT DIRECTIVE PROCESSOR.
 
 WCF3     SA1    SC+1
          NZ     X2,WCF4     IF NO SEQUENCE NUMBERS
          SX1    X1+14
 WCF4     WRITEK C,CHAR,X1   WRITE LINE TO COMPILE
          EQ     WCF6
 
*         WRITE COMPRESSED LINE.
 
 WCF5     WRITEW C,CDID,1    WRITE IDENTIFICATION
          WRITEC X2,CDTX     WRITE COMPRESSED LINE
 WCF6     SA1    NC          ADVANCE LINE COUNT
          SX2    B1
          IX6    X1+X2
          SA6    A1
          EQ     WCF         RETURN
 WSC      SPACE  4,10
**        WSC - WRITE STANDARD COMPILE FILE.
*
*         ENTRY  (C) = COMPILE FILE NAME.
*                (S) = SOURCE FILE NAME.
*                (CD) = COMMON DECK FLAG.
*                (CDAC) = LINE ACTIVITY FLAG.
*
*         EXIT   COMPILE FILE WRITTEN AS NEEDED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  CKC, ECD, WCF.
 
 
 WSC4     LISTOP I,WSCX      IF NO LIST FOR INACTIVE LINE - RETURN
          SX6    1RI
 WSC5     SA6    CHSP+4      SET ACTIVITY INDICATOR
          SA6    CL+1        SET LIST REQUESTED FLAG
 
 WSC      SUBR               ENTRY/EXIT
          RJ     ECD         EXPAND LINE
          SA1    CDAC
          SA2    S
          PL     X1,WSC3     IF LINE NOT ACTIVE
          ZR     X2,WSC2     IF NO SOURCE FILE
          SA1    SC+1        WRITE SOURCE
          SA2    SS
          ZR     X2,WSC1     IF NO SEQUENCE NUMBERS
          SX1    X1+14
 WSC1     WRITEK S,CHAR,X1
 WSC2     SA1    C           CHECK FOR COMPILE FILE BEING WRITTEN
          SA2    CD          COMMON DECK FLAG
          ZR     X1,WSC3     IF NO COMPILE FILE
          NZ     X2,WSC3     IF COMMON DECK
 
*         CHECK FOR COMMON DECK CALL DIRECTIVES.
 
          CARD   CALL        *CALL
          CARD   CALLC       *CALLC
          CARD   CALLALL     *CALLALL
          CARD   CSET
          CARD   IFCALL      *IFCALL
          CARD   NIFCALL     *NIFCALL
          RJ     WCF         WRITE COMPILE FILE
 WSC3     SA1    CDAC        CHECK LINE ACTIVITY
          PL     X1,WSC4     IF LINE INACTIVE
          SX6    1RA
          LISTOP A,WSC5,MI   IF LIST FOR ACTIVE LINE SELECTED
          EQ     WSCX        RETURN
          TITLE  COMPILE FILE DIRECTIVE PROCESSORS.
***       COMPILE FILE CONTROL DIRECTIVES.
*
*         THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE.
*         THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY
*         OR RESULT FROM INSERTION.
 CALL     SPACE  4,10
***       CALL   DNAME
*
*         PLACE A COPY OF DECK *DNAME* ON COMPILE FILE.
 
 
 CALL     SA1    IFIP        CHECK FOR INACTIVE SEQUENCE IN PROGRESS
          MI     X1,WRCX     IF INACTIVE SEQUENCE IN PROGRESS
          RECALL M
          RJ     ASN         ASSEMBLE NAME
          RJ     WCD         WRITE COMMON DECK
          EQ     WRCX        RETURN
 CALLC    SPACE  4,10
***       CALLC  DNAME
*
*         PLACE A COPY OF DECK *DNAME* ON COMPILE FILE, IF IT HAS NOT
*         ALREADY BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE
*         FILE DIRECTIVE.
 
 
 CALLC    SA1    IFIP        CHECK FOR INACTIVE SEQUENCE IN PROGRESS
          NG     X1,WRCX     IF INACTIVE SEQUENCE IN PROGRESS
          RECALL M
          RJ     ASN         ASSEMBLE NAME
          SEARCH TCCD,X6     SEARCH TABLE OF PREVIOUSLY CALLED DECKS
          NZ     X2,WRCX     IF FOUND - RETURN
          RJ     WCD         WRITE COMMON DECK
          EQ     WRCX        RETURN
 CALLALL  SPACE  4,10
***       CALLALL STRING
*
*         PLACE COPY OF EACH COMMON DECK WITH LEADING CHARACTERS =
*         STRING.
 
 
 CALLALL  SA1    CH          SAVE FIRST CHARACTER ADDRESS
          SA2    IFIP        CHECK INACTIVE SEQUENCE
          SX6    X1+B1
          MI     X2,WRCX     IF INACTIVE SEQUENCE IN PROGRESS
          SA6    CLAA
          RJ     ASN         ASSEMBLE NAME
          SA1    CH
          SA2    CLAA
          MX4    6           FORM NAME MASK
          IX5    X1-X2
          LX5    1
          SB3    X5
          LX5    1
          SB3    B3+X5
          AX7    X4,B3
          BX3    X6
          SA6    CLAA        STORE STRING
          SA7    A6+B1       STORE MASK
          LX4    X7
          SB2    B1+B1
          BX2    X2-X2
          SA1    L.TDKN
 CLA1     IX6    X1-X2
          ZR     X6,WRCX     IF END OF DECK NAMES - RETURN
          SB3    X2
          SA5    F.TDKN      CHECK NAME
          SX2    X2+B2       ADVANCE DECK NAME INDEX
          SA5    X5+B3
          BX6    X4*X5
          IX7    X6-X3
          NZ     X7,CLA1     IF NO MATCH
          SX6    X5-7
          NZ     X6,CLA1     IF NOT COMMON DECK
          LX5    59-16
          MI     X5,CLA1     IF DECK NOT ACTIVE
          LX5    17
          MX0    42          MASK NAME
          SX7    X2+         SAVE INDEX
          BX6    X0*X5
          SA7    CLAA+2
          RJ     WCD         WRITE COMMON DECK
          SA3    CLAA        RESTORE STRING
          SA4    A3+B1       RESTORE MASK
          SA2    A4+B1       RESTORE INDEX
          SB2    2
          SA1    L.TDKN
          EQ     CLA1        LOOP
 
 CLAA     CON    0
          CON    0
          CON    0
 COMMENT  SPACE  4,10
***       COMMENT CCC-CCC
*
*         PLACE COMMENT CCC-CCC IN COMPILE FILE IN FOLLOWING FORMAT -
* COMMENT CRDATE    MODDATE   CCC-CCC
*         1         2         3
* 2       1         1         1
*         WHERE  CRDATE = CREATION DATE
*                MODDATE = LAST MODIFICATION DATE
 
 
 COMMENT  SA1    SC+1        SET SEQUENCE NUMBER COLUMN
          SA2    CHAR+X1     PRESET (A6)
          BX6    X2
          SA3    CH          SET FIRST CHARACTER
          SA6    A2
          SB2    A2-B1       SET LAST COLUMN OF COMMENT
          SB3    X3          SET FIRST COLUMN OF COMMENT
          GE     B3,B2,CMT2  IF COMMENT EMPTY
          SB4    B2-CHAR-30  SET WORD COUNT FOR COMMENT
          MI     B4,CMT2     IF NO ROOM FOR COMMENT
          SA2    B3+B4       UNPACK COMMENT
 CMT1     BX6    X2
          SA6    A6-B1
          SB4    B4-B1
          SA2    A2-B1
          PL     B4,CMT1     IF NOT COMPLETE
 CMT2     SB3    CHAR        ENTER COMMENT PSEUDO
          SA1    =9L  COMMENT
          RJ     UPN         UNPACK NAME
          SA1    TIDT+2      ENTER CREATION DATE
          RJ     UPN         UNPACK NAME
          SA1    TIDT+3      CHECK MODIFICATION DATE
          NZ     X1,CMT3     IF DECK MODIFIED
          SA1    =1H
 CMT3     RJ     UPN         UNPACK NAME
          SX6    1R
          SA6    B3+
          SA1    AM
          NZ     X1,CMT4     IF *A* MODE
          SA2    NS+1
          EQ     WCF3
 
*         WRITE COMPRESSED LINE IDENTIFICATION.
 
 CMT4     WRITEW C,CDID,1    WRITE IDENTIFICATION
          SA1    SC+1
          EQ     WCF4
 CSET     SPACE  4,10
***       CSET   DNAME
*
*         DECLARE CHARACTER SET TO BE USED IN PROCESSING
*         CALLED COMMON DECKS.
 
 
 CSET     RJ     ASN         ASSEMBLE NAME OF *CSET*
          MX3    42
          SA1    TCST-1      FWA-1 OF CHARACTER SET TABLE
 CSET1    SA1    A1+B1
          ZR     X1,CSET2    IF UNKNOWN CHARACTER SET
          BX4    X3*X1
          BX7    X6-X4
          NZ     X7,CSET1    IF NO MATCH
          BX7    -X3*X1
          SA7    SETC        SET NEW CHARACTER SET
          EQ     WRCX        RETURN
 
 CSET2    SA0    =C/ CSET - UNKNOWN CHARACTER SET./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     WRCX        RETURN
 CWEOR    SPACE  4,10
***       CWEOR
*
*         WRITE END OF RECORD ON COMPILE FILE IF BUFFER IS NOT EMPTY.
 
 
 CWEOR    RECALL C
          SA1    NC          CHECK LINE COUNT
          ZR     X1,WRCX     IF NO LINES WRITTEN THIS RECORD - RETURN
          EQ     WEOR
 DEFINE   SPACE  4,10
***       DEFINE NAME,VALUE
*
*         SET THE VALUE OF *NAME* TO *VALUE*.  IF *VALUE* IS
*         NOT PRESENT A VALUE OF ZERO IS ASSUMED.
*
*         DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*,
*         *ENDIF* AND *IFCALL* DIRECTIVES.
*
*         WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN
*         PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE
*         FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*.
 
 
 DEFINE   RJ     ASN         ASSEMBLE NAME
          BX5    X6          SAVE NAME
          SX7    X7+B1       ADVANE BEYOND SEPARATOR
          SA7    A1+
          RJ     ASD         ASSEMBLE VALUE
          BX0    X7          SAVE VALUE
 
*         CHECK FOR VALUE IN RANGE.
 
          AX7    16
          ZR     X7,DEF1     IF VALUE WITHIN RANGE
          SA0    =C/ VALUE ERROR./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     WCF         RETURN
 
*         SEARCH FOR SYMBOL.
 
 DEF1     SEARCH TDEF,X5     SEARCH FOR PREVIOUSLY DEFINED SYMBOL
          NZ     X2,DEF2     IF PREVIOUSLY DEFINED
          ADDWRD A0,X5       ADD SYMBOL TO TABLE
          SA2    A6+         SET VALUE
 
*         ENTER SYMBOL VALUE INTO DEFINITION.
 
 DEF2     LX2    59-17
          MI     X2,WCFX     IF DEFINED ON INPUT
          LX2    17-59       REPOSITION SYMBOL
          MX1    42
          BX2    X1*X2       CLEAR PREVIOUS VALUE DEFINITION
          BX6    X2+X0       SYMBOL + VALUE
          SA6    A2          SET IN TABLE
          EQ     WCFX        RETURN
 ELSE     SPACE  4,10
***       ELSE
*
*         REVERSE MODIFICATION EFFECTS OF PREVIOUS *IF.
 
 
 ELSE     SA1    IFIP        CHECK FOR *IF IN PROGRESS
          ZR     X1,ELS1     IF NO *IF IN PROGRESS
          BX6    -X1         REVERSE PREVIOUS *IF CONDITION
          SA6    A1
          EQ     WCFX
 
 ELS1     SA0    =C/ NO *IF IN PROGRESS./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     WCF         RETURN
 ENDIF    SPACE  4,10
***       ENDIF
*
*         TERMINATE *IF RANGE.
 
 
 ENDIF    SA1    IFIP        CHECK FOR *IF IN PROGRESS
          ZR     X1,EIF1     IF NO *IF IN PROGRESS
          BX6    X6-X6       CLEAR *IF IN PROGRESS FLAG
          SA6    A1
          EQ     WCFX        RETURN
 
 EIF1     SA0    =C/ NO *IF IN PROGRESS./
          RJ     LCE         LIST COMPILE FILE ERROR MESSAGE
          EQ     WCF         RETURN
 IFX      SPACE  4,10
***       IF     ATR,NAME,VALUE
*
*         *ATR* MAY ASSUME ONE OF THE FOLLOWING VALUES.
*
*         DEF    SYMBOL REFERENCED BY ATTRIBUTE DEFINED.
*         UNDEF  SYMBOL REFERENCED BY ATTRIBUTE UNDEFINED.
*         EQ     SYMBOL REFERENCED BY ATTRIBUTE EQUAL TO *VALUE*.
*         NE     SYMBOL REFERENCED BY ATTRIBUTE NOT EQUAL TO *VALUE*.
*
*         IF THE CONDITION SPECIFIED BY THE ATTRIBUTE EXPRESSION
*         IS TRUE, AN ACTIVE *IF RANGE WILL BE INITIATED.
*
*         IF THE CONDITION IS FALSE THEN ALL LINES NORMALLY
*         WRITTEN TO THE COMPILE FILE AND COMPILE FILE DIRECTIVES
*         WILL BE TREATED AS INACTIVE FOR THE CURRENT MODIFICATION
*         RUN.
*
*         LINES WILL BE SKIPPED UNTIL THE OCCURENCE OF AN *ELSE OR
*         *ENDIF COMPILE FILE DIRECTIVE.
 
 
 IFX      RJ     ASN         ASSEMBLE ATTRIBUTE
          SX7    X7+B1       SKIP SEPARATOR
          SA6    IFXA        SAVE ATTRIBUTE
          SA7    A1
          RJ     ASN         ASSEMBLE SYMBOL NAME
          SX7    X7+B1
          SA6    A6+B1       SAVE SYMBOL NAME
          SA7    A1+
          RJ     ASD         ASSEMBLE SYMBOL VALUE
 
*         CHECK FOR VALUE SPECIFICATION IN RANGE.
 
          BX3    X7
          AX7    16
          SA0    =C/ VALUE ERROR./
          NZ     X7,IFX6     IF VALUE ERROR.
 
*         PROCESS SPECIFICATION.
 
          SA1    IFIP        CHECK *IF IN PROGRESS FLAG
          SA0    =C/ RECURSIVE *IF-S INCORRECT./
          NZ     X1,IFX6     IF *IF ALREADY IN PROGRESS
          SA2    IFXA        ATTRIBUTE
          SA4    A2+B1       SYMBOLIC NAME
          SA0    =C/ INCORRECT ATTRIBUTE./
          ZR     X2,IFX6     IF NO ATTRIBUTE
          MX0    36
          SA5    IFXB-1      FWA - 1 OF ATTRIBUTE TABLE
 
*         SEARCH FOR ATTRIBUTE.
 
 IFX1     SA5    A5+1        ADVANCE TO NEXT ENTRY
          BX7    X0*X5
          BX6    X7-X2       COMPARE SYMBOL
          ZR     X5,IFX6     IF AT END OF ATTRIBUTE TABLE
          NZ     X6,IFX1     IF NO MATCH
          SX2    X5          VALUE MASKING EXPRESSION
          LX5    59-18       ATTRIBUTE TEST TYPE FLAG
 
*         SEARCH FOR SYMBOL AND DETERMINE ACTION.
 
          SEARCH TDEF,X3+X4,X2
          MI     X5,IFX2     IF NEGATIVE ATTRIBUTE TEST
          EQ     IFX3        POSITIVE ATTRIBUTE TEST
 
*         PROCESS NEGATIVE ATTRIBUTE EXPRESSIONS.
 
 IFX2     ZR     X2,IFX4     IF *IF EXPRESSION TRUE
          EQ     IFX5        *IF EXPRESSION FALSE
 
*         PROCESS POSITIVE ATTRIBUTE EXPRESSIONS.
 
 IFX3     ZR     X2,IFX5     IF *IF EXPRESSION FLASE
          EQ     IFX4        *IF EXPRESSION TRUE
 
*         EXPRESSION TRUE.
 
 IFX4     SX6    B1          SET TRUE *IF EXPRESSION TEST FALG
          SA6    A1
          EQ     WCFX        RETURN
 
*         EXPRESSION FLASE.
 
 IFX5     SX6    -B1         SET FALSE *IF EXPRESSION TEST
          SA6    A1
          EQ     WCFX        RETURN
 
 IFX6     RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR MESSAGE
          EQ     WCF         RETURN
 
 IFXA     CON    0           ATTRIBUTE TEMPORARY
          CON    0           SYMBOL TEMPORARY
 
 IFXB     BSS    0           TABLE OF ATTRIBUTES
 
          VFD    36/0LDEF,6/0,18/0               DEFINED TEST
          VFD    36/0LUNDEF,6/1,18/0             UNDEFINED TEST
          VFD    36/0LEQ,6/0,18/377777B          EQUAL TEST
          VFD    36/0LNE,6/1,18/377777B          NOT EQUAL TEST
 
          CON    0
 IFCALL   SPACE  4,10
***       IFCALL NAME,DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
*         *NAME* IS DEFINED.
 
 
 IFCALL   RJ     ASN         ASSEMBLE NAME
          SEARCH TDEF,X6     SEARCH FOR NAME
          ZR     X2,WRCX     IF NOT FOUND - RETURN
          SX7    X7+B1       SKIP SEPARATOR
          SA7    CH
          EQ     CALL        PROCESS AS *CALL
 NIFCALL  SPACE  4,10
***       NIFCALL NAME,DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
*         *NAME* IS NOT DEFINED.
 
 
 NIFCALL  RJ     ASN         ASSEMBLE NAME
          SEARCH TDEF,X6     SEARCH FOR NAME
          NZ     X2,WRCX     IF FOUND - RETURN
          SX7    X7+B1       SKIP SEPARATOR
          SA7    CH
          EQ     CALL        PROCESS AS *CALL
 NOSEQ    SPACE  4,10
***       NOSEQ
*
*         REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE.
 
 
 NSQ      SX6    B1+         SET NO SEQUENCE NUMBER FLAG
          SA6    NS+1
          EQ     WCFX        LIST LINE
 SEQ      SPACE  4,8
***       SEQ
*
*         REQUEST SEQUENCE NUMBERS ON COMPILE FILE.
 
 
 SEQ      SX6    B0+         CLEAR NO SEQUENCE NUMBER FLAG
          SA6    NS+1
          EQ     WCFX        LIST LINE
 WIDTH    SPACE  4,10
***       WIDTH  N
*
*         SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*.
 
 
 WDH      RJ     ASD         ASSEMBLE COLUMN NUMBER
          SB2    X7-IWMACS-1
          MI     B2,WDH1     IF IN RANGE
          SA0    =C/ COLUMN NUMBER OUT OF RANGE./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR MESSAGE
          EQ     WCF         RETURN
 
*         PROCESS WIDTH DIRECTIVE.
 
 WDH1     SA1    SC+1        READ CURRENT SEQUENCE NUMBER COLUMN
          SB2    X1+CHAR
          SB3    X7+CHAR
          EQ     B2,B3,WCFX  IF NEW WIDTH = CURRENT WIDTH - LIST LINE
          SA7    A1          UPDATE WIDTH
          SB5    B0
          SB4    16
          GT     B2,B3,WDH4  IF DECREASE IN WIDTH
 
*         PROCESS INCREASE IN WIDTH.
 
 WDH2     SA1    B2+B4       MOVE SEQUENCE FIELD UP
          BX6    X1
          SA6    B3+B4
          SB4    B4-B1
          PL     B4,WDH2     IF MOVE NOT COMPLETE
          SX6    1R
 WDH3     SA6    A6-B1       BLANK FILL LINE
          SB3    B3-B1
          NE     B2,B3,WDH3  IF NOT AT END OF LINE
          EQ     WCFX        LIST LINE
 
*         PROCESS DECREASE IN WIDTH.
 
 WDH4     SA1    B2+B5       MOVE SEQUENCE FIELD DOWN
          BX6    X1
          SA6    B3+B5
          SB5    B5+B1
          NE     B4,B5,WDH4  IF MOVE NOT COMPLETE
          SX6    1R          BLANK FILL REMAINDER OF BUFFER
 WDH5     SA6    B3+B5
          SB3    B3+B1
          NE     B2,B3,WDH5  IF NOT COMPLETE
          EQ     WCFX        LIST LINE
 WEOF     SPACE  4,10
***       WEOF
*
*         WRITE END OF FILE ON *COMPILE* FILE.
 
 
 WEOF     WRITEF C,R
 WEF1     SA1    NC          PROPAGATE TOTAL LINE COUNT
          SA2    A1+B1
          BX6    X6-X6       CLEAR LINE COUNT THIS RECORD
          IX7    X1+X2
          SA6    A1
          SA7    A2+
          SA1    AM
          ZR     X1,WCFX     IF NOT *A* MODE
          WRITEW C,CIDT,1    WRITE COMPILE FILE  *A*  MODE FLAG
          EQ     WCFX        LIST LINE
 WEOR     SPACE  4,10
***       WEOR N
*
*         WRITE END OF RECORD (LEVEL N) ON COMPILE FILE.
*                IF N = 15 THIS IS THE SAME AS A WEOF DIRECTIVE.
*                ANY OTHER VALUE WRITES AN END OF RECORD.
 
 
 WEOR     RJ     ASD         ASSEMBLE LEVEL NUMBER
          SB2    X7-17B
          ZR     B2,WEOF     IF EOR LEVEL 17 PROCESS AS *WEOF*
          WRITER C,R
          EQ     WEF1
 WCD      TITLE  COMMON DECK PROCESSOR.
 WCD      SPACE  4,20
**        WCD - WRITE COMMON DECK.
*
*         DECK WRITTEN FROM EITHER MEMORY, NEW PROGRAM LIBRARY,
*         OR PROGRAM LIBRARY.
*
*         ENTRY  (X6) = DECK NAME, ELSE ZERO IF DECK NAME NOT CORRECT.
*
*         USES   ALL.
*
*         CALLS  DNL, ECD, INL, LCE, LCS, PCS, PCW, RPF, WCC, WCF.
 
 
 WCD14    LISTOP E,WCD15     IF NO ERROR LIST
          BX7    X7-X7
          SA7    CL          CLEAR LINE LISTED STATUS
          SA0    =C/ UNKNOWN DECK./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
 WCD15    RJ     DNL         DECREMENT COMMON DECK NESTING LEVEL
          NZ     X6,WCD0.1   IF STACK NOT EMPTY
          SA6    CD
          SA6    WCDE        CLEAR NESTING COMMON DECK NAME
          SA1    WCDF
          BX7    X1
          SA7    CSC         RESTORE CHARACTER SET OF CALLING DECK
 
 WCD      SUBR               ENTRY/EXIT
          SA1    CSC         GET CHARACTER SET OF CALLING DECK
          BX7    X1
          SA7    WCDF        SAVE IT
          NZ     X6,WCD0     IF NAME IS OK
          BX7    X7-X7
          SA7    CL          CLEAR LINE LISTED STATUS
          SA0    =C/ UNKNOWN DECK./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     WCDX        RETURN AFTER ERROR
 
 WCD0     RJ     INL         INCREMENT COMMON DECK NESTING LEVEL
 WCD0.1   SA1    L.TCDK
          ZR     X1,WCD4     IF NO DECKS IN MEMORY
 
*         CHECK DECKS IN MEMORY.
 
          SA2    F.TCDK
          MX0    42
          SB3    X1
          SB2    B0+
 WCD1     EQ     B2,B3,WCD4  IF END OF DECKS
          SA3    X2+B2       CHECK NAME
          BX7    X0*X3
          SB2    X3+B2
          IX4    X7-X6
          NZ     X4,WCD1     IF NO MATCH
          SX6    X3          EXTRACT LENGTH OF TCDK COMMON DECK
          SA3    A3+B1       SET CHARACTER SET OF COMMON DECK
          BX7    X3
          SA7    CSC
          SX7    A3+1        SET START
          SA6    WCDC        SAVE DECK LENGTH
          SA7    WCDD        SAVE DECK START POSITION
          LISTOP W,WCD1.1    IF NO LIST SET FOR DIRECTIVE
          RJ     LCS         LIST LINE STATUS
 
*         COPY DECK FROM MEMORY.
 
 WCD1.1   SX6    B1+         SET COMMON DECK FLAG
          SA6    CD
 WCD2     SA1    WCDC        RESET LENGTH OF DECK
          SA4    A1+B1
          ERRNZ  WCDD-WCDC-1 CODE ASSUMES VALUE
          SB2    X1
          ZR     B2,WCD15    IF END OF COPY - RETURN
          SA1    X4          STORE IDENTIFICATION
          SA2    A1+B1       START MOVE
          BX6    X1
          SA6    CDID
          MX0    48
 WCD3     LX6    X2
          SA6    A6+B1
          BX3    -X0*X2
          SA2    A2+B1
          SB2    B2-B1
          NZ     X3,WCD3     IF NOT AT END OF LINE
          SX7    A2          UPDATE START OF NEXT LINE
          SX6    A6-CDID     WORD COUNT OF COMPRESSED LINE
          SA6    CDWC        SET WORD COUNT OF COMPRESSED LINE
          SX6    B2-1        SET WORD COUNT
          SA7    WCDD
          SA6    A7-1
          RJ     PCW         WRITE COMPILE FILE
          ZR     X6,WCD2     IF SAME NESTING LEVEL
          EQ     WCD0        ENTER NEXT NESTING LEVEL
 
*         SEARCH DECK NAME TABLES.
 
 WCD4     BX0    X6          SAVE DECK NAME
          RECALL M
          SX3    7           SEARCH FOR DECK IN NEW DECKS
          SEARCH TECD,X0+X3,377777B
          NZ     X2,WCD5     IF FOUND
          SX3    7           SEARCH FOR DECK IN OLD DECKS
          SEARCH TDKN,X0+X3,377777B
          ZR     X2,WCD14    IF COMMON DECK NOT FOUND
 
*         INITIALIZE COMMON DECK READ FROM PROGRAM LIBRARY.
 
 WCD5     SA2    A2+1
          BX6    X2
          AX2    36          SET FILE NAME
          SA1    X2
          BX7    X1
          SA6    M+6
          SA7    M
          SA2    A7+B1       GET *FIRST*
          SX6    X2
          SA6    A2+B1
          SA6    A6+B1       SET BUFFER EMPTY
          SA2    CL+1
          NZ     X2,WCD6     IF LINE SHOULD BE LISTED
          LISTOP W,WCD7      IF NO LIST FOR DIRECTIVE
 WCD6     RJ     LCS         LIST LINE STATUS
 WCD7     RECALL P
          READ   M           BEGIN READ
          READW  M,BUF,TIDTL READ IDENT TABLE
          SX6    B1+
          SA6    CD          INDICATE COMMON DECK
          SB5    BUF         FWA OF IDENT TABLE
          RJ     PCS         PROCESS OPL CHARACTER SET
          READW  M,T1,1      READ MODIFIER TABLE WORD
          SA5    L.TDKI      SAVE CURENT IDENTIFIER TABLE LENGTH
          SA1    T1          AUGMENT IDENTIFIER TABLE
 +        ZR     X1,*
          ALLOC  TDKI,X1+B1
          BX6    X2          SAVE CURRENT FWA
          LX7    X5
          SA6    WCDB
          SA7    A6+B1
          IX6    X2+X5       SET TEMPORARY FWA
          SA4    BUF+1       SET DECK NAME
          SA1    T1
          SX2    B1
          BX7    X4+X2
          SX1    X1
          SA6    F.TDKI
          SA7    X6
          SX7    X7+1        ADD WORD FOR CHARACTER SET INDICATOR
          SA7    WCDD        SET POINTER WORD
          ZR     X1,WCD8     IF NO MODIFIERS
          READW  M,X6+B1,X1  READ MODIFIERS
 WCD8     SA3    L.TCDK      SET COMMON DECK LENGTH
          BX6    X3
          SA6    WCDC
          ALLOC  TCDK,2      ALLOCATE FOR POINTER AND CHARACTER SET
          ZR     X3,WCD11.1  IF NO ROOM
          SA1    CSC         SET CHARACTER SET INDICATOR IN TCDK
          SA3    L.TCDK
          BX7    X1
          SA2    F.TCDK
          SB2    X3-1
          SA7    X2+B2
 
*         COPY COMMON DECK TO COMPILE FILE.
 
 WCD9     SA0    M           FET ADDRESS
          RJ     RPF         READ PROGRAM FILE
          NZ     X1,WCD13    IF EOR
          SA1    CDAC
          PL     X1,WCD9     IF LINE INACTIVE
          RJ     PCW         WRITE COMPILE FILE
          SA6    WCDE        SAVE NAME OF COMMON DECK
          NZ     X6,WCD12    IF NEXT NESTING LEVEL
          ZR     X1,WCD9     IF COMMENT OR NOT SAVING IN MEMORY
 
*         SAVE COMMON DECK IN MEMORY IF POSSIBLE.
 
          SA1    WCDD
          SA5    CDWC
          ZR     X1,WCD9     IF NO ROOM FOR COMMON DECK
          ALLOC  TCDK,X5+B1  ALLOCATE FOR TEXT
          ZR     X3,WCD12    IF NO ROOM
          IX7    X3-X5       SET FWA
          SB2    X5+B1
          SB3    X7-1
          SA1    CDID
 WCD11    BX6    X1
          SA6    X2+B3       X2 = FWA OF TABLE
          SB2    B2-B1
          SA1    A1+B1
          SB3    B3+B1
          NZ     B2,WCD11    IF MORE TEXT REMAINS
          SX5    X5+B1       ADVANCE LENGTH
          SA1    WCDD
          IX6    X1+X5
          SA6    A1
          EQ     WCD9        READ NEXT LINE
 
 WCD11.1  MX6    0
          SA6    WCDE        CLEAR COMMON DECK NAME
 WCD12    SA1    WCDC        RESET OLD LENGTH
          SX6    X1
          BX7    X7-X7       CLEAR POINTER WORD
          SA6    L.TCDK
          SA7    WCDD
          SA2    F.TCDK      RESET END OF TABLE
          IX6    X2+X1
          SA6    A2+B1
          SA1    WCDE
          ZR     X1,WCD9     IF SAME NESTING LEVEL, READ NEXT LINE
 
*         RESET ALL CONDITIONS.
 
 WCD13    RECALL P
          SA2    WCDB        RESET DECK IDENTIFIER FWA
          BX6    X6-X6       CLEAR SCRATCH FILE
          SA3    A2+B1       RESET LENGTH
          SA6    M
          SA4    P+6         RESET FILE
          BX6    X2
          LX7    X3
          SA6    F.TDKI
          SA7    L.TDKI
          MX1    30          RESET FILE POSITION
          BX2    X1*X4
          SA3    WCDD        GET POINTER WORD
          AX4    30
          IX6    X2+X4
          SA1    A3-B1       LAST LENGTH
          SA6    A4
          SA2    L.TCDK
          ZR     X2,WCD13.1  IF *TCDK* EMPTY
          SA2    F.TCDK
          BX6    X3
          SB2    X1+
          SA6    X2+B2
 WCD13.1  SA3    WCDE
          ZR     X3,WCD15    IF NESTING STACK IS EMPTY, RETURN
          BX6    X3
          EQ     WCD0        ENTER NEXT NESTING LEVEL
 
 WCDB     CON    0           FWA OF DECK IDENTIFIER TABLE
          CON    0           LENGTH OF DECK IDENTIFIER TABLE
 WCDC     CON    0           LAST COMMON DECK LENGTH
 WCDD     CON    0           NEW POINTER WORD
 WCDE     CON    0           COMMON DECK NAME OF NEXT NESTING LEVEL
 WCDF     CON    0           SAVE CHARACTER SET OF CALLING DECK
 ABT      TITLE  SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT MODIFY.
*
*         ENTRY  (X0) = ADDRESS OF ERROR MESSAGE.
*
*         CALLS  CMF.
 
 
 ABT      RJ     CMF         COMPLETE FILES
 ABT1     MESSAGE A0         SEND ERROR MESSAGE
          ABORT
 ADW      SPACE  4,20
**        ADW - ADD ENTRY TO A TABLE.
*
*         ENTRY  (A0) = TABLE POINTER ADDRESS.
*                (X1) = TABLE ENTRY TO ADD.
*
*         EXIT   (X6) = TABLE ENTRY.
*                (A6) = ADDRESS OF TABLE ENTRY.
*                (X3) = INDEX OF TABLE ENTRY.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  ATS.
 
 
 ADW1     BX6    X1          ENTER WORD
          SX7    X3+B1       ADVANCE LENGTH
          SA6    X2+B2
          SA7    A3
 
 ADW      SUBR               ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE ROOM
          SA3    LTAB+A0
          SA4    A2+B1
          IX6    X2+X3
          SB2    X3
          IX7    X4-X6
          NZ     X7,ADW1     IF ROOM FOR WORD
          SA2    NTAB+A0     ALLOCATE TABLE
          BX6    X1          SAVE WORD
          SA6    ADWA
          ALLOC  A0,X2
          SA4    NTAB+A0     RESET LAST LENGTH
          SA1    ADWA        RESTORE WORD
          IX3    X3-X4
          SB2    X3
          EQ     ADW1        ENTER WORD
 
 ADWA     CON    0           TEMPORARY STORAGE
 AMD      SPACE  4,15
**        AMD - ASSEMBLE MODIFIER.
*
*         ADD AND LINK MODIFIERS INTO MODIFIER TABLE.
*
*         ENTRY  (B6) = ADDRESS OF LINKED LIST OF MODIFIERS.
*
*         USES   X - ALL.
*                A - 1, 2, 4, 5, 6, 7.
*                B - 2, 3, 6, 7.
*
*         CALLS  LER, UPN.
*
*         MACROS ADDWRD, PRINT, SEARCH.
 
 
*         PROCESS DUPLICATED MODIFIER NAME.
 
 AMD6     SB3    CHAR        ENTER NAME IN ERROR MESSAGE
          BX1    X6
          SX7    B6          SAVE ADDRESS OF LINKED LIST
          SX6    B1          SET ERROR FLAG
          SA7    AMDA
          SA6    A7+B1
          RJ     UPN         UNPACK NAME
          PRINT  -CHSP,B3+X1
          SX0    =C*DUPLICATE MODIFIER NAME.*
          RJ     LER         LIST ERROR
          SA2    AMDA        RESTORE ADDRESS OF LINKED LIST
          SB6    X2+
          NZ     B6,AMD0     IF NOT AT THE END OF THE CHAIN
 AMD7     SX6    B0+         CLEAR MODIFICATIONS
          SA6    MA
 
 AMD      SUBR               ENTRY/EXIT
          SX7    B0+         CLEAR ERROR FLAG
          SA7    AMDB
 AMD0     SA2    L.TDKI      SET CURRENT LENGTH
          SB7    X2
          MX0    42
 AMD1     SA1    B6          NEXT MODIFICATION LINK
          SA5    A1+2        EXTRACT MODIFICATION IDENTIFIER ADDRESS
          SB6    X1
          LX5    18
          SA4    X5          SEARCH FOR IDENTIFIER IN DECK TABLE
          SEARCH TDKI,X4
          NZ     X2,AMD2     IF FOUND
          ADDWRD TDKI,X1*X4  ADD NEW MODIFIER
          SA1    X5+B1       ENTER MODIFIER INDEX
          SX6    X3
          SA2    UP          CHECK UPDATE MODE
          LX6    24
          SA6    A1
          ZR     X2,AMD2     IF NOT *UPDATE* MODE
          BX1    -X0*X1      PROPAGATE LINE COUNT
          IX6    X6+X1
          SA6    A1+
 AMD2     SB2    X3+         CHECK MODIFIER INDEX
          LT     B2,B7,AMD6  IF OLD MODIFIER
          NZ     B6,AMD1     IF NOT AT END OF CHAIN
          SA1    AMDB
          NZ     X1,AMD7     IF ERRORS OCCURRED
          SA1    MA          SET MODIFICATION ADDRESS
          SB6    X1+
          ZR     X1,AMDX     IF NO MODIFIERS - RETURN
 
*         CONVERT LINE IDENTIFIERS.
 
 AMD3     SA5    B6          LOOK UP FIRST LIMIT
          SB6    X5
          LX5    24
          SA2    X5
          SEARCH A0,X2
          ZR     X2,AMD5     IF NOT FOUND
          BX2    X1*X5       ADD MODIFIER ADDRESS
          SA4    A5+B1       LOOK UP SECOND LIMIT
          SX3    A2
          IX6    X2+X3
          LX6    36
          SA6    A5
          ZR     X4,AMD4     IF NOT DEFINED
          LX4    24
          SA2    X4
          SEARCH A0,X2
          ZR     X2,AMD5     IF NOT FOUND
          BX2    X1*X4       ADD MODIFIER ADDRESS
          SX3    A2
          IX6    X2+X3
          LX6    36
          SA6    A4+
 AMD4     NZ     B6,AMD3     IF NOT AT END OF MODIFICATION CHAIN
          EQ     AMDX        RETURN
 
*         PROCESS UNKNOWN IDENTIFIER NAME.
 
 AMD5     SA1    A5+B1       SET UNKNOWN MODIFIER FLAG
          MX3    2
          SA2    A1+B1       CLEAR TEXT
          LX3    1
          MX0    42
          BX6    X3+X1
          LX0    24
          SA6    A1
          BX7    X0*X2
          SA7    A2
          EQ     AMD4
 
 AMDA     CON    0           ADDRESS OF LINKED LIST
 AMDB     CON    0           DUPLICATE MODIFIER ERROR FLAG
 ASD      SPACE  4,20
**        ASD - ASSEMBLE DIGITS.
*
*         ENTRY  (CH) = CHARACTER POINTER.
*
*         EXIT   (X7) = ASSEMBLED DIGITS.
*                (B2) = 0, IF NUMERIC FIELD NULL.
*                (B2) .NE. 0, IF NUMERIC FIELD NOT NULL.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 6.
*                B - 2.
 
 
 ASD3     SX6    =C*INCORRECT NUMERIC FIELD.*
          SA6    ERRM
          SX7    B0+
 
 ASD      SUBR               ENTRY/EXIT
          SA1    CH          GET NEXT CHARACTER
          BX7    X7-X7       CLEAR ASSEMBLY
          SA2    X1
          SB2    B0+
          SX3    X2-1R+
          ZR     X2,ASD3     IF TERMINATOR
          PL     X3,ASD3     IF SEPARATOR
 ASD1     SX2    X2-1R0
          MI     X2,ASD3     IF ALPHA
          LX3    X7,B1       LAST DIGIT * 10
          LX7    3
          IX3    X3+X7
          SX1    X1+B1       SET NEXT CHARACTER
          IX7    X3+X2       ADD NEW DIGIT
          SA2    X1
          SB2    X2-1R+
          ZR     X2,ASD2     IF SEPARATOR
          MI     B2,ASD1     IF NOT SEPARATOR
 ASD2     SX6    X1          UPDATE CHARACTER POINTER
          SA6    A1
          EQ     ASDX        RETURN
 ASN      SPACE  4,20
**        ASN - ASSEMBLE NAME.
*
*         ASSEMBLE UP TO 7 CHARACTER NAME TO A SEPARATOR.
*
*         ENTRY  (CHAR) = FIRST CHARACTER IN STRING.
*                (CH) = CHARACTER STRING CURRENT INDEX.
*
*         EXIT   (X6) = NAME, LEFT JUSTIFIED ZERO FILL.
*                (X6) = 0, IF SEPARATOR OR .GT. 7 CHARACTERS ASSEMBLED.
*                (A1) = CH.
*                (X7) = UPDATED CHARACTER POINTER.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 7.
*                B - 2.
 
 
 ASN2     MX1    6
          SX7    A2
 ASN3     LX6    6
          BX2    X1*X6
          ZR     X2,ASN3     IF NOT YET LEFT JUSTIFIED
          SA7    A1+         UPDATE CHARACTER POINTER
          MX1    -18
          BX2    -X1*X6
          ZR     X2,ASNX     IF .GT. 7 CHARACTERS
          SX6    B0+         CLEAR ASSEMBLY
          SA2    X1+
 
 ASN      SUBR               ENTRY/EXIT
          SA1    CH          CHECK FIRST CHARACTER
          SA2    X1
          BX6    X6-X6       CLEAR ASSEMBLY
          MX1    -6
          BX2    -X1*X2      MASK OFF POSSIBLE ESCAPE CODE
          SB2    X2-1R
          ZR     X2,ASNX     IF SEPARATOR, RETURN
          NG     B2,ASN1     IF NOT SEPARATOR
 
*         CHECK POSSIBLE 6/12 ESCAPE CODE.
 
          SB2    X2-76B
          NZ     B2,ASNX     IF SEPARATOR
          SA2    A2+B1
          BX2    -X1*X2
          SB2    X2-1RZ-1    END OF LOWER CASE LETTERS (Z)
          ZR     X2,ASNX     IF SEPARATOR, RETURN
          PL     B2,ASNX     IF SEPARATOR, RETURN
 ASN1     LX6    6           SHIFT ASSEMBLY
          BX6    X6+X2       MERGE NEW CHARACTER
          SA2    A2+1        NEXT CHARACTER
          BX2    -X1*X2      MASK OFF POSSIBLE ESCAPE CODE
          SB2    X2-1R
          ZR     X2,ASN2     IF SEPARATOR
          MI     B2,ASN1     IF NOT SEPARATOR
 
*         CHECK POSSIBLE 6/12 ESCAPE CODE.
 
          SB2    X2-76B
          NZ     B2,ASN2     IF NOT ESCAPE CODE THEN SEPARATOR
          SA2    A2+B1
          BX2    -X1*X2
          SB2    X2-1RZ-1    END OF LOWER CASE ALPHABETICS
          ZR     X2,ASN2     IF SEPARATOR
          NG     B2,ASN1     IF NOT SEPARATOR
          EQ     ASN2
 ATS      SPACE  4,20
**        ATS - ALLOCATE TABLE SPACE.
*
*         ENTRY  (A0) = TABLE NUMBER.
*                (X1) = NUMBER OF ADDITIONAL WORDS TO ALLOCATE.
*
*         EXIT   (X2) = TABLE FWA.
*                (X3) = NEW TABLE LENGTH.
*                     = ZERO - NO ROOM FOR TCDK TABLE EXPANSION.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3.
*
*         CALLS  ABT, WTW=.
 
 
 ATS9     SA2    FTAB+A0     SET RESPONSE
          SA3    LTAB+A0
 
 ATS      SUBR               ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE SPACE
          SA3    LTAB+A0
          IX7    X3+X1       ADVANCE LENGTH
          SA4    A2+B1
          IX6    X2+X7
          SA7    A3
          IX4    X4-X6
          MI     X4,ATS1     IF NO ROOM FOR CHANGE
          BX3    X7
          EQ     ATSX        RETURN
 
*         CHECK AVAILABLE STORAGE.
 
 ATS1     SA2    FTAB+FTABL  CHECK STORAGE
          SA3    FL
          IX6    X2+X1
          IX7    X3-X6
          MI     X7,ATS4     IF NO ROOM FOR INCREASE
          SA6    A2          UPDATE LWA+1 OF ALL TABLES
          SB2    A0+B1
          SB3    FTABL
          BX4    X2
          EQ     B2,B3,ATS9  IF LAST TABLE - RETURN
 
*         MOVE HIGHER TABLE UP.
 
 ATS2     SA2    A2-B1       ADVANCE FWA OF HIGHER TABLES
          IX6    X2+X1
          SA6    A2
          SB2    B2+B1
          NE     B2,B3,ATS2  IF NOT END OF TABLES
          IX3    X4-X2       (B2) = WORD COUNT
          SB3    X1          (B3) = MOVE INCREMENT
          ZR     X3,ATS9     IF NO MOVE NEEDED
          SB2    X3+
          SA1    X4-1        BEGIN AT LWA
 ATS3     BX6    X1          MOVE TABLE UP
          SA6    A1+B3
          SB2    B2-B1
          SA1    A1-B1
          NZ     B2,ATS3     IF MOVE NOT COMPLETE
          EQ     ATS9        EXIT TO SET RESPONSE
 
 ATS4     SX3    A0-TCDK
          SA2    L.TCDK
          ZR     X3,ATSX     IF COMMON DECK TABLE - RETURN
 
*         CLEAR COMMON DECKS.
 
          ZR     X2,ATS5     IF NO COMMON DECKS IN MEMORY
          SA3    F.TCDK
          BX6    X6-X6       CLEAR COMMON DECKS
          LX7    X3
          SA6    A2+
          SA7    FTAB+FTABL
          EQ     ATS1        ATTEMPT TO ALLOCATE AGAIN
 
*         DUMP INSERTION TEXT.
 
 ATS5     SA2    T
          SA4    L.TTXT
          NZ     X2,ATS8     IF TEXT FILE BEGUN
          ZR     X4,ATS8     IF NO TEXT
          SX7    X1          SAVE CHANGE
          SX6    B4          SAVE B4 - B7
          SB2    A0-TTXT
          NZ     B2,ATS6     IF NOT TEXT TABLE INCREASE
          IX4    X4-X1       (X4) = ACTUAL LENGTH
 ATS6     SA7    ATSA
          SX7    B5
          SA6    A7+B1
          SA7    A6+B1
          SX6    B6
          SX7    B7
          SA6    A7+B1
          SA7    A6+B1
          SA3    F.TTXT      LWA+1 ALL TABLES = FWA TEXT TABLE
          BX6    X6-X6       CLEAR TEXT TABLE LENGTH
          LX7    X3
          SA6    A4
          SA7    FTAB+FTABL
          SA7    A7-B1       FWA COMMON DECKS = FWA TEXT TABLE
          SA1    T+7         SET TEXT FILE NAME
          BX6    X1
          SA6    A2
          EVICT  A2,R        DUMP TEXT TABLE
          WRITEW X2,X3,X4
          SA1    EI
          ZR     X1,ATS7     IF NO EDITING BEGUN
          WRITER X2,R
          SA1    X2+1        REWIND POINTERS
          SX7    X1
          SA7    A1+B1
          SA7    A7+B1
          BX7    X7-X7       INSURE NO HIT ON TEXT INDEX
          SA7    T+5
 ATS7     SA1    ATSA        RESET CHANGE
          SB2    A0-TTXT
          SA2    A1+B1       RESTORE B4 - B7
          SA3    A2+B1
          SB4    X2
          SB5    X3
          SA2    A3+B1
          SA3    A2+B1
          SB6    X2
          SB7    X3
          NZ     B2,ATS1     IF NOT TEXT TABLE REQUEST - RETRY
          EQ     ATSX        RETURN
 
*         ALLOCATE ADDITIONAL MEMORY.
 
 ATS8     SA3    FL          INCREMENT FL
          SX7    X3+FLINL
          BX4    X1          SAVE X1
          SA7    A3          SET NEW FL
          MEMORY CM,,R,X7
          BX1    X4          RESTORE X1
          EQ     ATS1        ATTEMPT TO ALLOCATE AGAIN
 
 ATSA     CON    0           TEMPORARIES
          CON    0
          CON    0
          CON    0
          CON    0
 ATX      SPACE  4,20
**        ATX - ALLOCATE TABLE EXPANSION SPACE.
*
*         ENTRY  (A0) = TABLE POINTER ADDRESS.
*                (X1) = TABLE BLOCK SIZE.
*
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  ATS.
 
 
 ATX      SUBR               ENTRY/EXIT
          SA2    FTAB+A0     CHECK TABLE ROOM
          SA3    LTAB+A0
          IX2    X2+X1       ADD DESIRED BLOCK SIZE
          SA4    A2+B1
          IX6    X2+X3
          SB2    X3
          IX7    X4-X6
          PL     X7,ATXX     IF ROOM FOR BLOCK
          BX6    X1          SAVE WORD
          SA6    ATXA
          ALLOC  A0,X1
          SA1    ATXA        RESTORE WORD
          IX7    X3-X1
          SA7    A3          RESET TABLE CONTENT LENGTH
          EQ     ATXX        RETURN
 
 ATXA     CON    0           TEMPORARY STORAGE
 CAS      SPACE  4,20
**        CAS - CALL ASSEMBLER.
*
*         ENTRY  (QM) = *Q* MODE ASSEMBLER NAME.
*                (XM) = *X* MODE ASSEMBLER NAME.
*                (NC) = LINES WRITTEN TO COMPILE FILE.
*                (NC+1) = LINES WRITTEN TO COMPILE FILE
*                            IN LAST RECORD.
*                (SFL) = SYSTEM FIELD LENGTH.
*
*         EXIT   IF *X* OR *Q* MODE, EXIT IS TO ASSEMBLER
*                AND A0 AND X0 ARE SET UP WITH EXTENDED MEMORY AND FL,
*                OTHERWISE RETURN.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  MVE=.
 
 
 CAS      SUBR               ENTRY/EXIT
          SA1    QM          CHECK FOR  *X*  OR  *Q*  MODE
          SA2    XM
          SA3    NC          CHECK FOR LINES WRITTEN ON COMPILE
          BX6    X1+X2
          SA4    A3+B1
          ZR     X6,CASX     IF NOT  *X*  OR  *Q*  MODE - RETURN
          BX3    X3+X4
          ZR     X3,CASX     IF NO LINES WRITTEN ON COMPILE - RETURN
          SA1    SFL
          SA0    X1
          SA6    CASA        STORE ASSEMBLER NAME
          MEMORY CM,,R,X1    RESTORE ORIGINAL FL
          SX7    CASBL-1
          SA7    ACTR        SET ARGUMENT COUNT
          MOVE   CASBL,CASB,ARGR  MOVE PARAMETERS
          MOVE   CASGL,CASG,CCDR  MOVE COMMAND
          SA1    EFL         RESTORE *ECS* FIELD LENGTH
          BX0    X1
          SYSTEM LDR,R,CASA  CALL ASSEMBLER
          EQ     CASX        RETURN
 
 CASA     CON    0           LOADER CALL WORDS
          CON    140BS36
 
 CASB     BSS    0           ASSEMBLER PARAMETER LIST
          CON    0LI+1R=
          CON    0LCOMPILE
          CON    0LL+1R=
 CASC     CON    0L0
          CON    0LB+1R=
 CASD     CON    0LLGO
          CON    0LS+1R=
 CASE     CON    0LSYSTEXT
          CON    0LG+1R=
 CASF     CON    0L0
          CON    0
 CASBL    EQU    *-CASB
 
 CASG     BSS    0           ASSEMBLER COMMAND
          DUP    8,1
          CON    1H
          CON    0
 CASGL    EQU    *-CASG
 CKC      SPACE  4,20
**        CKC - CHECK LINE.
*
*         ENTRY  (A0) - ADDRESS OF FLAG LIST WORD.
*
*T LIST   42/FLAG NAME,18/PROCESSOR ADDR.
*
*         EXIT   (X4) = 0 IF NULL DIRECTIVE.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 7.
*                B - 2, 3, 5.
*
*         CALLS  *ASN* AND SPECIAL LINE PROCESSORS.
 
 
 CKC      SUBR               ENTRY/EXIT
          SA1    CHAR        CHECK FIRST CHARACTER
          SA2    PC          CHECK PREFIX CHARACTER
          MX6    -6
          BX1    -X6*X1      USE 6 BIT CHARACTER ONLY
          SX7    A1+B1
          BX3    X1-X2
          SX4    X1-1R
          SA7    CH          SET SECOND CHARACTER
          RJ     ASN         ASSEMBLE NAME
          MX0    42
          SA1    A0+
          BX4    X4+X6       SET EXIT CONDITION
          SB3    64
          NZ     X3,CKCX     IF FIRST CHARACTER .NE. PREFIX - RETURN
          ZR     X6,CKCX     IF BLANK NAME - RETURN
 CKC1     ZR     X1,CKCX     IF END OF LIST - RETURN
          IX7    X1-X6       COMPARE NAMES
          SB5    X1          SET PROCESSOR ADDRESS
          BX3    X0*X7
          SA1    A1+B1       NEXT LIST ENTRY
          NZ     X3,CKC1     IF NO MATCH
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1+1
 CKC2     SB2    X2-1R
          NZ     B2,CKC3     IF NOT BLANK
          SA2    A2+B1       NEXT CHARACTER
          SB3    B3-B1
          PL     B3,CKC2     IF NOT AT END OF LINE
 CKC3     SX7    A2          SET NEXT CHARACTER ADDRESS
          SA7    A1
          JP     B5          PROCESS SPECIAL LINE
 CMF      SPACE  4,20
**        CMF - COMPLETE FILES.
*
*         WRITE DIRECTORY, RETURN SCRATCH FILES, REWIND MODSET,
*         INSURE EVEN PAGE COUNT AND TERMINATE OUTPT FILE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 6, 7.
*
*         MACROS RECALL, RETURN, REWIND, WRITER, WRITEW.
 
 
 CMF      SUBR               ENTRY/EXIT
          RECALL P
          WRITER C
          RETURN T
          REWIND S
          SA1    NR
          NZ     X1,CMF1     IF NO REWIND SET
          REWIND C
 CMF1     SA1    O
          SA2    LF
          ZR     X1,CMF3     IF NO OUTPUT FILE
          SA3    PN
          ZR     X2,CMF3     IF NOTHING LISTED
          LX3    59-0
          NG     X3,CMF2     IF PAGE NUMBER EVEN
          SA1    TO
          ZR     X1,CMF2     IF TERMINAL OUTPUT
          WRITEW O,(=2L1 ),1 EJECT
 CMF2     WRITER O
 CMF3     SA1    A
          ZR     X1,CMF4     IF FILE NOT USED
          RECALL A
 CMF4     RECALL M
          SA1    M+7
          SA2    A+7
          BX6    X1
          LX7    X2
          SA6    M
          SA7    A
          RETURN M
          RETURN A
          SB6    FETS        WAIT FOR ALL FILES QUIET
          SB7    FETSL
 CMF5     SA1    B6
          ZR     X1,CMF6     IF FILE NOT DEFINED
          RECALL B6
 CMF6     SB6    B6+FETLEN+FETODL
          NE     B6,B7,CMF5  IF MORE FILES TO PROCESS
          EQ     CMFX        RETURN
 CPF      SPACE  4,30
**        CPF - CONVERT PROGRAM FILE.
*
*         ENTRY  (CDTX) = FIRST WORD OF COMPRESSED LINE.
*                (CDWC) = WORD COUNT OF COMPRESSED LINE.
*
*         EXIT   (X2) = -6 BIT MASK.
*                (X0) = 2074BS48.
*                (B5) = (B7) = 60.
*                (B2) = 6.
*                (A5) = CDTX.
*                (X5) = (CDTX).
*
*         USES   X - 0, 1, 2, 5.
*                A - 1, 5.
*                B - 2, 4, 5, 7.
*
*         CALLS  CFT, CTF.
 
 
 CPF      SUBR               ENTRY/EXIT
          SA1    CVT         CHECK FOR CONVERSION
          ZR     X1,CPFX     IF NO CONVERSION
          SX0    2074B       CONSTANT - XN=0, BN=60 UPON UNPACK
          SB7    60          CONSTANT 60
          LX0    48
          SB5    B7
          SB2    6           CONSTANT 6
          MX2    -6          CHARACTER MASK
          SA5    CDTX        FWA OF COMPRESSED LINE BUFFER
          MI     X1,CFT      IF 64 TO 63 CHARACTER SET CONVERSION
*         EQ     CTF         63 TO 64 CHARACTER SET CONVERSION
 CTF      SPACE  4,20
**        CTF - CONVERT 63 TO 64 CHARACTER SET.
*
*         CONVERTS A COMPRESSED LINE FROM 63 TO 64 CHARACTER
*         SET.  A  *0001*  BYTE IS CONVERTED TO  *5555*  AND A  *63*
*         CODE BECOMES A  *0001*  BYTE.  THE WORD COUNT IS ALSO
*         UPDATED.  SINCE THE NEW COMPRESSED LINE MAY BE LONGER THAN
*         THE OLD, THE LINE IS NOT CONVERTED IN PLACE.  THE CONVERTED
*         LINE IS MOVED BACK TO THE  *CDTX*  BUFFER AFTER CONVERSION.
*
*         IN *ASCII* MODE, 63 CHARACTER SET PERCENT (*7404B*) IS
*         CONVERTED TO *63B*.
*
*
*         ENTRY  (X2) = -6 BIT MASK.
*                (X0) = 2074BS48.
*                (B5) = (B7) = 60.
*                (B2) = 6.
*                (A5) = CDTX.
*                (X5) = (CDTX).
*
*         EXIT   (CDTX) = CONVERTED LINE IMAGE.
*                (CDWC) = UPDATED LINE WORD COUNT.
*
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 1, 5, 6, 7.
*                B - 3, 4, 5, 6, 7.
*
*         CALLS  MVE=.
 
 
*CTF      BSS    0
          SA1    CSC         CHARACTER SET (DISPLAY/ASCII) CURRENT DECK
          SB4    X1
          SA1    CVTX-1      PRESET (A6)
          BX6    X1
          SA6    A1+
          UX6,B6 X0          SET REGISTERS
 CTF1     LX5    6           PICK NEXT CHARACTER
          SB5    B5-6        DECREMENT CHARACTER COUNT
          BX4    -X2*X5
          NZ     B5,CTF2     IF NOT END OF INPUT WORD
          SA5    A5+B1       ADVANCE TO NEXT WORD
          SB5    B7          RESET CHARACTER COUNT
 CTF2     SX1    X4-63B      CHECK FOR 63 CHARACTER SET COLON
          ZR     X4,CTF4     IF COMPRESSION CHARACTER (*00*)
          ZR     X1,CTF8     IF COLON
          SA1    MADCV
          ZR     B4,CTF3     IF DISPLAY CODE MODE
          NZ     X1,CTF3     IF MADIFY CONVERSION
          SX1    X4-74B
          NZ     X1,CTF3     IF NOT ESCAPE CODE 74B
          LX7    B2,X5       TRY NEXT CHARACTER
          BX1    -X2*X7
          SX7    X1-04
          NZ     X7,CTF3     IF NOT *7404B* (PERCENT)
          SX4    63B         (X4) = 64 CHARACTER SET PERCENT
          LX5    6
          SB5    B5-6
          NZ     B5,CTF3     IF NOT END OF INPUT WORD
          SA5    A5+B1
          SB5    B7          RESET CHARACTER COUNT
 CTF3     LX6    6           PROCESS NORMAL CHARACTER
          SB6    B6-6        DECREMENT CHARACTER COUNT
          BX6    X6+X4       INSERT NEXT CHARACTER
          NZ     B6,CTF1     IF OUTPUT WORD NOT EXHAUSTED
          SA6    A6+B1       SET CURRENT WORD
          UX6,B6 X0          RESET REGISTERS
          EQ     CTF1        GET NEXT CHARACTER
 
*         PROCESS COMPRESSION CODE.
 
 CTF4     LX5    6           PROCESS CHARACTER FOLLOWING COMPRESSION
          BX4    -X2*X5
          SB5    B5-6        DECREMENT CHARACTER COUNT
          NZ     B5,CTF5     IF INPUT WORD NOT EMPTY
          SA5    A5+B1       ADVANCE TO NEXT WORD
          SB5    B7
 CTF5     ZR     X4,CTF9     IF END OF LINE
          SB3    X4-1        CHECK FOR  *0001*  BYTE
          ZR     B3,CTF7     IF  *0001*  BYTE
          LX6    6           INSERT  *00*
 CTF6     SB6    B6-B2
          NZ     B6,CTF3     IF NOT END OF OUTPUT WORD
          SA6    A6+B1       SET CURRENT WORD
          UX6,B6 X0          RESET REGISTERS
          EQ     CTF3        PROCESS COMPRESSION AS NORMAL CHARACTER
 
*         PROCESS  *0001*  CODE.
 
 CTF7     SX4    1R          CONVERT  *0001*  TO  *5555*
          LX6    6           INSERT  *55*
          BX6    X6+X4
          EQ     CTF6        PROCESS SPACE AS NORMAL CHARACTER
 
*         PROCESS  *63*  CODE.
 
 CTF8     SA1    MADCV
          NZ     X1,CTF3     IF MADIFY CONVERSION
          SX4    B1          CONVERT  *63*  TO  *0001*
          LX6    6           INSERT  *00*
          ZR     B4,CTF6     IF DISPLAY CODE, PROCESS *01* AS NORMAL
          SX1    74B
          BX6    X6+X1
          SX4    04B         MAKE *63* INTO *7404* IN ASCII MODE
          EQ     CTF6        PROCESS  *01*  AS NORMAL CHARACTER
 
*         PROCESS END OF LINE.
 
 CTF9     LX6    X6,B6       POSITION LAST WORD
          MX3    -12
          SA6    A6+B1
          BX4    -X3*X6      CHECK FOR END OF LINE IN CURRENT WORD
          ZR     X4,CTF10    IF END OF LINE PRESENT
          BX6    X6-X6       SET END OF LINE WORD
          SA6    A6+B1
 CTF10    SX7    A6-CVTX+1   SET UPDATED WORD COUNT
          SA7    CDWC
          MOVE   X7,CVTX,CDTX  MOVE TO COMPRESSED LINE BUFFER
          EQ     CPFX        RETURN
 CFT      SPACE  4,20
**        CFT - CONVERT 64 TO 63 CHARACTER SET.
*
*         CONVERTS A COMPRESSED LINE FROM 64 TO 63 CHARACTER
*         SET.  A  *0001*  BYTE IS CONVERTED TO A  *63*  AND A
*         *63*  IS CONVERTED TO A  *55*.
*
*         ENTRY  (X2) = -6 BIT MASK.
*                (X0) = 2074BS48.
*                (B5) = (B7) = 60.
*                (B2) = 6.
*                (A5) = CDTX.
*                (X5) = (CDTX).
*
*         EXIT   (CDTX) = CONVERTED LINE IMAGE.
*                (CDWC) = UPDATED LINE WORD COUNT.
*
*         USES   X - 1, 3, 4, 5, 6, 7.
*                A - 1, 4, 5, 6, 7.
*                B - 4, 5, 6.
 
 
 CFT      SA1    CSC         CHARACTER SET (DISPLAY/ASCII) CURRENT DECK
          SA4    CVTX-1      PRESET (A6)
          SB4    X1
          BX6    X4
          SA6    A4
          UX6,B6 X0          SET REGISTERS
 CFT1     LX5    6           GET NEXT CHARACTER
          SB5    B5-6        DECREMENT CHARACTER COUNT
          BX4    -X2*X5
          NZ     B5,CFT2     IF NOT END OF INPUT WORD
          SA5    A5+B1       SET NEXT WORD
          SB5    B7          RESET CHARACTER COUNT
 CFT2     ZR     X4,CFT4     IF COMPRESSION CODE OR COLON
          SX1    X4-74B
          NZ     X1,CFT2.1   IF NOT ESCAPE CODE 74B
          LX7    B2,X5       CHECK NEXT CHARACTER
          BX1    -X2*X7
          SX7    X1-04B      CHECK FOR 64 CHARACTER SET COLON
          NZ     X7,CFT2.1   IF NOT 64 CHARACTER SET COLON (*7404*)
          SX4    63B         SET 63 CHARACTER SET COLON (*63B*)
          LX5    6
          SB5    B5-6
          NZ     B5,CFT3     IF NOT END OF INPUT WORD
          SA5    A5+B1
          SB5    B7          RESET CHARACTER COUNT
          EQ     CFT3        INSERT CHARACTER
 
 CFT2.1   SX1    X4-63B      CHECK FOR PERCENT SIGN
          NZ     X1,CFT3     IF NOT PERCENT SIGN
          EQ     B4,B1,CFT9  IF ASCII MODE
          SX4    1R          CONVERT PERCENT TO BLANK
 CFT3     LX6    6           INSERT CHARACTER
          SB6    B6-6
          BX6    X6+X4
          NZ     B6,CFT1     IF OUTPUT WORD NOT FULL
          SA6    A6+B1       SET CURRENT WORD
          UX6,B6 X0          RESET REGISTERS
          EQ     CFT1        GET NEXT CHARACTER
 
*         PROCESS COMPRESSION/COLON CODES.
 
 CFT4     LX5    6           GET NEXT CHARACTER
          SB5    B5-6        DECREMENT CHARACTER COUNT
          BX4    -X2*X5
          ZR     X4,CFT7     IF END OF LINE
          NZ     B5,CFT5     IF INPUT WORD NOT EXHAUSTED
          SA5    A5+1        GET NEXT CHARACTER
          SB5    B7+         RESET CHARACTER COUNT
 CFT5     SX1    X4-1        CHECK FOR  *0001* CODE
          ZR     X1,CFT6     IF COLON (*0001*)
          LX6    6           SET  *00*
          SB6    B6-B2       DECREMENT CHARACTER COUNT
          NZ     B6,CFT3     IF OUTPUT WORD NOT EXHAUSTED
          SA6    A6+B1
          UX6,B6 X0
          EQ     CFT3        PROCESS AS NORMAL CHARACTER
 
*         PROCESS  *0001*  CODE.
 
 CFT6     SX4    63B         CONVERT  *0001*  TO  *63*
          EQ     CFT3        PROCESS AS NORMAL CHARACTER
 
*         PROCESS END OF LINE.
 
 CFT7     LX6    X6,B6       LEFT JUSTIFY ASSEMBLY
          MX3    -12         CHECK FOR END OF LINE SUPPLIED
          SA6    A6+B1       SET LAST WORD
          BX4    -X3*X6
          ZR     X4,CFT8     IF END OF LINE PRESENT
          BX6    X6-X6
          SA6    A6+B1
 CFT8     SX7    A6-CVTX+1   SET UPDATED WORD COUNT
          SA7    CDWC
          MOVE   X7,CVTX,CDTX  MOVE TO COMPRESSED LINE BUFFER
          EQ     CPFX        RETURN
 
*         PROCESS *63* IN ASCII MODE.
 
 CFT9     SX1    74B         MAKE PERCENT IN ASCII CHARACTER SET
          LX6    6
          SB6    B6-B2
          SX4    04B
          BX6    X6+X1
          NZ     B6,CFT3     IF OUTPUT WORD NOT EXHAUSTED
          SA6    A6+B1
          UX6,B6 X0
          EQ     CFT3        PROCESS AS NORMAL CHARACTER
 DNL      SPACE  4,15
**        DNL - DECREMENT NESTING LEVEL.
*
*         ENTRY  NONE.
*
*         EXIT   (X6) = COMMON DECK NAME OF PREVIOUS NESTING LEVEL.
*                     = 0 IF NO NESTING.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 2, 6, 7.
 
 
 DNL      SUBR               ENTRY/EXIT
          SX6    0
          SA1    L.TNCC
          SA6    CDC         CLEAR COMMON DECK LINE COUNT
          SA6    CDS         CLEAR COMMON DECK SKIP COUNT
          ZR     X1,DNLX     IF NO NESTING
          SX6    X1-1
          SA6    A1          DECREMENT TABLE LENGTH
          ZR     X6,DNLX     IF NO NESTING
          SA2    F.TNCC
          IX3    X6+X2
          MX2    42
          SA1    X3-1        GET PREVIOUS NESTING LEVEL NAME
          SX7    X1          SKIP COUNT
          BX6    X2*X1       COMMON DECK NAME
          SA7    CDS         SET SKIP COUNT
          EQ     DNLX        RETURN
 ECD      SPACE  4,20
**        ECD - EXPAND LINE.
*
*         ENTRY  (CDTX) = FIRST WORD OF COMPRESSED LINE.
*
*         EXIT   (B7) = LWA+1 OF LAST CHARACTER IN EXPANDED LINE.
*                (CHAR) = FIRST CHARACTER OF EXPANDED LINE.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  CDD.
 
 
 ECD      SUBR               ENTRY/EXIT
          SA3    CSC         CHARACTER SET OF DECK
          SA4    SETC        CHECK FOR *CSET
          ZR     X3,ECD0     IF DECK IS DISPLAY
 
*         DECK IS 6/12 ASCII.
 
          SB6    B1+
          NZ     X4,ECD0.1   IF NOT *CSET,DISPLAY - UNPACK 6/12 ASCII
          SB6    B0+
          EQ     ECD0.1      OTHERWISE *CSET,DISPLAY FOLD TO UPPER CASE
 
*         DECK IS DISPLAY.
 
 ECD0     SB6    -B1         UNPACK 6 BIT CHARACTERS
          NG     X4,ECD0.1   IF NO *CSET
          ZR     X4,ECD0.1   IF *CSET,DISPLAY
          SB6    B1+         UNPACK 6/12 ASCII CHARACTERS
 
 ECD0.1   SA1    SC+1        SET LAST COLUMN
          SX6    1R          SET TO BLANK FILL BUFFER
          SB7    X1+B1
          SA6    CHAR        PRESET (A6)
          MX0    -6
          SB2    -B7
          SB5    10          CONSTANT 10
          SB4    B5
 ECD1     SB7    B7-B1       BLANK FILL LINE
          SA6    A6+B1
          PL     B7,ECD1     IF NOT COMPLETE
          SB3    CHAR+1+X1
          SA1    CDTX
          EQ     ECD3
 
*         EXPAND LINE TEXT.
 
 ECD1.1   SX2    X7-76B
          SX4    X7-74B
          ZR     X2,ECD1.2   IF 76B ESCAPE CODE
          NZ     X4,ECD2     IF NO ESCAPE CODES
          BX3    X1
          LX3    6
          BX2    -X0*X3
          SX4    X2-1
          SX3    X2-2
          ZR     X4,ECD1.3   IF 7401B UNPACK AT SIGN
          ZR     X3,ECD1.3   IF 7402B UNPACK CIRCUMFLEX
          SX4    X2-4
          SX3    X2-7
          ZR     X4,ECD1.3   IF 7404B UNPACK COLON (64) OR PERCENT (63)
          ZR     X3,ECD1.3   IF 7407B UNPACK GRAVE ACCENT
          EQ     ECD2        OTHERWISE UNPACK 6 BIT CHARACTERS
 
 ECD1.2   BX4    X1
          LX4    6
          BX3    -X0*X4
          SX4    X3-37B
          PL     X4,ECD2     IF .GT. 7636B UNPACK 6 BIT CHARACTERS
 ECD1.3   LX7    6           12 BIT CHARACTER
          SB4    B4-B1
          LX1    6
          BX2    -X0*X1
          BX7    X7+X2
          NZ     B4,ECD2     IF NOT END OF WORD
          SA1    A1+B1
          SB4    B5
 ECD2     PL     B2,ECD7     IF LINE LIMIT REACHED
          SA7    B2+B3       STORE CHARACTER
          SB2    B2+B1
 ECD3     SB4    B4-1        SHIFT TO NEXT CHARACTER
          LX1    6
          BX7    -X0*X1
          NZ     B4,ECD4     IF NOT END OF WORD
          SA1    A1+B1       SET NEXT WORD
          SB4    B5
 ECD4     ZR     X7,ECD4.1   IF CURRENT CHARACTER IS *00*
          NG     B6,ECD2     IF UNPACKING 6 BIT CHARACTERS
          ZR     B6,ECD11    IF CONVERTING LOWER TO UPPER CASE
          EQ     ECD1.1      OTHERWISE UNPACK 12 BIT ASCII
 
 ECD4.1   SB4    B4-1
          LX1    6           EXTRACT SPACE COUNT
          BX7    -X0*X1
 
 ECDA     BSS    0
          NZ     B4,ECD5     IF NOT END OF WORD
*         NZ     B4,ECD6     (63 CHARACTER SET)
          SA1    A1+B1       SET NEXT WORD
          SB4    B5          RESET CHARACTER COUNT
 
 ECDB     BSS    0
 ECD5     SB7    X7          CHECK COMPRESSION CODE
*         EQ     ECD6        (63 CHARACTER SET)
          NE     B7,B1,ECD6  IF NOT  *0001*
          BX7    X7-X7       INSERT  *00*  CHARACTER
          EQ     ECD2
 
*         PROCESS COMPRESSION CODE.
 
 ECD6     SX4    X7+B1       SET COMPRESSION COUNT
          SB2    X4+B2       SET BLANKS IN BUFFER
          NZ     X7,ECD3     IF NOT END OF WORD
 
*         ENTER IDENTIFIER NAME.
 
 ECD7     SA2    CDID        GET LINE IDENTIFICATION
          SB7    B2+B3       SET ADDRESS OF LAST CHARACTER +1
          MX3    -16
          SB2    7
          LX2    6
 ECD8     BX7    -X0*X2      NEXT CHARACTER
          SB2    B2-1
          LX2    6
          NZ     X7,ECD9     IF NOT  *00*
          SX7    1R          SET BLANK
 ECD9     SA7    B3-B1
          SB3    B3+B1
          NZ     B2,ECD8     IF NOT AT END OF NAME
 
*         ENTER LINE NUMBER.
 
          LX2    12          CONVERT LINE NUMBER
          BX1    -X3*X2
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SB2    9
          LX6    24
          MX0    -6
 ECD10    BX7    -X0*X6      ENTER SEQUENCE NUMBER
          SB2    B2-B1
          SA7    A7+B1
          LX6    6
          NZ     B2,ECD10    IF NOT AT END OF SEQUENCE NUMBER
          SB3    A7+1        RETURN WITH NEXT CHARACTER POSITION
          EQ     ECDX
 
 
*         CONVERT 6/12 ASCII TO DISPLAY CODE.
*
*         X0 = 6 BIT CHARACTER MASK (LOW ORDER CHARACTER).
*         X1 = UNPACK REGISTER POSITIONED TO NEXT CHARACTER.
*         X7 = CURRENT ESCAPE CODE RIGHT JUSTIFIED.
*         B4 = COUNT OF CHARACTERS UNPACKED FROM X1.
*         B5 = 10 (NUMBER OF 6 BIT CHARACTERS IN A WORD).
 
 
 ECD11    BX3    X1
          LX3    6
          BX2    -X0*X3      GET NEXT CHARACTER
          SX4    X7-74B
          SX3    X7-76B
          ZR     X4,ECD14    IF 74B ESCAPE CODE
          NZ     X3,ECD2     IF NO ESCAPE CODES
          ZR     X2,ECD2     IF 7600B, PROCESS AS 2 CHARACTERS
          SX4    X2-37B
          PL     X4,ECD2     IF .GT. 7636B, PROCESS AS 2 CHARACTERS
          SX4    X2-33B
          NG     X4,ECD12    IF LOWER CASE CONVERT TO UPPER CASE
 
*         CHECK FOR ISO NATIONAL CHARACTERS.
 
          SX7    61B
          ZR     X4,ECD13    IF LEFT BRACE CONVERT TO LEFT BRACKET
          SX4    X2-34B
          SX7    75B
          ZR     X4,ECD13    IF VERTICAL LINE CONVERT TO BACK SLASH
          SX4    X2-35B
          SX7    62B
          ZR     X4,ECD13    IF RIGHT BRACE CONVERT TO RIGHT BRACKET
          SX2    76B         CONVERT TILDE TO CIRCUMFLEX
 
 ECD12    BX7    X2          STRIP AWAY 76B ASCII ESCAPE CODE
 ECD13    SB4    B4-B1
          LX1    6
          NZ     B4,ECD2     IF DISPLAY CODE CHARACTER
          SA1    A1+B1       SET UP NEXT WORD
          SB4    B5
          EQ     ECD2        STORE DISPLAY CODE CHARACTER
 
 ECD14    BX3    X2          POSSIBLE 74B ESCAPE CODE FOUND
          SX4    X3-1
          ZR     X4,ECD13    IF AT SIGN (IN X7)
          SX4    X3-2
          SX2    76B
          ZR     X4,ECD12    IF CIRCUMFLEX
          SX4    X3-7
          ZR     X4,ECD13    IF 7407B - UNPACK GRAVE ACCENT
          SX4    X3-4
          NZ     X4,ECD2     IF NOT 7407B - 2 CHARACTERS
          SA4    COPL        CHECK FOR 63 OR 64 CHARACTER SET
          SA2    DISCOL
          NZ     X4,ECD12    IF 64 UNPACK COLON
          SA2    DISPER
          EQ     ECD12       OTHERWISE UNPACK 63 PERCENT (55B)
 INL      SPACE  4,15
**        INL - INCREMENT NESTING LEVEL.
*
*         INCREMENT NESTING LEVEL OF COMMON DECK CALLS.
*
*         ENTRY  (X6) = COMMON DECK NAME.
*
*         EXIT   (X6) = COMMON DECK NAME.
*
*         USES   X - 0, 1, 4, 7.
*                A - 1, 4, 7.
*                B - 2.
*
*         MACROS ADDWRD, SEARCH.
 
 
 INL1     SX7    0
          SA7    CDC         RESET LINE COUNT
          SA7    CDS         RESET SKIP COUNT
          SEARCH TCCD,X6
          NZ     X2,INLX     IF ALREADY CALLED COMMON DECK
          ADDWRD TCCD,X6     ADD NAME TO TABLE OF CALLED DECKS
 
 INL      SUBR               ENTRY/EXIT
          MX0    42
          BX6    X0*X6
          ADDWRD TNCC,X6     PUSH DECK NAME ON STACK
          LE     B2,B0,INL1  IF NO PREVIOUS ENTRY
          SA1    CDC         GET COUNT OF LINES OF PREVIOUS OPLC
          SA4    A6-B1       GET PREVIOUS ENTRY
          BX4    X0*X4
          BX7    X4+X1       INCLUDE SKIP COUNT
          SA7    A4
          EQ     INL1        SEARCH TABLE OF CALLED COMMON DECKS
 PCS      SPACE  4,15
**        PCS - PROCESS OPL CHARACTER SET.
*
*         CHECK AND/OR INITIALIZE  *MODIFY*  FOR 63/64 CHARACTER
*         AND DISPLAY/ASCII CHARACTER SET OPL PROCESSING.
*
*         ENTRY  (B5) = FWA OF IDENT TABLE FOR RECORD.
*
*         EXIT   IF INITIAL ENTRY.
*                (ECDA) INITIALIZED.
*                (ECDB) INITIALIZED.
*
*         USES   X - 1, 2, 3, 4, 5.6, 7.
*                A - 0, 1, 3, 4, 6, 7.
*                B - 2.
*
*         CALLS  ABT, SFN.
 
 
 PCS      SUBR               ENTRY/EXIT
          SA5    B5+16B      CHECK CHARACTER SET OF RECORD
          MX1    -6          MASK OFF 63/64 CHARACTER SET
          BX5    -X1*X5
 
*         VERIFY OPL CHARACTER SET.
 
          SX3    X5-64B      CHECK FOR 64 CHARACTER SET PL
          ZR     X3,PCS1     IF 64 CHARACTER SET
          ZR     X5,PCS1     IF 63 CHARACTER SET (*00*)
          SA1    B5+B1       INCORRECT CHARACTER SET DECK NAME
          RJ     SFN         SPACE FILL DECK NAME
          SX2    1R &1R-     FORM MESSAGE
          BX5    X5-X5       SET 63 CHARACTER SET
          LX6    -6
          BX6    X6-X2
          SA6    PCSB        SET MESSAGE
          SA1    A5          CORRECT CHARACTER SET IN HEADER
          MX2    54
          BX7    X2*X1       PRESERVE ASCII FLAG
          SA7    A1
          MESSAGE A6,3       * DECKNAM - INCORRECT CS, 63 ASSUMED.*
 
*         CHECK FOR MIXED PL,S.
 
 PCS1     SA4    COPL        PREVIOUS CHARACTER SET
          BX3    X4-X5       COMPARE PREVIOUS AGAINST CURRENT
          BX6    X5          CHARACTER SET OF CURRENT RECORD
          SB2    X5          CHARACTER SET OF CURRENT RECORD
          SA6    A4          SET PREVIOUS CHARACTER SET
          MI     X4,PCS2     IF INITIAL ENTRY
 
*         COMPARE AGAINST CHARACTER SET OF PREVIOUS RECORD.
 
          ZR     X3,PCS11    IF SAME CHARACTER SET - CHECK ASCII FLAG
          SA1    B5+B1       SET DECK NAME IN MESSAGE
          RJ     SFN         SPACE FILL DECK NAME
          SX2    1R &1R-     FORM MESSAGE
          LX6    -6
          BX6    X6-X2
          SA6    PCSC
          SA0    A6          ADDRESS OF MESSAGE
          EQ     ABT
 
*         CHECK REDUNDANT CONVERSION.
 
 PCS2     SA3    CVT         CHECK AGAINST CONVERSION OPTION
          ZR     X3,PCS7     IF NO CONVERSION SPECIFIED
          SB2    X3-63B
          NZ     X5,PCS4     IF PROGRAM LIBRARY IS 64 CHARACTER SET
          NZ     B2,PCS5     IF NOT REDUNDANT, NOT 63 TO 63 CONVERSION
 PCS3     MESSAGE (=C* REDUNDANT CONVERSION IGNORED.*),3
          BX6    X6-X6       CLEAR CONVERSION IF REDUNDANT
          SA6    A3
          EQ     PCS7        PROCESS AS NO CONVERSION
 
 PCS4     NE     B1,B2,PCS5  IF NOT 64 TO 64 REDUNDANCY
          SA1    MADCV
          NZ     X1,PCS5     IF MADIFY CONVERSION - NOT REDUNDANT
          SB2    64B         NEW PROGRAM LIBRARY CHARACTER SET
          EQ     PCS3        REDUNDANT 64 TO 64 CONVERSION
 
 PCS5     ZR     B2,PCS6     IF CONVERSION TO 63 CHARACTER SET
          SB2    64B         SET CONVERSION TO 64 CHARACTER SET
 PCS6     SX7    B2-1        SET CONVERSION FLAG
          SA7    A3+
 
*         MODIFY INSTRUCTIONS FOR 63 CHARACTER SET.
 
 PCS7     NZ     B2,PCS8     IF 64 CHARACTER SET
          SA1    PCSE
          SA0    PCSD
          NZ     X1,ABT      IF INPUT 64 WHILE PL IS 63
          SA1    PCSA        MODIFY INSTRUCTIONS
          SA2    A1+B1
          BX6    X1
          BX7    X2
          SA6    ECDA
          SA7    ECDB
 
*         INITIALIZE PROGRAM LIBRARY/COMPILE FILE CHARACTER SETS.
 
 PCS8     SX7    B2          NEW CHARACTER SET
          SA1    CIDT        COMPILE FILE HEADER SKELETON
          SA7    CNPL        CHARACTER SET OF NEW PROGRAM LIBRARY
          LX7    24
          BX6    X7+X1
          SA6    A1
 
*         STORE DISPLAY CODE COLON AND PERCENT CHARACTERS.
 
          ZR     B2,PCS9     IF 63 CHARACTER SET
          MX7    0           00B = 64 CHARACTER SET COLON
          SX6    63B         63B = 64 CHARACTER SET PERCENT
          EQ     PCS10       STORE CHARACTERS
 
 PCS9     SX7    63B         63 CHARACTER SET COLON
          SX6    1R          63 CHARACTER SET PERCENT
 PCS10    SA7    DISCOL      COLON
          SA6    DISPER      PERCENT
 
 
*         DETERMINE IF DECK IS DISPLAY OR 6/12 ASCII.
 
 PCS11    SA2    MADCV       CHECK FOR MADIFY CONVERSION
          SX6    1           SET ASCII BIT FOR THIS DECK
          NZ     X2,PCS12    IF MADIFY CONVERSION
          SA1    A5          GET CHARACTER SET WORD
          MX4    -6
          LX1    -6          SHIFT TO ASCII/DISPLAY FIELD
          BX6    -X4*X1
 PCS12    SA6    CSC         SET CURRENT CHARACTER SET
          EQ     PCSX        RETURN
 
 
 PCSA     NZ     B4,ECD6     IF NOT END OF WORD (63 CHARACTER SET)
          SA1    A1+B1
          SB4    B5
+         EQ     ECD6        (63 CHARACTER SET)
 
 PCSB     DATA   C* DECKNAM - INCORRECT CS, 63 ASSUMED.*
 PCSC     DATA   C* DECKNAM - MIXED CHARACTER SET DETECTED.*
 PCSD     DATA   C* INCORRECT CS ON INPUT.*
 PCSE     DATA   0           INPUT 64 SET INDICATOR
 PLE      SPACE  4,20
**        PLE - PROCESS LIBRARY ERROR.
*
*         ISSUES LIBRARY ERROR MESSAGE AND ABORTS JOB.
*
*         CALLS  ABT.
 
 
 PLE      SA1    DN          SET DECK NAME IN MESSAGE
          BX6    X1
          SA6    PLEB
          SA0    PLEA        ABORT JOB
          EQ     ABT
 
 PLEA     DATA   20H PL ERROR IN DECK
 PLEB     CON    0
 PCW      SPACE  4,20
**        PCW - PROCESS COMPILE FILE WRITE.
*
*         WRITE COMMON DECK DATA IF NOT CALL TO OTHER COMMON DECK.
*         TRAP NESTING OF COMMON DECKS.
*
*         ENTRY  NONE.
*
*         EXIT   (X1) = ZERO = NORMAL RETURN
*                     = NONZERO = SKIP THIS LINE
*                (X6) = COMMON DECK NAME IF CALL ENCOUNTERED.
*                       ELSE 0, AND LINE WRITTEN.
*
*         USES   ALL.
*
*         CALLS  ASN, ECD, LCE, WCC, WCF.
*
*         MACROS CARD, LISTOP, RECALL, SEARCH.
 
 
 PCW7     SA1    AM          CHECK FOR COMPRESSED COMPILE FILE
          ZR     X1,PCW8     IF NOT COMPRESSED MODE
 
          RJ     WCC         WRITE COMPRESSED COMPILE FILE
          EQ     PCW10       NORMAL RETURN
 
 PCW8     RJ     ECD         EXPAND LINE
 PCW9     RJ     WCF         WRITE COMPILE FILE
          SX1    1           THIS LINE IS NOT A COMMENT
 PCW10    MX6    0           NORMAL RETURN - NO COMMON DECK NESTING
 
 PCW      SUBR               ENTRY/EXIT
          SA2    CDC         INCREMENT LINE COUNT
          SA1    CDS         GET SKIP COUNT
          SX7    X2+B1
          SA7    A2
          ZR     X1,PCW1     IF NOTHING TO SKIP
          SX7    X1-1
          SA7    A1
          MX1    0           INDICATE SKIPPING
          BX6    X6-X6
          EQ     PCWX        RETURN SKIPPING THIS LINE
 
 PCW1     SA1    CDTX
          SA2    WCCA        GET PREFIX CHARACTER
          BX3    X2-X1
          AX3    54
          NG     X3,PCW7     IF NOT COMMENT LINE
          NZ     X3,PCW7     IF NOT COMMENT LINE
          RJ     ECD         EXPAND LINE
 
          CARD   CALL,PCW2         *CALL
          CARD   CALLC,PCW4        *CALLC
          CARD   IFCALL,PCW5       *IFCALL
          CARD   NIFCALL,PCW6      *NIFCALL
 
          EQ     PCW9        WRITE COMPILE FILE
 COMPILE  SPACE  4,10
***       COMPILE FILE CONTROL DIRECTIVES.
*
*         THESE DIRECTIVES CONTROL THE PROCESSING OF THE COMPILE FILE.
*         THEY ARE PROCESSED WHEN THEY OCCUR FROM THE PROGRAM LIBRARY
*         OR RESULT FROM INSERTION.
 CALL     SPACE  4,10
***       CALL   DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE.
 
 PCW2     SA1    IFIP
          NG     X1,PCW10    IF INACTIVE
          RECALL M
          RJ     ASN         ASSEMBLE NAME
 PCW3     NZ     X6,PCW3.5   IF NAME IS OK
          BX7    X7-X7
          SA7    CL          CLEAR LINE LISTED STATUS
          SA0    =C/ UNKNOWN DECK./
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     PCW10       RETURN AFTER ERROR
 
 PCW3.5   SEARCH TNCC,X6     CHECK IF RECURSIVE CALL
          ZR     X2,PCWX     IF NOT FOUND IN NESTING STACK
          LISTOP E,PCW10     IF NO ERROR LIST - RETURN
          SA0    PCWA
          RJ     LCE         LIST COMPILE FILE DIRECTIVE ERROR
          EQ     PCW10       NORMAL RETURN
 CALLC    SPACE  4,10
***       CALLC  DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF IT
*         HAS NOT BEEN CALLED BY A PREVIOUS *CALL* OR *CALLC* COMPILE
*         FILE DIRECTIVE.
 
 PCW4     SA1    IFIP
          NG     X1,PCW10    IF INACTIVE
          RECALL M
          RJ     ASN         ASSEMBLE NAME
          SEARCH TCCD,X6
          ZR     X2,PCW3     IF NOT FOUND - PROCESS AS *CALL
          EQ     PCW10       NORMAL RETURN
 IFCALL   SPACE  4,10
***       IFCALL NAME,DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
*         *NAME* IS DEFINED.
 
 
 PCW5     RJ     ASN         ASSEMBLE NAME
          SEARCH TDEF,X6     SEARCH FOR NAME
          ZR     X2,PCW10    IF NOT FOUND - RETURN
          SX7    X7+B1       SKIP SEPARATOR
          SA7    CH
          EQ     PCW2        PROCESS AS *CALL
 NIFCALL  SPACE  4,10
***       NIFCALL NAME,DNAME
*
*         PLACE COPY OF COMMON DECK *DNAME* ON COMPILE FILE, IF
*         *NAME* IS NOT DEFINED.
 
 
 PCW6     RJ     ASN         ASSEMBLE NAME
          SEARCH TDEF,X6     SEARCH FOR NAME
          NZ     X2,PCW10    IF FOUND - RETURN
          SX7    X7+B1       SKIP SEPARATOR
          SA7    CH
          EQ     PCW2        PROCESS AS *CALL
 
 
 PCWA     DATA   C* DECKNAM - INCORRECTLY NESTED CALL OF COMMON DECK*
 RCL      SPACE  4,15
**        RCL - RE-COMPRESS LINE.
*
*         ENTRY  (CHAR) = CHARACTER STRING OF LINE.
*                (B7)   = LAST CHARACTER POSITION IN STRING BUFFER.
*
*         EXIT   (CDTX) = COMPRESSED LINE.
*                (CDWC) = WORD COUNT OF COMPRESSED LINE.
*
*         USES   ALL.
 
 
*         PROCESS END OF LINE.
 
 RCL8     LX6    X6,B6       SHIFT UP LAST WORD
          MX3    -12
          SA6    A6+1
          BX4    -X3*X6
          SB2    A1+
          BX6    X6-X6
          ZR     X4,RCL9     IF LINE TERMINATED
          SA6    A6+1        TERMINATE LINE
 RCL9     SX7    A6-B2       SET WORD COUNT
          SA7    A1-B1
 
 RCL      SUBR               ENTRY/EXIT
          SX7    B7-1        SAVE LAST CHARACTER POSITION
          SA7    RCLL
          SX0    2074B       (X0) = CONSTANT 60 FOR UNPACK
          SB4    100B
          SB3    -B1
          SA1    CDID        PRESET (A6)
          LX0    48
          SA5    CHAR        FIRST CHARACTER
          SB7    B4+B1
          BX6    X1
          SA6    A1
          SB2    6
          UX6,B6 X0          RESET REGISTERS
          SA2    RCLL        SET LAST CHARACTER POSITION
          SB5    -B1
          BX1    -X2
          SX7    1R
          EQ     RCL7        ENTER TO PROCESS FIRST CHARACTER
 
 RCL1     SB5    B5+1
 RCL2     LX6    6           00 CHARACTER
          SB6    B6-B2
          SX4    B4-B1       COMPRESSION = 77B
          SB3    B5-B7
          NZ     B6,RCL3     IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 RCL3     PL     B3,RCL4     IF .GT. 64 BLANKS
          SX4    B5-B1       COMPRESSION = COUNT - 1
          SB3    -B1
 RCL4     NZ     X4,RCL5     IF CHARACTER IS NOT  *00*
          LX6    6           INSERT *00*
          SB6    B6-B2
          SX4    B1          SET *01*
          NZ     B6,RCL5     IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 RCL5     BX3    X4          SAVE CHARACTER
          AX4    6           CHECK FOR ESCAPE CODE
          ZR     X4,RCL6     IF NO ESCAPE CODE
          LX6    6           SHIFT ASSEMBLY
          SB6    B6-B2
          BX6    X6+X4       MERGE NEW CHARACTER
          SB5    B3
          NZ     B6,RCL6     IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 RCL6     MX4    -6
          BX4    -X4*X3      CLEAN OFF ESCAPE CODE
          LX6    6           SHIFT ASSEMBLY
          SB6    B6-B2
          BX6    X6+X4       MERGE NEW CHARACTER
          SB5    B3
          NZ     B6,RCL7     IF NOT END OF WORD
          SA6    A6+B1
          UX6    B6,X0
 RCL7     IX3    X5-X7       CHECK CHARACTER
          BX4    X5
          SB5    B5+B1       COUNT BLANK
          SB3    X1          -( LWA + 1 ) OF STRING BUFFER
          SB3    B3+A5       CHECK FOR END OF LINE
          SA5    A5+B1       NEXT CHARACTER
          ZR     B3,RCL8     IF END OF LINE
          ZR     X3,RCL7     IF BLANK
          SB3    -1
          ZR     B5,RCL4     IF NO BLANKS
          BX4    X7
          SA5    A5-B1       BACKSPACE
          EQ     B5,B1,RCL4  IF 1 BLANK
          SB5    B5-1
          NE     B5,B1,RCL1  IF NOT 2 BLANKS
          SA5    A5-1        BACKSPACE
          EQ     RCL4        CHECK FOR *00* CHARACTER
 
 RCLL     CON    0           LAST CHARACTER POSITION IN STRING BUFFER
 RMT      SPACE  4,25
**        RMT - READ MODIFIER TABLE.
*
*         ENTRY  (DN) = DECK NAME.
*                (MA) = MODIFICATION TABLE ADDRESS.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - ALL.
*
*         CALLS  AMD, ATS, PCS, POC.
 
 
 RMT      SUBR               ENTRY/EXIT
          SA1    DA          GET DECK TABLE ENTRY
          SA3    X1+B1       SET RANDOM ADDRESS
          MX7    -30
          BX7    -X7*X3
          AX3    36          SET FILE NAME
          SA7    P+6
          SA2    X3
          BX6    X2
          SA6    P
          READ   A6          INITIATE NEW READ
          READW  X2,TIDT,TIDTL  READ IDENT TABLE
          NZ     X1,PLE      IF EOR
          SA1    TIDT
          LX1    12
          SB2    X1-7700B
          NZ     B2,PLE      IF NO IDENT TABLE
          SA1    TIDT+1      CHECK DECK NAME
          SA2    DN
          BX3    X1-X2
          NZ     X3,PLE      IF NO MATCH
          ADDWRD TDKI,X1     ADD DECK NAME TO DECK IDENTIFIER TABLE
          ADDWRD TNCD,X6-X6  ADD NEXT LINE NUMBER
          SB5    TIDT        FWA OF IDENT TABLE
          RJ     PCS         PROCESS CHARACTER SET
          READW  P,T1,1      READ MODIFIER TABLE LENGTH
          NZ     X1,PLE      IF EOR
          SA1    T1          CHECK TABLE
          LX1    18
          BX6    X6-X6
          SB2    X1-700100B
          SB3    X1-700200B
          ZR     B2,RMT1     IF NORMAL DECK
          NZ     B3,PLE      IF NOT COMMON DECK
          SX6    B1
 RMT1     SA6    CD          SET DECK STATUS
          LX1    42          SET TABLE LENGTH
          SB7    X1
          ZR     B7,RMT2     IF NO MODIFIERS
          ALLOC  TNCD,B7     ALLOCATE FOR MODIFIERS
          ALLOC  TDKI,B7
          READW  P,X2+B1,B7  READ MODIFIERS
 RMT2     SA3    MA
          ZR     X3,RMT3     IF NO MODIFICATIONS
          SB6    X3
          RJ     AMD         ADD MODIFIERS
          SA1    L.TDKI      ALLOCATE PARALLEL TABLE
          SB7    X1
          ALLOC  TNCD,B7
 RMT3     SA1    YK
          ZR     X1,RMTX     IF NO YANKS - RETURN
 
*         ADD YANKS.
 
          SA2    L.TDKI      SEARCH MODIFIER TABLE
          SA1    F.TDKI
          SX0    1S16        YANK/UNYANK MASK
          SB4    X2+
          SA5    X1
          BX7    X7-X7       CLEAR YANK COUNT
 RMT4     EQ     B4,B1,RMT6  IF END OF MODIFIER TABLE
          SA5    A5+B1       NEXT ENTRY
          SB4    B4-B1
          SX2    1S15        SEARCH FOR YANK
          SEARCH TNME,X5+X2,X2
          ZR     X2,RMT4     IF NOT FOUND
          BX1    X0*X2       CLEAR/SET YANK IN MODIFIER
          LX2    59-0
 RMT5     BX5    -X0*X5
          IX6    X5+X1
          SA6    A5
          SX7    X7+B1       COUNT YANK
          PL     X2,RMT4     IF NOT YANK AFTER
          SA5    A5+B1       NEXT ENTRY
          SB4    B4-B1
          NZ     B4,RMT5     IF NOT AT END OF MODIFIERS
 RMT6     SA7    YD          SET YANK FLAG
          EQ     RMTX        RETURN
 RPF      SPACE  4,25
**        RPF - READ LINE FROM PROGRAM LIBRARY.
*
*         EXIT   (X1) = 0, IF NO EOR READ.
*
*         USES   ALL.
*
*         CALLS  RDC=.
 
 
 RPF      SUBR               ENTRY/EXIT
          READC  A0,BUF,BUFL READ MHB,S
          NZ     X1,RPFX     IF EOR - RETURN
          SA1    BUF         SHIFT TO FIRST MHB
          LX1    24
          SX6    -B1         CLEAR MHB COUNT
          MX0    -18
          SB2    B1          2 MHB-S ON FIRST PASS
 RPF1     LX1    18          SHIFT TO NEXT MHB
          BX7    -X0*X1
          SB2    B2-B1
          SX6    X6+B1
          ZR     X7,RPF2     IF END OF MHB LIST
          SA7    TMHB+X6     STORE MHB
          PL     B2,RPF1     IF NOT AT END OF WORD
          SA1    A1+B1       NEXT WORD
          SB2    B1+B1       RESET MHB COUNT
          LX1    6
          EQ     RPF1        LOOP
 
*         READ COMPRESSED LINE.
 
 RPF2     SA5    BUF         SET LINE ACTIVITY
          MX0    -16         SET IDENTIFIER INDEX MASK
          BX7    X5
          SA6    NMHB
          SA7    CDAC
          READC  A0,CDTX,MXCCL  READ COMPRESSED LINE
          NZ     X1,PLE      IF EOR
          SX7    B6-CDTX     SET WORD COUNT OF LINE
          LX5    -18         EXTRACT IDENTIFIER INDEX
          SA7    CDWC
          BX4    -X0*X5
          SA2    F.TDKI
          SB2    X4
          AX5    18          SET LINE NUMBER
          SA2    X2+B2       SET LINE IDENTIFIER
          SX3    X5
          SA4    F.TNCD
          BX6    X0*X2
          IX7    X6+X3
          SA4    X4+B2       CHECK NEXT LINE FOR MODIFICATION
          SA7    A2          SET LINE COUNTER
          SA7    CDID
          IX6    X3-X4
          NZ     X6,RPF3     IF NO MODIFICATION
          SA2    MA          SET MODIFICATION
          SX6    X2+
          SA6    A2+1
 RPF3     RJ     CPF         CONVERT PROGRAM FILE
          BX1    X1-X1       CLEAR EOR
          EQ     RPFX        RETURN
 RTF      SPACE  4,20
**        RTF - READ LINE FROM TEXT FILE.
*
*         ENTRY  (A5) = TEXT INDEX ADDRESS.
*                (X5) = TEXT INDEX.
*
*         EXIT   (X6) = UPDATED TEXT INDEX.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
 
 
 RTF      SUBR               ENTRY/EXIT
          SA1    T
          SA2    F.TTXT
          NZ     X1,RTF2     IF TEXT FILE WRITTEN
          SB2    X5          FIRST WORD INDEX
          MX4    -12
          SA6    CDID        PRESET (A6)
          SB3    A6-1
          SA1    X2+B2       FIRST WORD
          BX7    X7-X7
 RTF1     LX6    X1          MOVE WORD
          BX2    -X4*X1
          SA6    A6+B1
          SX7    X7+B1       COUNT WORD
          SA1    A1+B1       READ NEXT WORD
          NZ     X2,RTF1     IF NOT ZERO BYTE
          SA7    B3          SET LINE LENGTH
          IX6    X5+X7       ADVANCE TEXT INDEX
          EQ     RTFX        RETURN
 
*         PROCESS DATA ON TEXT FILE.
 
 RTF2     SA1    T+5         CHECK TEXT FILE POSITION
          SA2    T+2
          SX6    TBUF
          MX4    -24
          IX7    X2-X6
          BX4    -X4*X5
          IX6    X4-X1
          MI     X6,RTF4     IF REQUIRED TEXT BEFORE BUFFER
          IX7    X6-X7
          MX3    -12
          PL     X7,RTF4     IF REQUIRED TEXT AFTER BUFFER
          SB7    X2          (B7) = BUFFER LIMIT
          BX7    X7-X7       CLEAR WORD COUNT
          SB6    X6+TBUF     (B6) = STARTING ADDRESS
          SA6    CDID        PRESET (A6)
          SA1    B6          FIRST WORD
          SB3    A6-B1
 RTF3     EQ     B6,B7,RTF4  IF END OF BUFFER REACHED
          LX6    X1          MOVE WORD
          BX2    -X3*X1
          SB6    B6+B1
          SA6    A6+B1
          SX7    X7+B1       COUNT WORD
          SA1    A1+B1       READ NEXT WORD
          NZ     X2,RTF3     IF NOT ZERO BYTE
          SA7    B3          SET LINE LENGTH
          IX6    X5+X7       ADVANCE TEXT INDEX
          EQ     RTFX        RETURN
 
 RTF4     AX4    6           SET RANDOM ADDRESS
          SX6    B1
          IX6    X4+X6
          LX4    6           SET CURRENT TEXT INDEX
          BX7    X4
          SA6    T+6
          SA7    A6-B1
          SX6    TBUF        SET IN = OUT = FIRST
          SA6    T+2
          SA6    A6+B1
          READ   T,R
          EQ     RTF2        RESTART MOVE
 STB      SPACE  4,20
**        STB - SEARCH TABLE FOR ENTRY WITH MASK.
*
*         ENTRY  (A0) = TABLE NUMBER.
*                (X1) = MASK.
*                (X6) = ENTRY TO SEARCH FOR.
*
*         EXIT   (X2) = 0, IF ENTRY NOT FOUND.
*                (X2) .NE. 0, TABLE ENTRY.
*                (A2) = ADDRESS OF TABLE ENTRY.
*                (X3) = INDEX OF TABLE ENTRY.
*
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 2.
 
 
 STB2     SA2    A2-B1       RESTORE ENTRY
          SX3    A2-B3       SET INDEX
 
 STB      SUBR               ENTRY/EXIT
          SA3    FTAB+A0
          SA2    LTAB+A0
          ZR     X2,STBX     IF TABLE EMPTY - RETURN
          SB2    X2
          SB3    X3
          SA2    X3
 STB1     BX3    X6-X2       CHECK ENTRY
          SB2    B2-B1
          BX3    X1*X3
          SA2    A2+B1
          ZR     X3,STB2     IF REQUESTED ENTRY FOUND
          NZ     B2,STB1     IF NOT END OF TABLE
          BX2    X2-X2       IF ENTRY NOT FOUND
          EQ     STBX        RETURN
 UPN      SPACE  4,20
**        UPN - UNPACK NAME.
*
*         ENTRY  (X1) = NAME, LEFT JUSTIFIED ZERO FILL.
*                (B3) = CHARACTER ADDRESS.
*
*         EXIT   (B3) = UPDATED CHARACTER ADDRESS.
*
*         USES   X - 1, 6, 7.
*                A - 7.
*                B - 3.
 
 
 UPN1     BX7    -X6*X1      GET NEXT CHARACTER
          BX1    X6*X1       ERASE CURRENT CHARACTER
          SA7    B3+
          SB3    B3+B1       ADVANCE ADDRESS
          LX1    6
          NZ     X1,UPN1     IF NOT END OF NAME
          SX7    1R          SET TERMINAL BLANK
          SA7    B3+
 
 UPN      SUBR               ENTRY/EXIT
          MX6    -6
          LX1    6
          EQ     UPN1
 WDR      SPACE  4,25
**        WDR - WRITE DIRECTORY TO PROGRAM LIBRARY.
*
*         ENTRY  (A0) = ADDRESS OF FET FOR FILE.
*
*         SET DATE IN IDENT TABLE AND WRITE TO  *NPL*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  WTW=.
 
 
 WDR      SUBR               ENTRY/EXIT
          SA1    A0+
          SA2    L.TNDK
          ZR     X1,WDRX     IF NO NEW PROGRAM LIBRARY - RETURN
          ZR     X2,WDRX     IF NO NEW DECKS - RETURN
          RECALL A0
          SA1    PL          ENTER PROGRAM LIBRARY NAME
          SA2    DATE        ENTER DATE IN IDENT TABLE
          BX6    X1
          LX7    X2
          SA6    TIDT+1
          SA7    A6+B1
          BX7    X7-X7       CLEAR MODIFICATION DATE
          SA7    A7+B1
          WRITEW A0,TIDT,TIDTL
          SA5    L.TNDK      MERGE DECK COUNT AND DIRECTORY ID
          SA2    WDRA
          BX6    X5+X2
          SA6    T1
          WRITEW A0,T1,1
          SA1    F.TNDK      REMOVE FILE NAME POINTERS
          SB2    B1+B1
          SB3    X5
          MX4    24
          SA2    X1+B1
          BX6    -X4*X2
 WDR1     SA6    A2
          SB3    B3-B2
          SA2    A2+B2
          BX6    -X4*X2
          NZ     B3,WDR1     IF NOT COMPLETE
          WRITEW A0,X1,X5    WRITE DECK NAME TABLE
          WRITEF X2,R
          EQ     WDRX        RETURN
 
 WDRA     CON    7000BS48    DIRECTORY ID
 WMT      SPACE  4,20
**        WMT - WRITE MODIFIER TABLE.
*
*         ADD DECK TO NEW DECK NAME TABLE.  WRITE MODIFIER TABLE
*         TO *NPL*.
*
*         USES   ALL.
*
*         CALLS  ADW, WTW=.
 
 
 WMT      SUBR               ENTRY/EXIT
          SA1    MA
          SA2    DN          ENTER DECK NAME IN IDENT TABLE
          SA3    TIDT+3
          ZR     X1,WMT1     IF NO MODIFICATIONS
          SA3    DATE        ENTER NEW DATE
 WMT1     BX6    X2
          LX7    X3
          SA6    TIDT+1
          SA7    TIDT+3
          SA1    CD
          SX3    X1+6
          ADDWRD TNDK,X2+X3  ENTER DECK NAME
          SX1    RI          SET RANDOM INDEX RETURN ADDRESS
          SX2    X1
          LX1    30
          BX6    X1+X2
          SA6    N+6
          SX1    X2+B1
          SX2    X1
          LX1    30
          BX6    X2+X1
          SA6    M+6
          SA1    CD
          SA2    WMTA
          ZR     X1,WMT2     IF NOT COMMON DECK
          SA2    WMTB
 WMT2     SA1    L.TDKI      MERGE MODIFIER COUNT AND MODIFIER TABLE ID
          SX5    X1-1
          BX6    X2+X5
          SA6    T1
          SA2    CSC         GET DISPLAY/ASCII FLAG
          SA1    CNPL        SET CHARACTER SET OF NEW PROGRAM LIBRARY
          LX2    6
          BX6    X1+X2       MERGE DISPLAY/ASCII FLAG
          SA6    TIDT+16B
          SA1    N
          ZR     X1,WMT3     IF NO NEW PROGRAM LIBRARY
          WRITEW N,TIDT,TIDTL WRITE IDENT TABLE
          WRITEW N,T1,1      WRITE MODIFIER ID
          SA1    F.TDKI      WRITE DECK MODIFIERS
          WRITEW X2,X1+B1,X5
          SA1    M
          ZR     X1,WMTX     IF NOT SCRATCH FILE - RETURN
 WMT3     WRITEW M,TIDT,TIDTL WRITE IDENT TABLE
          WRITEW X2,T1,1     WRITE MODIFIER ID
          SA1    F.TDKI      WRITE DECK MODIFIERS
          WRITEW X2,X1+B1,X5
          EQ     WMTX        RETURN
 
 WMTA     CON    7001BS48    MODIFIER TABLE ID FOR DECK
 WMTB     CON    7002BS48    MODIFIER TABLE ID FOR COMMON DECK
 WNF      SPACE  4,25
**        WNF - WRITE LINE TO NEW PROGRAM LIIBRARY.
*
*         ENTRY  (CDAC) = LINE ACTIVITY FLAG.
*                (CDID) = LINE IDENTIFICATION.
*                (CDWC) = WORD COUNT OF COMPRESSED LINE.
*                (CDTX) = FWA OF TEXT OF COMPRESSED LINE.
*                (NMHB) = NUMBER OF MODIFICATION HISTORY BYTES (MHBS).
*                (THMB) = TABLE OF MHBS.
*
*         USES   ALL.
*
*         CALLS  WTW=.
 
 
 WNF      SUBR               ENTRY/EXIT
          SA1    CDAC        ACTIVITY TO BIT 59
          SA5    NMHB        STORE MHB TERMINATORS
          MX3    1
          SA2    A1+B1       WORD COUNT OF LINE TO BITS 54 - 58
          BX6    X6-X6
          BX1    X3*X1
          SA6    TMHB+X5
          LX1    24
          SA3    A2+B1       LINE NUMBER TO BITS 36 - 53
          MX0    -16
          SA6    A6+B1
          LX2    18
          SB3    X5          MHB COUNT
          BX3    -X0*X3
          SA6    A6+B1
          BX1    X1+X2
          SA5    A5+B1       FIRST MHB
          SB2    B1          2 MHB,S ON FIRST PASS
          IX7    X1+X3
          SA7    BUF
 
*         PACK AND WRITE MHB TABLE.
 
 WNF1     LX7    18          PACK MHB-S
          SB3    B3-B1
          BX7    X5+X7
          SB2    B2-B1
          SA5    A5+B1       NEXT MHB
          PL     B2,WNF1     IF NOT AT END OF WORD OF MHB,S
          SA7    A7+B1       STORE WORD
          SB2    B1+B1
          BX7    X7-X7
          PL     B3,WNF1     IF NOT DONE WITH ALL MHB,S
          SX5    A7-BUF
 
*         WRITE MHB TABLE AND COMPRESSED LINE.
 
          SA1    N
          ZR     X1,WNF2     IF NO NEW PROGRAM LIBRARY
          WRITEW N,BUF+1,X5
          SA1    CDWC
          WRITEW X2,CDTX,X1
          SA1    M
          ZR     X1,WNFX     IF NO SCRATCH LIBRARY - RETURN
 WNF2     WRITEW M,BUF+1,X5
          SA1    CDWC
          WRITEW X2,CDTX,X1
          EQ     WNFX        RETURN
 WOF      SPACE  4,20
**        WOF - WRITE OUTPUT FILE.
*
*         ENTRY  (X1) .GT. 0, FWA OF LINE IN *C* FORMAT.
*                (X1) .LT. 0, -(FWA) OF LINE IN *S* FORMAT.
*                (X2) = LENGTH OF LINE IN *S* FORMAT.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*
*         CALLS  CDD.
*
*         MACROS WRITEC, WRITES, WRITEW.
 
 
 WOF      SUBR               ENTRY/EXIT
          SX6    B1+         INDICATE DATA WRITTEN TO OUTPUT FILE
          SA3    LC          ADVANCE LINE COUNT
          SA6    LF
          SX6    X3+B1
          SA6    A3
          SA4    A3+B1
          IX7    X6-X4
          NG     X7,WOF5     IF BOTTOM OF PAGE NOT REACHED
          BX6    X1          SAVE REQUEST
          LX7    X2
          SA6    WOFA
          SA7    A6+B1
          SA1    PN          ADVANCE PAGE NUMBER
          SX7    X1+B1
          SX6    3           RESET LINE COUNT
          SA6    A3
          SA7    A1
          RJ     CDD         CONVERT PAGE NUMBER
          MX1    -12
          LX6    4*6         STORE PAGE NUMBER
          BX6    X1*X6
          SA6    PAGE
          SA1    TO
          SX2    O
          ZR     X1,WOF1     IF TERMINAL OUTPUT
          WRITEW X2,(=1H1),1
          SA1    TL
          WRITEW X2,X1,6
          WRITEW X2,TITL,TITLL
          EQ     WOF2        CONTINUE PROCESSING
 
 WOF1     SA3    PN
          SX3    X3-2
          NZ     X3,WOF2     IF NOT FIRST TIME
          WRITEW X2,TERL,TERLL
          WRITEW X2,(=C*  *),1  WRITE END OF LINE
 WOF2     SA1    WOFB        CHECK IF TIME FOR CONTROL IMAGE
          SX6    B1
          SA6    A1
          SA3    TO
          NZ     X1,WOF4     IF *MODIFY* CONTROL HAS BEEN OUTPUT
          ZR     X3,WOF3     IF TERMINAL OUTPUT
          WRITEW X2,(=1H),1  *MODIFY* CONTROL IMAGE
 WOF3     WRITEW X2,CCDR,8
          WRITEW X2,(=C*  *),1  WRITE END OF LINE
          SA1    LC          SET LINE COUNT FOR EXTRA LINE
          SX6    X1+B1
          SA6    A1
 WOF4     WRITEW X2,SBTL,SBTLL
          SA1    WOFA        RESTORE REQUEST
          SA2    A1+B1
 WOF5     NG     X1,WOF6     IF *S* FORMAT
          WRITEC O,X1
          EQ     WOFX        RETURN
 
 WOF6     BX1    -X1
          WRITEK O,X1,X2
          EQ     WOFX        RETURN
 
 WOFA     CON    0
          CON    0
 WOFB     CON    0           *MODIFY* CONTROL LINE ISSUE FLAG
SSR       SPACE  4,15
**        SSR - SELECT *S* READ FUNCTION.
*
*         SELECT *RDS=* OR *RDA=* DEPENDING ON CHARACTER SET.
*
*         ENTRY  (CSC) = CURRENT CHARACTER SET.
*
*         USES   X - 3.
*                A - 3.
*
*         CALLS  RDA=, RDS=.
 
 
 SSR      SUBR               ENTRY/EXIT
          SA3    CSC         GET CURRENT CHARACTER SET
          NZ     X3,SSR1     IF ASCII
          RJ     =XRDS=      DISPLAY CODE
          EQ     SSRX        RETURN
 
 SSR1     RJ     =XRDA=      6/12 DISPLAY BASED ASCII
          EQ     SSRX        RETURN
SSW       SPACE  4,15
**        SSW - SELECT *S* WRITE FUNCTION.
*
*         SELECT *WTS=* OR *WTA=* DEPENDING ON CHARACTER SET.
*
*         ENTRY  (CSC) = CURRENT CHARACTER SET.
*
*         USES   X - 3.
*                A - 3.
*
*         CALLS  WTA=, WTS=.
 
 
 SSW      SUBR               ENTRY/EXIT
          SA3    CSC         GET CURRENT CHARACTER SET
          NZ     X3,SSW1     IF ASCII
          RJ     =XWTS=      DISPLAY CODE
          EQ     SSWX        RETURN
 
 SSW1     RJ     =XWTA=      6/12 DISPLAY BASED ASCII
          EQ     SSWX        RETURN
          TITLE  LIST SUBROUTINES.
 LCE      SPACE  4,10
**        LCE - LIST COMPILE FILE DIRECTIVE ERROR MESSAGE.
*
*         ENTRY  (A0) = ERROR MESSAGE ADDRESS.
*
*         EXIT   ERROR MESSAGE AND LINE IN ERROR LISTED.
*
*         USES   X - 0, 1.
*                A - 1.
*                B - 3.
*
*         CALLS  ECD, LCS, LER, UPN.
 
 
 LCE      SUBR               ENTRY/EXIT
          SA1    AM          CHECK FOR COMPRESSED COMPILE GENERATION
          ZR     X1,LCE1     IF NOT COMPRESSED COMPILE FILE GENERATION
          RJ     ECD         EXPAND COMPRESSED LINE
 LCE1     SA1    =9L  *ERROR*
          SB3    CHSP
          RJ     UPN         UNPACK ERROR DATA
          RJ     LCS         LIST LINE
          SX0    A0
          RJ     LER         LIST ERROR MESSAGE
          EQ     LCEX        RETURN
 LCS      SPACE  4,15
**        LCS - LIST LINE STATUS.
*
*         USES   X - 0, 1, 2, 3, 6.
*                A - 1, 2, 3, 6.
*                B - 2, 3, 4, 5.
*
*         CALLS  CDD, UPN, WOF.
 
 
 LCS      SUBR               ENTRY/EXIT
          SA1    CL
          NZ     X1,LCSX     IF LINE LISTED - RETURN
          BX6    X6-X6
          SA6    A1+B1       CLEAR LIST REQUEST
          SA1    TMHB
          SA2    SC+1
          MX0    -16
          BX6    -X0*X1
          SB6    CHAR+15+X2
          ZR     X6,LCS1     IF DECK LINE
          SA2    F.TDKI      ADD CURRENT DECK NUMBER
          SA3    X2
          BX1    -X0*X3
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          LX6    4*6
          BX1    X6
          SB3    B6+
          RJ     UPN         UNPACK NAME
          SB6    B3+
 LCS1     PRINT  -CHSP,B6+X1  LIST LINE
          SX6    1R          CLEAR STATUS
          SA6    CHSP+4
          SA6    A6+B1
          SA6    A6+B1
          SA6    CL          SET LINE LISTED
          EQ     LCSX        RETURN
 LDS      SPACE  4,15
**        LDS - LIST DECK STATUS.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  LTB, SFN, WOF.
 
 
 LDS      SUBR               ENTRY/EXIT
          LISTOP D,LDSX      IF NO LIST FOR DECK STATUS - RETURN
          SA1    DN          DECK NAME
          RJ     SFN         SPACE FILL NAME
          SA2    F.TDKI
          LX6    -12
          SX4    X2+B1
          SA6    BUF
          SA3    L.TDKI
          SX0    =C*MODIFIERS.*
          SX5    X3-1
          RJ     LTB         LIST TABLE
          PRINT  (=C*  *)
          EQ     LDSX        RETURN
 LER      SPACE  4,20
**        LER - LIST ERROR MESSAGE.
*
*         ENTRY  (X0) = ERROR MESSAGE ADDRESS.
*                (EA) = ERROR COUNTER ADDRESS TO BE INCREMENTED.
*
*         EXIT   CHSP CLEARED.
*                (EC) = INCREMENTED BY 1.
*
*         USES   ALL.
*
*         CALLS  WTC=, WTW=.
 
 
 LER      SUBR               ENTRY/EXIT
          LISTOP E,LER1      IF NO ERROR LIST
          SA2    O           CHECK FOR OUTPUT FILE
          ZR     X2,LER1     IF NO OUTPUT FILE
          WRITEW O,(=8A******* ),1
          WRITEC X2,X0
          SA2    LC          ADVANCE LINE COUNT
          SX7    X2+B1
          SA7    A2
 LER1     SB2    9           CLEAR CHARACTER SPACING
          SX6    1R
 LER2     SA6    CHSP+B2
          SB2    B2-1
          PL     B2,LER2     IF NOT COMPLETE
          SA1    EA          ADVANCE ERROR COUNT
          SA1    X1
          SX6    X1+B1
          SA6    A1
          EQ     LERX        RETURN
 LST      SPACE  4,20
**        LST - LIST STATISTICS.
*
*         LIST DECKS ON PROGRAM LIBRARY.  LIST DECKS ON *NPL*.
*
*         USES   ALL.
*
*         CALLS  CDD, LTB, WOF.
 
 
 LST      SUBR               ENTRY/EXIT
          LISTOP S,LSTX      IF NO LIST FOR STATISTICS - RETURN
          SX6    =60HSTATISTICS.
          SX7    99999       FORCE PAGE EJECT
          SA6    TL
          SA7    LC
          SA1    =1H         CLEAR FIRST WORD OF BUFFER
          SX7    B1+B1       RESET WORDS/ENTRY
          BX6    X1
          SA6    BUF
          SA7    LTBA
          SA6    SBTL+1      CLEAR SUBTITLE
          SA6    A6+B1
 
*         LIST DECKS ON PROGRAM LIBRARY.
 
          SX0    =C*DECKS ON PROGRAM LIBRARY.*
          SA4    F.TDKN
          SA5    DL
          RJ     LTB         LIST TABLE
 
*         LIST COMMON DECKS ON PROGRAM LIBRARY.
 
          SA1    DL
          SA2    F.TDKN
          BX7    X7-X7       CLEAR DECK IDENTIFIER TABLE
          SA5    X2
          SA7    L.TDKI
          ZR     X1,LST3     IF NO DECKS IN PROGRAM LIBRARY
          SB6    B1+B1
          MX0    -16
          SB7    X1+
 LST1     BX1    -X0*X5
          SB2    X1-7
          NZ     B2,LST2     IF NOT COMMON DECK
          ADDWRD TDKI,X5     ADD DECK
          ADDWRD A0,X6-X6
 LST2     SB7    B7-B6
          SA5    A5+B6
          NZ     B7,LST1     IF NOT END OF DECK NAME TABLE
 LST3     SA4    F.TDKI
          SA5    L.TDKI
          SX0    =C*COMMON DECKS ON PROGRAM LIBRARY.*
          RJ     LTB         LIST TABLE
 
*         LIST INTRODUCED DECKS.
 
          SA1    L.TDKN
          SA2    DL
          IX5    X1-X2
          ZR     X5,LST4     IF NO DECKS INTRODUCED
          SA3    F.TDKN
          IX4    X3+X2
          SX0    =C*DECKS ADDED BY INITIALIZATION DIRECTIVES.*
          RJ     LTB         LIST TABLE
 
*         LIST DECKS ON NEW PROGRAM LIBRARY.
 
 LST4     SA1    N
          ZR     X1,LST5     IF NO NEW PROGRAM LIBRARY
          SX0    =C*DECKS ON NEW PROGRAM LIBRARY.*
          SA4    F.TNDK
          SA5    L.TNDK
          RJ     LTB         LIST TABLE
 
*         REMOVE COMMON DECKS FROM EDIT TABLE.
 
 LST5     SA1    L.TEDT
          SA4    F.TEDT
          SB3    X1
          BX5    X5-X5
          SA2    X4
          SB4    X4
          SA3    C
          ZR     X1,LST8     IF EDIT TABLE EMPTY
          ZR     X3,LST8     IF NO COMPILE FILE
          SB6    B1+B1
          SB2    -B6
 LST6     BX6    X2          STORE DECK NAME
          SA1    A2+B1       CHECK DECK TYPE
          SA3    X1
          BX7    X1
          SB7    X3-OCRT
          SA6    B4+X5
          SA7    A6+B1
          SX5    X5+B6
          NZ     B7,LST7     IF NOT COMMON DECK
          SX5    X5+B2
 LST7     SB3    B3-B6
          SA2    A2+B6
          NZ     B3,LST6     IF NOT END OF EDIT TABLE
 
*         LIST DECKS ON COMPILE FILE.
 
 LST8     SX0    =C*DECKS WRITTEN ON COMPILE FILE.*
          RJ     LTB         LIST TABLE
          PRINT  (=C*  *)
 
*         LIST STORAGE USED AND LINE COUNT.
 
          SA1    FTAB+FTABL  ROUND UP STORAGE USED
          SX7    MTBS+300    MINIMUM CORE REQUIRED
          IX3    X1-X7
          PL     X3,LST9     IF CURRENT USED MORE THAN MINIMUM
          SX1    X7
 LST9     SA2    =1AB
          MX0    -3
          SB3    1R0-1R
          SB2    B0
          SX1    X1+77B      ROUND UP FL USED
          AX1    6
          LX1    6
 LST10    BX7    -X0*X1      CONVERT TO OCTAL DISPLAY
          LX2    -6
          SB2    B2+6
          SX3    X7+B3
          AX1    3
          IX2    X2+X3
          NZ     X1,LST10    IF NOT FINISHED CONVERTING
          LX6    X2,B2
          SA6    LSTA+1
          SA1    NC          LINE COUNT
          SA2    A1+B1
          IX1    X1+X2
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SA6    LSTB
          PRINT  LSTA
          EQ     LSTX        RETURN
 
 LSTA     DATA   10H
          DATA   10H
          DATA   H* STORAGE USED.*
 LSTB     DATA   10H
          DATA   C* LINES WRITTEN ON COMPILE FILE.*
 LTB      SPACE  4,20
**        LTB - LIST TABLE.
*
*         LIST SPECIFIED TABLE ON OUTPUT FILE.
*
*         ENTRY  (X0) = MESSAGE ADDRESS.
*                (X4) = TABLE ADDRESS.
*                (X5) = LENGTH OF TABLE.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - ALL.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  SFN, WOF.
 
 
 LTB      SUBR               ENTRY/EXIT
          SA1    LC          CHECK LINE COUNT
          SA0    X4          (A0) = TABLE ADDRESS
          SA2    A1+B1
          SX6    X1+4
          IX7    X6-X2
          PL     X7,LTB1     IF NOT ROOM FOR FIRST LINE OF TABLE
          PRINT  (=C*  *)
          SA1    LC
          BX6    X1
 LTB1     SA6    A1          UPDATE LINE COUNT
          MX3    -12         COPY MESSAGE TO BUFFER
          SA2    X0
          LX6    X2
          SB2    BUF+1
 LTB2     SA6    B2
          BX7    -X3*X2
          SB2    B2+B1
          SA2    A2+B1
          LX6    X2
          NZ     X7,LTB2     IF NOT END OF MESSAGE
          PRINT  BUF
          SA1    =1H         CLEAR FIRST WORD OF BUFFER
          BX6    X1
          MX0    42
          SA6    BUF
          PRINT  (=C*  *)
          NZ     X5,LTB3     IF TABLE NOT EMPTY
          PRINT  (=C+           * NONE * +)
          EQ     LTBX        RETURN
 
*         LIST SPECIFIED TABLE.
 
 LTB3     SA1    LTBA        SET ENTRY COUNT
          SB2    X1-1
          AX4    X5,B2       COMPUTE NUMBER OF ROWS
          SX3    X4+11
          PX6    X3
          SA2    =12.
          FX4    X6/X2
          UX3    B2,X4
          BX6    X6-X6       CLEAR ENTRY INDEX
          LX0    X3,B2
          PX2    X0          COMPUTE ENTRY INCREMENT (ROWS*ENTRY)
          PX7    X1
          SA6    A1+B1
          DX3    X7*X2
          UX6    X3
          SA6    A6+B1
 LTB4     SX0    X0-1        DECREMENT ROW COUNT
          SA1    LTBA+1      SET ENTRY INDEX
          MI     X0,LTBX     IF ALL ROWS LISTED - RETURN
          SA2    A1-B1       ADVANCE TABLE
          SA3    A1+B1       SET ENTRY INCREMENT
          IX6    X1+X2
          SB3    X1
          SB6    X3
          MX4    42
          SA6    A1
          SB4    X5
          SB5    B0+
 LTB5     SA1    B3+A0       TABLE ENTRY
          BX1    X4*X1
          RJ     SFN         SPACE FILL NAME
          SA1    A1          TABLE ENTRY
          LX1    59-16       CHECK YANK BIT
          PL     X1,LTB6     IF NOT YANKED
          SA2    LTBB        ADD()
          IX6    X6+X2
 LTB6     LX6    -6          STORE NAME
          SA6    BUF+1+B5
          SB5    B5+B1
          SB3    B3+B6
          LT     B3,B4,LTB5  IF NOT AT END OF LINE
          BX6    X6-X6
          SA6    A6+B1
          PRINT  BUF
          MX4    42
          EQ     LTB4        LOOP
 
 LTBA     CON    2           WORDS/ENTRY
          CON    0           TEMPORARY
          CON    0           TEMPORARY
 LTBB     CON    10H       ) (-1H
 LUM      SPACE  4,15
**        LUM - LIST UNPROCESSED MODIFICATIONS.
*
*         ENTRY  (X5) = MODIFICATION TABLE ADDRESS.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3.
*
*         CALLS  LER, PML, SFN, UPN, WOF.
 
 
 LUM      SUBR               ENTRY/EXIT
          SA1    =9L  *ERROR*
          SB3    CHAR
          RJ     UPN         UNPACK NAME
 LUM1     SB3    X5
          ZR     B3,LUMX     IF END OF MODIFICATIONS - RETURN
          SA5    B3
          SA1    A5+B1
          LX6    X5,B1
          MI     X1,LUM2     IF ERROR FLAG SET
          MI     X6,LUM2     IF DELETE
          SA2    A1+B1       CHECK TEXT STATUS
          AX2    24
          SX7    X2
          ZR     X7,LUM1     IF TEXT PROCESSED
 
*         AN ERROR OCCURRED ON MODIFICATION LINE.
 
 LUM2     SX6    X5          SAVE POSITION
          SB2    B1+B1
          SA6    LUMA
          SA2    A5+B2       ENTER IDENTIFIER NAME
          AX2    42
          SA1    X2
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          BX1    X6
          SB3    CHAR+10
          RJ     UPN         UNPACK NAME
          SB2    B1+1
          PL     X5,LUM3     IF NOT INSERT
          SA1    =7LINSERT,
          EQ     LUM4
 
 LUM3     SA1    =7LDELETE,
          LX2    X5,B2
          PL     X2,LUM4     IF DELETE
          SA1    =8LRESTORE,
 LUM4     RJ     UPN         UNPACK MODIFICATION TYPE
          RJ     PML         PREPARE MODIFICATION LIMIT
          SA1    A5
          SA5    A5+B1       CHECK NEXT WORD
          MX2    36
          BX6    X1-X5
          LX2    54
          BX7    X2*X6
          ZR     X7,LUM5     IF SAME IDENTIFICATION
          BX6    X2*X5
          ZR     X6,LUM5     IF LIMIT = 0
          SX6    1R,         ADD COMMA TO PREVIOUS LIMIT
          SA6    B3-B1
          RJ     PML         PREPARE MODIFICATION LIMIT
 LUM5     SX0    B3-CHAR
          PRINT  (=C*  *)
          PRINT  -CHAR,X0
          SA5    A5          EXTRACT ERROR CODE
          SB2    X5
          SA1    LUMB+B2     SET ERROR
          SX0    X1
          RJ     LER         LIST ERROR
          SA5    LUMA        RESTORE POSITION
          EQ     LUM1        LOOP
 
 LUMA     CON    0
 
 LUMB     BSS    0
          LOC    0
          CON    =C*DIRECTIVE NOT REACHED.*
          CON    =C*UNKNOWN MODIFIER.*
          CON    =C*OVERLAPPING MODIFICATION.*
          CON    =C*FIRST SOURCE LINE IS AFTER SECOND SOURCE LINE.*
          LOC    *O
 PML      SPACE  4,15
**        PML - PREPARE MODIFICATION LIMIT.
*
*         ENTRY  (X5) = MODIFICATION LIMIT WORD.
*                (A6) = NEXT BUFFER ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 6, 7.
*                B - 2, 3, 5.
*
*         CALLS  CDD, UPN.
 
 
 PML      SUBR               ENTRY/EXIT
          AX5    18          SET LINE NUMBER
          SX3    X5
          AX5    18
          SA1    X5          SET MODIFIER NAME
          MX0    42
          BX1    X0*X1
          RJ     UPN         UNPACK NAME
          SX6    1R.         ADD PERIOD
          SA6    B3
          SB6    B3+B1
          SX1    X3          CONVERT NUMBER
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SB3    B6
          BX1    X4          LEFT JUSTIFIED NUMBER
          RJ     UPN         UNPACK NUMNER
          EQ     PMLX        RETURN
 BUFFERS  TITLE  COMMON DECKS AND BUFFERS.
**        PROGRAM LIBRARY DIRECTIVE PROCESSOR TABLE.
 
 
          HERE
          DATA   0           END OF TABLE
          SPACE  4
*CALL     COMCDXB
*CALL     COMCCDD
*CALL     COMCSFN
*CALL     COMCMVE
*CALL     COMCRDA
*CALL     COMCRDC
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCWTA
*CALL     COMCWTC
*CALL     COMCWTS
*CALL     COMCWTW
*CALL     COMCCIO
*CALL     COMCSYS
          SPACE  4
**        BUFFERS.
 BUFFERS  SPACE  4
          USE    BUFFERS
 BLOCKS   SPACE  4,10
**        BLOCK STORAGE.
 TITLE    SPACE  4,6
**        TITLE LINE.
 
 
 TITL     DATA   20H MODIFY - VER 1.2
 DATE     CON    1H
 TIME     CON    1H
          CON    4APAGE
 PAGE     CON    1H
 TITLL    EQU    *-TITL
 
**        TERMINAL TITLE LINE.
 
 TERL     DATA   50H MODIFY - VER 1.2
 TERDT    CON    1H
 TERTM    CON    1H
 TERLL    EQU    *-TERL
          SPACE  4,6
**        ALTERNATE TITLE.
 
 
 ALT      DATA   60HDECK STATUS AND MODIFICATIONS.
 
*         *MODIFY* INPUT SUB-HEADER.
 
 TLT      DATA   60HMODIFY INPUT.
 SUB      SPACE  4,6
**        SUB-TITLE LINE.
 
 
 SBTL     DATA   30H
          CON    0
          CON    2L
 SBTLL    EQU    *-SBTL
 IDENT    SPACE  4,6
**        IDENT TABLE.
 
 
 TIDT     VFD    12/7700B,12/TIDTL-1,36/0
          BSSZ   16B
 TIDTL    EQU    *-TIDT
          SPACE  4,6
**        COMPRESSED COMPILE FILE HEADER.
 
 
 CIDT     VFD    12/7700B,12/TIDTL-1,12/0000B,24/0
 OPL      SPACE  4,6
**        OPL FILE NAME TABLE.
 
 
 TOFN     CON    0           INDEX
          BSS    50
 TOFNL    EQU    *-TOFN
 CDAC     SPACE  4,10
**        PROGRAM LIBRARY PROCESSING BUFFERS.
*
*         THE ORDER OF THE FOLLOWING MUST
*         BE MAINTAINED.
 
 
 CDAC     CON    1S59        LINE ACTIVITY
 CDWC     CON    0           WORD COUNT OF COMPRESSED LINE
 CDID     CON    1           CARD  ID
 CDTX     BSS    MXCCL       TEXT OF COMPRESSED LINE
 CVTX     BSS    MXCCL       CONVERSION BUFFER
 
 NMHB     CON    1           NUMBER OF MODIFICATION HISTORY BYTES
 TMHB     CON    1S16        MODIFICATION HISTORY BYTE TABLE
          BSS    199
 CDCT     SPACE  4,10
**        CHARACTER STRING BUFFER.
 
 
 CDCT     DATA   1           LINE COUNT-(MUST PROCEED CHSP)
 CHSP     BSS    0           SPACING FOR LIST
          DUP    10+IWMAX+26,1
          CON    1R
 CHAR     EQU    CHSP+10
 USBB     EQU    CHAR        STRING BUFFER
 BUFFERS  SPACE  4,10
**        BUFFER ALLOCATION.
 
 
 BUF      BSS    0           SCRATCH BUFFER
 PBUF     EQU    BUF+BUFL
 OBUF     EQU    PBUF+PBUFL
 CBUF     EQU    OBUF+OBUFL
 SBUF     EQU    CBUF+CBUFL
 MBUF     EQU    SBUF+SBUFL
 NBUF     EQU    MBUF+MBUFL
 TBUF     EQU    NBUF+NBUFL
 MTBS     EQU    TBUF+TBUFL
 RFL=     EQU    MTBS+MTBSL+4
 
 
          ERRNG  PBUF-USBB-81  STRING BUFFER OVERFLOWS CODE
 IDENT    SPACE  4
          IDENT              TERMINATE BLOCK
          QUAL   DIRECT
 PDC      TITLE  DIRECTIVE LINE PROCESSING.
**        DIRECTIVE LINE PROCESSORS WILL BE OVERLAID AFTER COMPLETION.
 DATA     SPACE  4
**        DATA STORAGE.
 
 
          ORG    PBUF
 CDLS     CON    0           LINE LIST FLAGS
 INSF     CON    0           INSERT FLAG
 AIDT     CON    0           ASSUMED IDENTIFIER NUMBER
 LCAC     CON    0           ADDRESS+1 OF LAST CHARACTER ON  *READS*
 
*         THE ORDER OF THE FOLLOWING MUST BE MAINTAINED.
 
 MDTI     CON    0           MODIFICATION TABLE INDEX
 IDT1     CON    0           FIRST LIMIT IDENTIFICATION
          CON    0
 IDT2     CON    0           SECOND LIMIT IDENTIFICATION
          CON    0
 MDSA     CON    0           MODIFICATION SET NAME ADDRESS
 PDC      SPACE  4,10
***       INPUT RECORD COMMENTS.
*
*         THE FOLLOWING DIRECTIVE IS RECOGNIZED AS A COMMENT IN THE
*         MODIFY INPUT STREAM.
*
*         / CCC-CCC
 PDC      SPACE  4,10
**        PDC - PROCESS DIRECTIVE LINES.
 
 
 PDC10    RJ     IPC         INSERT PREFIX CHARACTER
 
 PDC      SUBR               ENTRY/EXIT
          SA1    ZM          CHECK FOR *Z* MODE ARGUMENT
          NZ     X1,PDC0     IF *Z* ARGUMENT SELECTED
          SA1    I
          ZR     X1,PDC9     IF NO INPUT FILE
          READ   I
 PDC0     BSS    0
          RJ     RDD         READ FIRST DIRECTIVE
          NZ     X1,PDC9     IF EOR
          EQ     PDC2
 
*         PROCESS NEXT DIRECTIVE.
 
 PDC1     RJ     RDD         READ DIRECTIVE
          NZ     X1,PDC8     IF EOR
 PDC2     CARD   COPY
          RJ     CRD         CONDITIONALLY READ DIRECTORY
 PDC3     SA1    PDCB        INCREMENT DIRECTIVE COUNT
          SX7    X1+B1
          SA7    A1
          CARD   COPYPL
          CARD   CREATE
          CARD   CSET
          CARD   DECK
          CARD   DEFINE
          CARD   EDIT
          CARD   IDENT
          CARD   INWIDTH
          CARD   MOVE
          CARD   NOSEQ
          CARD   OPLFILE
          CARD   PREFIX
          CARD   PREFIXC
          CARD   PURDECK
          CARD   SEQ
          CARD   SORSEQ
          CARD   UNYANK
          CARD   UPDATE
          CARD   WIDTH
          CARD   YANK
          CARD   IGNORE
          RMT
          VFD    42/1L/,18/PDC6      LIST COMMENT LINE
          RMT
          SX6    1S"LO.T"
          SA6    CDLS
          CARD   D,DELETE
          CARD   DELETE
          CARD   I,INSERT
          CARD   INSERT
          CARD   MODNAME
          CARD   RESTORE
          SA2    INSF
          NZ     X2,PDC4     IF INSERTING
          NZ     X4,ERR1     IF NOT NULL DIRECTIVE
          SA1    PDCB        DECREMENT DIRECTIVE COUNT
          SX7    X1-1
          SA7    A1
          EQ     PDC6.1      CONTINUE
 
 PDC4     RJ     CCD         COMPRESS LINE
          RJ     WTF         WRITE TEXT FILE
          SA1    F.TMOD      INCREMENT DIRECTIVE COUNT
          SA2    L.TMOD
          SX0    B1+
          IX3    X1+X2
          LX0    24
          SA1    X3-1
          IX6    X1+X0
          SA6    A1
 
*         DIRECTIVE PROCESSORS RETURN HERE TO LIST LINE.
 
 PDC5     SX6    1           SET *CREATE*, *COPYPL* NOT ALLOWED
          SA6    PDCA
 PDC6     RJ     LDC         LIST LINE
 PDC6.1   SA1    DL
          MI     X1,PDC1     IF NO DIRECTORY
 
*         DIRECTIVE PROCESSORS RETURN HERE TO READ NEXT LINE.
 
 PDC7     RJ     RDD         READ NEXT DIRECTIVE
          ZR     X1,PDC3     IF NOT EOR/EOF/EOI
 PDC8     SA1    DE          CHECK FOR DIRECTIVE ERRORS
          SA2    DB
          NZ     X1,PDC8.1   IF ERRORS
          SA1    PDCB        GET DIRECTIVE COUNT
          ZR     X1,PDC9     IF NO DIRECTIVES PROCESSED
          EQ     PDC10       CONTINUE
 
 PDC8.1   NZ     X2,PDC10    IF DEBUG SELECTED
          BX6    X6-X6       CLEAR EDIT TABLE
          SA6    L.TEDT
          RJ     LST         LIST STATISTICS
          SA0    =C* DIRECTIVE ERRORS.*
          EQ     ABT
 
*         PROCESS EMPTY INPUT FILE.
 
 PDC9     SA1    FM
          SA0    =C* NO DIRECTIVES.*
          ZR     X1,ABT      IF NOT *F* MODE
          SA5    P+7         READ *P* FILE DIRECTORY
          RJ     RDR         READ DIRECTORY
          NZ     X0,ABT      IF ERRORS IN OPL
          SA1    L.TDKN      SET ORIGINAL DECK TABLE LENGTH
          BX6    X1
          SA6    DL
          EQ     PDC10       COMPLETE PROCESSING
 
 PDCA     CON    0           *CREATE*,  *COPY*  ALLOWED FLAG
 PDCB     CON    0           DIRECTIVE COUNT
 ERR      SPACE  4
**        ERR - DIRECTIVE ERROR PROCESSORS.
 
 
 ERR      SA6    ERRM        SET ERROR MESSAGE ADDRESS
          EQ     PDC6        EXIT
 
 ERR1     SX6    =C*INCORRECT DIRECTIVE.*
          EQ     ERR
 
 ERR2     SX6    =C*FORMAT ERROR IN DIRECTIVE.*
          EQ     ERR
 
 ERR3     SX6    =C*IDENT NAME PREVIOUSLY REFERENCED.*
          EQ     ERR
 
 ERR4     SX6    =C* INITIALIZATION DIRECTIVE OUT OF ORDER.*
          EQ     ERR         PUT OUT ERROR MESSAGE AND CONTINUE
          SPACE  4,10
***       INITIALIZATION DIRECTIVES.
*
*         THE FOLLOWING DIRECTIVES MUST BE THE FIRST DIRECTIVES
*         OTHER THAN FILE MANIPULATION DIRECTIVES.
*         DECKS INTRODUCED BY THESE DIRECTIVES TAKE PRECEDENCE OVER
*         ANY PREVIOUS DECKS BY THE SAME NAME.
*         THESE PREVIOUS DECKS ARE DENOTED IN THE DIRECTORY LISTS
*         BY BEING ENCLOSED IN PARENS.
 COPY     SPACE  4,10
***       COPY   FNAME,RNAME
*
*         COPY PROGRAM LIBRARY *FNAME* TO OPL FILE FOR RANDOM ACCESS.
*         *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD
*         TO BE COPIED.
 
 
 COPY     SA1    P
          SA2    CPYA
          SX5    P+7         SET PROGRAM LIBRARY NAME
          ZR     X1,ERR1     IF NO PROGRAM LIBRARY NAME
          NZ     X2,CPY1     IF NOT FIRST ENTRY
          EVICT  A1,R
 
 CPY1     SA1    PDCA
          NZ     X1,ERR4     IF *COPY* NOT ALLOWED
          RECALL M
          SA1    X5          SET FILE NAME
          BX6    X1
          SX7    X5          SET FILE NAME ADDRESS
          SA6    X2
          SA7    CPYA
          RJ     SAF         SET ALTERNATE FILE
          SA1    CH          CHECK NEXT CHARACTER
          SX2    B1+B1       SET BINARY FILE
          IX7    X6+X2
          SA3    X1
          BX6    X6-X6
          SA7    A
          SB2    X3-1R,
          NZ     B2,CPY2     IF NO COMMA
          SX7    X1+B1       SKIP COMMA
          SA7    A1
          RJ     ASN         ASSEMBLE RECORD NAME
 CPY2     SA6    CPYB        SET RECORD NAME
          READ   A
          READW  A,BUF,BUFL  READ FIRST PART
          SX6    =C*COPY FILE EMPTY.*
          MI     X1,ERR      IF EOR/EOF/EOI
 
*         READ REMAINDER OF RECORD(S).
 
 CPY3     BX6    X1          SAVE WORD COUNT
          SA6    T1
          SX1    B6          LWA+1 OF DATA READ
          SX2    BUF         SET RECORD TYPE
          RJ     SRT         SET RECORD TYPE
          SB2    X6-ODRT
          NZ     B2,CPY5     IF NOT *OPLD*
 CPY4     READW  A,BUF,BUFL  SKIP DIRECTORY
          ZR     X1,CPY4     IF NOT EOR/EOF/EOI
          EQ     CPY8
 
*         COPY ONE RECORD.
 
 CPY5     SA7    CPYC+1      ENTER DECK NAME IN MESSAGE
          ADDWRD TNDK,X6     ENTER RECORD NAME
          ADDWRD A0,X6-X6
          SX7    A6          SET RANDOM RETURN ADDRESS
          SA7    M+6
          MESSAGE CPYC,1     ISSUE CONSOLE MESSAGE
          SA1    T1          CHECK RECORD LENGTH
          NZ     X1,CPY7     IF SHORT BLOCK
 CPY6     WRITEW M,BUF,BUFL  WRITE RECORD
          READW  A,BUF,BUFL  READ NEXT BLOCK
          ZR     X1,CPY6     IF NOT EOR/EOF/EOI
 CPY7     WRITEW M,BUF,X1-BUF
          WRITER X2
          SA1    CPYB
          ZR     X1,CPY8     IF NO RECORD NAME OPTION
          SA2    CPYC+1      COMPARE NAMES
          BX6    X2-X1
          ZR     X6,CPY9     IF RECORD REACHED
 
*         BEGIN NEXT RECORD.
 
 CPY8     READ   A           BEGIN NEW READ
          RECALL M
          READW  A,BUF,BUFL
          PL     X1,CPY3     IF NOT EOF
          SA2    CPYB
          ZR     X2,CPY9     IF NO RECORD NAME OPTION
          SA3    CPYC+1
          BX7    X2-X3
          ZR     X7,CPY9     IF RECORD REACHED
          SX6    =C*RECORD NOT FOUND.*
          SA6    ERRM
 CPY9     RJ     LDC         LIST DIRECTIVE LINE
          SA2    =10H
          LISTOP C,CPY10     IF NO LIST FOR COPY LINE
          BX6    X2
          SA4    F.TNDK      LIST RECORDS COPIED
          SA5    L.TNDK
          SA6    BUF
          SX0    =C*RECORDS COPIED.*
          RJ     LTB         LIST TABLE
          PRINT  (=C*  *)
 CPY10    SA0    M           WRITE DIRECTORY
          RJ     WDR         WRITE DIRECTORY
          SA5    CPYA        ADD DECKS
          RJ     ADK         ADD DECK
          MESSAGE CCDR,1
          SA1    L.TDKN      SET ORIGINAL DECK TABLE LENGTH
          BX6    X1
          SA6    DL
          EQ     PDC7        EXIT TO READ NEXT LINE
 
 CPYA     CON    0           FILE NAME ADDRESS
 CPYB     CON    0           RECORD NAME IF REQUESTED
 CPYC     CON    10H  COPY /
          CON    0
 COPYPL   SPACE  4,10
***       COPYPL FNAME,DNAME
*
*         COPY PROGRAM LIBRARY *FNAME* TO AN INTERNAL FILE FOR RANDOM
*         ACCESS.
*         *RNAME* IF PRESENT, IS THE NAME OF THE LAST RECORD
*         TO BE COPIED.
 
 
 COPYPL   SX5    A+7         COPY TO SCRATCH FILE
          EQ     CPY1
 CREATE   SPACE  4,10
***       CREATE FNAME
*
*         CREATE DECK(S) FROM SOURCE FILE *FNAME*.
*         DECKS ARE CREATED TO A SCRATCH FILE FOR MODIFICATION USE.
*         IF A DECK DUPLICATES A DECK ON THE PROGRAM LIBRARY, THE
*         NEW DECK IS USED FOR MODIFICATION.
 
 
 CREATE   SA1    PDCA
          NZ     X1,ERR4     IF *CREATE* NOT ALLOWED
          SA1    CVT         DIS-ALLOW CREATE WITH CONVERSION
          SA0    =C*CREATE NOT ALLOWED WITH CONVERSION.*
          NZ     X1,ABT      IF CONVERSION BEING MADE
          RJ     SAF         SET ALTERNATE FILE
          SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SB2    X3-1R       CHECK FOR BLANK TERMINATOR
          NZ     B2,ERR1     IF NOT TERMINATED
          SA6    A           SET CREATION FILE NAME
          READ   A
          READW  A,T1,1
          SA0    =C*CREATION FILE EMPTY.*
          NZ     X1,ABT      IF EOR/EOF/EOI
          RJ     LDC         LIST DIRECTIVE LINE
          SB6    TIDTL-1     CLEAR *77* TABLE
          SX7    B0+
 CRT0     SA7    TIDT+B6
          SB6    B6-1
          GT     B6,B1,CRT0  IF NOT COMPLETE
          SA1    A+7         USE SCRATCH FILE
          SA2    DATE        SET CREATION DATE
          BX6    X1
          LX7    X2
          SA6    M
          BX6    X6-X6
          SA6    N           CLEAR NEW PROGRAM LIBRARY
          SA7    TIDT+2
          RECALL A
          SA1    X2+B1       SET OUT = FIRST
          SX6    X1
          SA6    A1+2
          SA1    IW
          READS  A,CHAR,X1
 
*         BEGIN NEW DECK.
 
 CRT1     SX6    CHAR        SET CHARACTER POINTER
          SA6    CH
          BX7    X7-X7
          SA7    CD          CLEAR COMMON DECK
          SA7    CRTF        CLEAR CHARACTER SET FOUND
          SX7    .DIS        NOMINAL CHARACTER SET IS DISPLAY
          SA7    CSC
          RJ     ASN         ASSEMBLE NAME
          SA0    =C*FORMAT ERROR IN DIRECTIVE.*
          ZR     X6,ABT      IF NAME BLANK OR TOO LONG
          SA6    DN          SET DECK NAME
          SA6    CRTA+1      INSERT NAME IN MESSAGE
          MESSAGE A6-B1,1
 
 CRT1.1   SA1    IW          LOOP LOOKING FOR COMMON/ASCII/DISPLAY
          READK  A,CHAR,X1   READ NEXT LINE
          SX6    B6          LAST CHARACTER ADDRESS
          SA6    LCAC
          SX6    CHAR        SET CHARACTER POINTER
          SA6    CH
          RJ     ASN         ASSEMBLE NAME
          ZR     X6,CRT2     IF BLANK NAME OR TOO LONG
          SA2    CD
          NZ     X2,CRT1.2   IF COMMON DECK HEADER CARD ALREADY FOUND
 
          SA1    =0LCOMMON
          BX2    X6-X1
          SX7    B1
          NZ     X2,CRT1.2   IF NOT A *COMMON* DECK
          SA7    CD          SET COMMON DECK
          EQ     CRT1.1      READ NEXT LINE
 CRT1.2   SA2    CRTF
          NZ     X2,CRT2     IF CHARACTER SET HEADER CARD ALREADY FOUND
          SA6    CSR         INDICATE CHARACTER SET REQUEST
          RJ     RCS         REQUEST CHARACTER SET
          NZ     X6,CRT2     IF THIS LINE NOT CHARACTER SET HEADER
          SX7    B1
          SA7    CRTF        FIRST PASS CHARACTER SET HEADER
          SA1    CD
          ZR     X1,CRT1.1   IF COMMON DECK HEADER NOT FOUND YET
          SA1    IW
          READK  A,CHAR,X1   READ TEXT FOLLOWING HEADER CARDS
          SX6    B6+         SET LAST CHARACTER ADDRESS
          SA6    LCAC
 CRT2     RJ     WMT         WRITE MODIFIER TABLE
 
*         COPY SOURCE TEXT.
 
 CRT3     RJ     CCD         COMPRESS LINE
          RJ     WNF         WRITE NEW PROGRAM LIBRARY
          SA1    CDID        ADVANCE LINE NUMBER
          SX6    X1+B1
          SA6    A1
          SA1    IW
          READK  A,CHAR,X1   READ NEXT LINE
          SX6    B6+         SET LAST CHARACTER ADDRESS
          SA6    LCAC
          ZR     X1,CRT3     IF NO EOR/EOF/EOI
 
*         COMPLETE CURRENT DECK.
 
          WRITER M,R         END CURRENT DECK
          SA1    RI+1        ENTER RANDOM INDEX
          SX2    N+7
          LX2    36
          ADDWRD TNDK,X2+X1
          SX6    B1          RESET LINE COUNTER
          SA6    CDID
          READ   A           BEGIN NEW RECORD
          SA1    IW
          READS  A,CHAR,X1   READ NEXT LINE
          ZR     X1,CRT1     IF NOT EOR/EOF/EOI
 
*         TERMINATE CREATE.
 
          LISTOP C,CRT4      IF NO LIST FOR DIRECTIVE
          SX0    =C*DECKS CREATED.*
          SA4    F.TNDK      LIST DECKS
          SA5    L.TNDK
          SA1    =1H
          BX6    X1
          SA6    BUF
          RJ     LTB         LIST TABLE
          PRINT  (=C*  *)
 CRT4     SA1    N+7         RESTORE NEW PROGRAM LIBRARY FILE
          SX5    A+7         ADD DECKS
          BX7    X1
          SA7    N
          BX6    X6-X6       CLEAR SCRATCH FILE NAME
          SA6    M
          RJ     ADK         ADD DECK
          MESSAGE CCDR,1
          EQ     PDC7        EXIT TO READ NEXT LINE
 
 CRTA     CON    10H CREATE /
          CON    0
 CRTF     CON    0           CHARACTER SET REQUEST FOUND FOR THIS DECK
 CSET     SPACE  4,10
***       CSET   DNAME
*
*         DECLARE THE INITIAL CHARACTER SET FOR READING MODSETS.
*         IF OMITTED, *CSET* DEFAULTS TO *ASCII*.
 
 
 CSET     RJ     ASN         ASSEMBLE NAME OF *CSET*
          MX3    42
          SA1    TCST-1      FWA-1 OF CHARACTER SET TABLE
 CSET1    SA1    A1+B1
          ZR     X1,CSET2    IF UNKNOWN CHARACTER SET
          BX4    X3*X1
          BX7    X6-X4
          NZ     X7,CSET1    IF NO MATCH
          BX7    -X3*X1
          SA7    CSC
          EQ     PDC6        RETURN
 
 CSET2    SX6    =C*CSET - UNKNOWN CHARACTER SET.*
          EQ     ERR         EXIT WITH ERROR MESSAGE
 OPLFILE  SPACE  4,10
***       OPLFILE FNAME,FNAME,...,FNAME
*
*         DECLARE FILE(S) *FNAME* TO BE AN ADDITIONAL PROGRAM LIBRARY
*         FILE(S).
 
 
 OPLFILE  SA1    PDCA
          NZ     X1,ERR4     IF *OPLFILE* NOT ALLOWED
          RJ     SAF         SET ALTERNATE FILE
          SA1    TOFN
          SB2    X1-TOFNL+1
          MI     B2,OFN1     IF ROOM IN FILE NAME TABLE
          SX6    =C*TOO MANY OPL FILES.*
          EQ     ERR
 
 OFN1     SB2    X1+B1       ADD FILE NAME
          SX3    B1+B1
          BX6    X6+X3
          SX7    B2          ADVANCE INDEX
          SA6    A1+B2
          SA7    A1+
          SA5    A1+B2       READ DIRECTORY
          RJ     RDR         READ DIRECTORY
          SX6    A0+
          NZ     X0,ERR      IF ERRORS IN OPL
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R,
          SA6    A1+
          ZR     B2,OPLFILE  IF COMMA LOOP
          EQ     PDC6        EXIT
 DECK     SPACE  4,10
***       MODIFICATION DIRECTIVES.
*
*         MODIFICATION DIRECTIVES WHICH REFER TO ACTUAL LINES ON THE
*         PROGRAM LIBRARY INCLUDE THE IDENTIFICATION OF THE LINE AT
*         WHICH MODIFICATION TAKES PLACE.  THE IDENTIFICATION HAS THE
*         GENERAL FORM *MNAME*.*NUMBER*, WHERE *MNAME* = THE NAME OF
*         THE MODIFIER, AND *NUMBER* IS THE NUMBER OF THE LINE.
*         FOR ORIGINAL LINES IN THE DECK, THE LINE IDENTIFICATION MAY
*         BE SHORTENED TO *NUMBER*.  THE IDENTIFICATION IS REFERRED
*         TO AS *C* OR *CN* IN THE DESCRIPTION OF THE DIRECTIVES.
 DECK     SPACE  4,10
***       DECK   DNAME
*
*         SET DECK NAME FOR MODIFICATION TO *DNAME*
*         THIS DIRECTIVE MUST PRECEED ALL DIRECTIVES WHICH RESULT IN
*         THE MODIFICATION OF A DECK.
 
 
 DECK     RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NAME BLANK OR TOO LONG
          SA1    IG
          ZR     X1,DCK2     IF NO IGNORES
          SEARCH TIGD,X6
          ZR     X2,DCK2     IF DECK IS NOT TO BE IGNORED
          SA6    DCKA+1
          MESSAGE A6-B1,1
          SA1    LO          CHECK LIST OPTIONS
          SA2    CDLS
          BX6    X1*X2
          ZR     X6,DCK0     IF LIST OPTION OFF
          PRINT  (=C* IGNORE THE FOLLOWING DECK*)
          PRINT  (=C*  *)
 DCK0     RJ     LDC         LIST DIRECTIVE LINE
 DCK1     RJ     RDD         READ DIRECTIVE
          NZ     X1,PDC8     IF EOR
          CARD   IDENT
          CARD   EDIT
          CARD   DECK
          SX7    1S"LO.T"
          SA7    CDLS
          RJ     LDC         LIST IGNORED LINES
          EQ     DCK1
 
 DCK2     SX1    6
          SEARCH TDKN,X6+X1,777776B
          NZ     X2,DCK3     IF DECK FOUND
          MX6    0
          SA6    MDTI        CLEAR CURRENT DECK NAME
          SA6    INSF        CLEAR INSERT FLAG
          SX6    =C*UNKNOWN DECK.*
          EQ     ERR
 
 DCK3     SX5    A2          SET DECK ADDRESS
          SEARCH TDKI,X6     SEARCH FOR PREVIOUS ENTRY
          NZ     X2,DCK4     IF FOUND
          ADDWRD A0,X1*X6    ENTER DECK TABLE
 DCK4     BX6    X3          SET EDIT INDEX
          SX7    X5          SET DECK NAME ADDRESS
          SA6    MDTI
          SA7    AIDT
          BX6    X6-X6       CLEAR INSERT
          SA6    INSF
          EQ     PDC5        EXIT
 
 DCKA     DATA   10H IGNORE /
          DATA   0
 DEFINE   SPACE  4,10
***       DEFINE NAME,VALUE
*
*         SET THE VALUE OF *NAME* TO *VALUE*.  IF *VALUE* IS
*         NOT PRESENT A VALUE OF ZERO IS ASSUMED.
*
*         DEFINED NAMES ARE USED IN CONJUNCTION WITH *IF*, *ELSE*,
*         *ENDIF* AND *IFCALL* DIRECTIVES.
*
*         WHEN A SYMBOL IS DEFINED ON THE INPUT STREAM ( NO INSERT IN
*         PROGRESS ) THE INPUT DEFINITION WILL OVERRIDE ANY COMPILE
*         FILE SPECIFICATIONS FOR VALUES OF THE SPECIFIED NAME *NAME*.
 
 
 DEFINE   SA1    INSF        CHECK FOR INSERT IN PROGRESS
          NZ     X1,PDC4     IF INSERT FLAG SET
 
*         PROCESS DEFINE DIRECTIVE.
 
          ZR     X6,ERR2     IF NAME BLANK OR TOO LONG
          RJ     ASN         ASSEMBLE NAME
          SEARCH TDEF,X6     SEARCH FOR NAME
          NZ     X2,DEF1     IF SYMBOL ALREADY EXISTS
          ADDWRD A0,X6       ADD ENTRY TO TABLE
          SA2    A6+         GET ENTRY
 
*         ASSEMBLE VALUE AND DEFINITION.
 
 DEF1     SA5    A2
          SA1    CH          SKIP SEPARATOR
          SX6    X1+B1
          SA6    A1
          RJ     ASD         ASSEMBLE NUMERIC VALUE
          NZ     B2,DEF2     IF FIELD NOT NULL
          SX6    B0+
          SA6    ERRM        CLEAR ERROR FLAG AND USE DEFAULT VALUE
 DEF2     BX3    X7
          AX7    16
          NZ     X7,DEF3     IF VALUE TO LARGE
          MX1    42
          BX5    X1*X5
          MX4    1           SET DEFINED ON INPUT FLAG
          LX4    17-59
          BX6    X4+X3       FLAG + VALUE
          BX6    X5+X6       FLAG + SYMBOL + VALUE
          SA6    A5          SET IN TABLE
          EQ     PDC6        RETURN
 
*         VALUE ERROR.
 
 DEF3     SX6    =C/ VALUE ERROR./
          EQ     ERR
 DELETE   SPACE  4,10
***       DELETE C
*         D      C
*
*         DELETE DIRECTIVE *C* AND INSERT FOLLOWING TEXT.
 DELETE   SPACE  4,10
***       DELETE C1,C2
*         D      C1,C2
*
*         DELETE LINES *C1* THROUGH *C2* AND INSERT FOLLOWING TEXT.
 
 
 DELETE   SX6    2           SET DELETE
 DLT1     SA6    T1
          RJ     AMI         ASSEMBLE FIRST DELETE IDENTIFIER
          SA1    CH          CHECK NEXT CHARACTER
          SA6    IDT1        SET FIRST IDENTIFIER
          SA7    A6+B1
          SA2    X1
          SB7    X2-1R
          ZR     B7,DLT2     IF BLANK
          RJ     AMI         ASSEMBLE SECOND IDENTIFIER
 DLT2     SA6    IDT2        SET SECOND IDENTIFIER
          SA7    A6+1
          SA1    T1          ENTER MODIFICATION TABLE
          RJ     EMT         ENTER MODIFIER TABLE
          SX6    1           SET INSERT FLAG
          SA6    INSF
          EQ     PDC5        EXIT
 EDIT     SPACE  4,10
***       EDIT   D1
*         EDIT   D1,D2,...DN
*         EDIT   D1.DN
*
*         REQUEST EDITING OF DECK(S) D1 - DN.
 
 
 EDIT     RJ     ASN         ASSEMBLE NAME
          SB7    B0          1 ENTRY
          SA1    IG
          ZR     X1,EDI1     IF NO IGNORES
          SEARCH TIGD,X6
          NZ     X2,EDI5     IF DECK IS TO BE IGNORED
 EDI1     SX3    6           SEARCH FOR DECK
          SEARCH TDKN,X6+X3,377776B
          ZR     X6,ERR2     IF BLANK NAME - FORMAT ERROR
          ZR     X2,EDI6     IF NOT FOUND
          SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SB2    X3-1R.
          SA5    A2+
          NZ     B2,EDI3     IF NOT PERIOD
          SX7    X1+B1       SKIP PERIOD
          SA7    A1
          RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NAME BLANK OR TOO LONG
          SA1    IG
          ZR     X1,EDI2     IF NO IGNORES
          SEARCH TIGD,X6
          NZ     X2,ERR2     IF DECK IS TO BE IGNORED - *D1.DN* ILLEGAL
 EDI2     SX3    6           SEARCH FOR DECK
          SEARCH TDKN,X6+X3,377776B
          ZR     X6,ERR2     IF NAME BLANK OR TOO LONG
          ZR     X2,EDI6     IF NOT FOUND
          SB6    A5          SET NUMBER OF ENTRIES
          SB7    A2-B6
          SX6    =C/NAMES SEPARATED BY *.* IN WRONG ORDER./
          MI     B7,ERR      IF FIRST NAME AFTER SECOND
 EDI3     BX6    X5          CHECK DECK STATUS
          LX6    59-16
          MI     X6,EDI4     IF IGNORE BIT SET
          SEARCH TEDT,X5     SEARCH FOR PREVIOUS ENTRY
          NZ     X2,EDI4     IF FOUND
          ADDWRD A0,X1*X5    ENTER DECK IN EDIT TABLE
          SX1    A5
          ADDWRD A0,X1
 EDI4     SB7    B7-2
          SA5    A5+2
          PL     B7,EDI3     IF NOT AT END OF REQUESTED DECKS
 
 EDI5     SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R
          ZR     B2,PDC5     IF BLANK - RETURN
          NE     B2,B1,ERR2  IF NOT COMMA - FORMAT ERROR
          SA6    A1          SKIP COMMA
          EQ     EDIT        LOOP
 
 EDI6     SA1    EDTA+1      SET NAME IN MESSAGE
          MX2    30
          BX1    X2*X1
          LX6    30
          BX3    -X2*X6
          IX7    X1+X3
          MX2    12
          BX6    X2*X6
          SA7    A1
          SA6    A1+1
          SX6    EDTA        SET MESSAGE ADDRESS
          EQ     ERR
 
 EDTA     DATA   30HUNKNOWN DECK -
 IDENT    SPACE  4,10
***       IDENT  MNAME
*
*         BEGIN MODIFICATION SET WITH MODIFIER *MNAME*.
 
 
 IDENT    RJ     ASN         ASSEMBLE NAME
          SX2    1S13        SEARCH FOR IDENTIFIER NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SEARCH TNME,X6     DONT ALLOW DUPLICATE IDENT LINES
          NZ     X2,ERR3     IF MOD REFERENCED BEFORE IDENT LINE
          ADDWRD A0,X6       ADD IDENTIFIER
          ADDWRD A0,X6-X6
          SA2    A6-B1
          SX7    A2
          SA1    A2          RESTORE NAME
          SA7    MDSA
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SA1    =10H-IDENT-
          BX7    X1
          SA6    SBTL+2
          SA7    A6-B1
          BX6    X6-X6       CLEAR INSERT
          SA6    INSF
          LISTOP T,IDN1      IF INPUT TEXT NOT SELECTED
          SX7    99999       FORCE PAGE EJECT
          SA7    LC
          SX6    B1+
          SA6    CDCT        RESTART INPUT SEQUENCING
          EQ     PDC5        EXIT
 
 IDN1     LISTOP C,PDC5      IF DIRECTIVE LIST NOT SELECTED
          PRINT  (=C*  *)
          PRINT  (=C*  *)
          EQ     PDC5
 INSERT   SPACE  4,10
***       INSERT C
*         I      C
*
*         INSERT FOLLOWING LINES AFTER *C*.
 
 
 INSERT   RJ     AMI         ASSEMBLE INSERT IDENTIFIER
          SA6    IDT1        SET FIRST LIMIT
          SA7    A6+B1
          BX6    X6-X6
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SB7    X2-1R
          NZ     B7,ERR2     IF NOT BLANK - FORMAT ERROR
          SA6    A7+B1       CLEAR SECOND LIMIT
          SA6    A6+B1
          SX1    4           ENTER INSERT INTO MODIFICATION TABLE
          RJ     EMT         ENTER MODIFIER TABLE
          SX6    1           SET INSERT FLAG
          SA6    INSF
          EQ     PDC5        EXIT
 INWIDTH  SPACE  4,10
***       INWIDTH N
*
*         SET THE WIDTH OF THE INPUT LINES TO N.
 
 
 INWIDTH  RJ     ASD         ASSEMBLE COLUMN NUMBER
          SB2    X7-IWMACS-1
          MI     B2,INW2     IF IN RANGE
 INW1     SX6    =C*COLUMN OUT OF RANGE.*
          EQ     ERR
 
 INW2     SA7    IW
          SX6    1R          CLEAR INPUT BUFFER
          SB2    CHAR+X7
          SB3    CHAR+IWMAX
 INW3     EQ     B2,B3,PDC6  IF COMPLETE
          SA6    B2
          SB2    B2+B1
          EQ     INW3        LOOP FOR REMAINDER OF BUFFER
 MODNAME  SPACE  4,10
***       MODNAME MNAME
*
*         SET ASSUMED MODIFIER NAME TO *MNAME*.
*         NOTE - IF THIS DIRECTIVE IS USED, THE DECK NAME MUST BE
*         RESET BY ANOTHER -MODNAME- DIRECTIVE.
 
 
 MODNAME  RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SEARCH TNME,X6     SEARCH FOR NAME
          NZ     X2,MNM1     IF FOUND
          ADDWRD A0,X6       ADD NEW NAME
          SA2    A6
 MNM1     SX6    A2          SET ASSUMED IDENTIFIER ADDRESS
          SA6    AIDT
          EQ     PDC5        EXIT
 MOVE     SPACE  4,10
***       MOVE   D1,D2
*         MOVE   D1,D2,...,DN
*
*         MOVE DECK D2 TO BE AFTER DECK D1.
 
 
 MOVE     RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF BLANK NAME - FORMAT ERROR
          SX3    6           SEARCH FOR DECK
          SEARCH TDKN,X6+X3,377776B
          ZR     X2,EDI6     IF NOT FOUND
          SA1    CH          CHECK NEXT CHARACTER
          SX5    X3
          SA3    X1
          SB2    X3-1R,
          NZ     B2,ERR2     IF NOT COMMA
          SX7    X1+B1       SKIP COMMA
          SA7    A1
 
 MVE1     RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF BLANK NAME - FORMAT ERROR
          SX3    6           SEARCH FOR DECK
          SEARCH TDKN,X6+X3,377776B
          ZR     X2,EDI6     IF NOT FOUND
          LX5    18
          BX1    X5+X3
          SX5    X3+
          ADDWRD TMVE,X1     ENTER IN MOVE TABLE
          SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SX7    X1+B1
          SB2    X3-1R
          ZR     B2,PDC5     IF BLANK - RETURN
          NE     B2,B1,ERR2  IF NOT COMMA - FORMAT ERROR
          SA7    A1          SKIP COMMA
          EQ     MVE1        LOOP
 NOSEQ    SPACE  4,10
***       NOSEQ
*
*         REQUEST NO SEQUENCE NUMBERS ON COMPILE FILE.
 
 
 NOSEQ    SX6    B1+         SET NO SEQUENCE NUMBERS FLAG
          SA1    INSF
          NZ     X1,PDC4     IF INSERT FLAG
          SA6    NS
          EQ     PDC6        EXIT
 PREFIX   SPACE  4,10
***       PREFIX C
*
*         SET DIRECTIVE PREFIX = *C*.  C MAY BE ANY 6 BIT DISPLAY
*         CODE CHARACTER.
 
 
 PREFIX   SA1    CH
          SA2    X1+
          SB7    X2-1R
          ZR     B7,ERR2     IF CHARACTER IS BLANK
          MX3    -6
          BX6    -X3*X2      USE 6 BIT CHARACTER ONLY
          SA6    PC
          EQ     PDC6        EXIT
 PREFIXC  SPACE  4,10
***       PREFIXC C
*
*         SET COMPILE FILE DIRECTIVE PREFIX = *C*.  C MAY BE ANY 6
*         BIT DISPLAY CODE CHARACTER.
 
 
 PREFIXC  SA1    CH          CHECK NEW PREFIX CHARACTER
          SA2    X1
          SB7    X2-1R
          ZR     B7,ERR2     IF CHARACTER IS BLANK
          MX3    -6
          BX6    -X3*X2      USE 6 BIT CHARACTER ONLY
          SA6    PCC
          EQ     PDC6        EXIT
 PURDECK  SPACE  4,10
***       PURDECK D1
*         PURDECK D1,D2,...,DN
*         PURDECK D1.DN
*
*         REQUEST PURGE OF DECK(S) D1 - DN.
 
 
 PURDECK  RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SX3    6           SEARCH FOR DECK NAME
          SEARCH TDKN,X6+X3,377776B
          ZR     X2,EDI6     IF NOT FOUND
          MX1    1
          ADDWRD TMVE,X1+X3  ENTER IN MOVE TABLE
          SA5    A6
          SA1    CH          CHECK NEXT CHARACTER
          SA3    X1
          SX7    X1+1
          SB2    X3-1R
          ZR     B2,PDC5     IF BLANK - RETURN
          NE     B2,B1,PUR1  IF NOT COMMA
          SA7    A1          SKIP COMMA
          EQ     PURDECK     LOOP
 
 PUR1     SB2    X3-1R.
          NZ     B2,ERR2     FORMAT ERROR IF NOT PERIOD
          SA7    A1
          RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SX3    6
          SEARCH TDKN,X6+X3,377776B
          ZR     X2,EDI6     IF NOT FOUND
          LX3    18
          IX6    X5+X3
          SA6    A5
          JP     PDC5
 RESTORE  SPACE  4,10
***       RESTORE C
*
*         RESTORE DIRECTIVE *C*, AND INSERT FOLLOWING TEXT.
 RESTORE  SPACE  4,10
***       RESTORE C1,C2
*
*         RESTORE LINES *C1* THROUGH *C2*, AND INSERT FOLLOWING TEXT.
 
 
 RESTORE  SX6    3           SET RESTORE
          EQ     DLT1        PROCESS AS DELETE
 SEQ      SPACE  4,10
***       SEQ.
*
*         REQUEST SEQUENCE NUMBERS ON COMPILE FILE.
 
 
 SEQ      SX6    B0+         SET SEQUENCE NUMBERS FLAG
          SA1    INSF
          NZ     X1,PDC4     IF INSERT FLAG
          SA6    NS
          EQ     PDC6        EXIT
 SORSEQ   SPACE  4,10
***       SORSEQ
*
*         REQUEST SEQUENCE NUMBERS ON SOURCE FILE.
 
 
 SORSEQ   BSS    0           ENTRY
          SX6    B1+         SET SEQUENCE NUMBERS FLAG
          SA6    SS
          EQ     PDC6        EXIT
 UNYANK   SPACE  4,10
***       UNYANK MNAME
*
*         REMOVE A PREVIOUS YANK ON MODIFIER *MNAME*.
 UNYANK   SPACE  4,10
***       UNYANK MNAME,*
*
*         REMOVE PREVIOUS YANKS ON ALL MODIFIERS FROM *MNAME* ON.
 
 
 UNYANK   RJ     ASN         ASSEMBLE IDENT NAME
          ZR     X6,ERR2     IF NAME BLANK OR TOO LONG
          SX7    1S15        SET UNYANK STATUS
          BX6    X6+X7
          EQ     YNK1        PROCESS YANK
 UPDATE   SPACE  4,10
***       UPDATE
*
*         PROPAGATE LINE COUNTS FOR IDENTS BETWEEN DECKS.
*         WHEN THIS OPTION IS USED, THE ORDER OF EDITING IS DETERMINED
*         BY THE ORDER OF THE PROGRAM LIBRARY, AND INSERTION TEXT
*         NUMBERS WILL BE THE SAME AS THOSE PRODUCED BY *UPDATE*.
 
 
 UPDATE   SX6    B1          SET -UPDATE- FLAG
          SA6    UP
          EQ     PDC6        EXIT
 WIDTH    SPACE  4,10
***       WIDTH  N
*
*         SET LINE WIDTH BEFORE SEQUENCE NUMBERS = *N*.
 
 
 WIDTH    RJ     ASD         ASSEMBLE COLUMN NUMBER
          SB2    X7-IWMACS-1
          PL     B2,INW1     IF OUT OF RANGE
          SA1    INSF
          NZ     X1,PDC4     IF INSERT FLAG
          SA7    SC          SET SEQUENCE NUMBER COLUMN
          EQ     PDC6        EXIT
 YANK     SPACE  4,10
***       YANK   MNAME
*
*         REMOVE EFFECTS OF MODIFIER *MNAME*.
 YANK     SPACE  4,10
***       YANK   MNAME,*
*
*         REMOVE EFFECTS OF MODIFIERS FROM *MNAME* ON.
*         ANY MODIFIERS WHICH HAVE BEEN YANKED ARE DENOTED IN THE
*         MODIFIER LIST BY ENCLOSING PARENS.
 
 
 YANK     RJ     ASN         ASSEMBLE IDENT NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SX7    3S15        SET YANK BIT
          BX6    X6+X7
 YNK1     SX3    6           SEARCH FOR DECK NAME
          SEARCH TDKN,X6+X3,777776B
          NZ     X2,ERR1     IF INCORRECT DIRECTIVE FOUND
          SX2    1S15        SEARCH FOR YANK NAME
          SEARCH TNME,X6+X2,X2
          ZR     X2,YNK2     IF NOT FOUND
          MX4    -15         ENTER NEW STATUS
          BX2    -X4*X2
          BX6    X6+X2
          SA6    A2
          EQ     YNK3
 
*         PROCESS ALL PARAMETERS.
 
 YNK2     ADDWRD A0,X6       ENTER NEW YANK NAME
 YNK3     SA1    CH          CHECK NEXT CHARACTER
          SX7    B1          SET YANK FLAG
          SA2    X1
          SX7    X1+1
          SA7    YK
          SB2    X2-1R,
          NZ     B2,PDC5     IF NOT COMMA - RETURN
          SA2    X7          CHECK NEXT CHARACTER
          SX3    B1
          SB2    X2-1R*
          NZ     B2,ERR1     IF NOT ASTERISK
          BX6    X3+X6       SET ALL AFTER FLAG
          SA6    A6
          EQ     PDC5        EXIT
 IGNORE   SPACE  4,10
***       IGNORE D1
*         IGNORE D1,D2,...,DN
*
*         CAUSES ANY FURTHER MODIFICATION DIRECTIVES TO THE DESIGNATED
*         DECK(S) TO BE IGNORED.
 
 
 IGNORE   RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SEARCH TIGD,X6
          NZ     X2,IGN1     IF FOUND - IGNORE DUPLICATED IGNORES
          ADDWRD A0,X6       ENTER DECK NAME
 IGN1     SA1    CH          CHECK NEXT CHARACTER
          SX7    B1          IGNORE FLAG
          SA2    X1
          SX7    X1+1
          SA7    IG          SET IGNORE FLAG
          SB2    X2-1R
          ZR     B2,PDC5     IF  BLANK  - RETURN
          NE     B2,B1,ERR2  IF NOT COMMA
          SA7    A1+
          EQ     IGNORE
 ADK      TITLE  DIRECTIVE PROCESSING SUBROUTINES.
 ADK      SPACE  4,20
**        ADK - ADD FROM NEW DECK TABLE TO DECK TABLE.
*
*         ENTRY  (X5) - FILE NAME ADDRESS.
*
*         EXIT   TNDK - CLEARED.
*
*         USES   ALL.
*
*         CALLS  ADW, STB.
 
 
 ADK      SUBR               ENTRY/EXIT
          SA1    L.TNDK
          ZR     X1,ADKX     IF NO NEW DECKS - RETURN
          ALLOC  TDKN,X1,S   ALLOCATE TABLE SLACK FOR LARGE BLOCK
          SA1    L.TNDK
          SB4    B0          PREPARE TO ADD NEW DECKS
          SB5    X1
          SX6    X5          SET FILE NAME ADDRESS
          MX0    24
          SB6    2
          SA6    T1
 ADK1     SA1    F.TNDK      CHECK FOR PREVIOUS DECK
          SA5    X1+B4
          SB2    X5-OPRT
          ZR     B2,ADK2     IF TYPE = OPL
          NE     B2,B1,ADK6  IF TYPE .NE. OPLC
 ADK2     SEARCH TDKN,X5,377777B
          ZR     X2,ADK3     IF NOT FOUND
          SX1    1S16        SET IGNORE BIT
          BX6    X2+X1
          SA6    A2
 ADK3     SA1    FM
          ZR     X1,ADK5     IF NOT -F- MODE
          SEARCH TEDT,X5     LOOK UP EDIT ENTRY
          NZ     X2,ADK4     IF FOUND
          ADDWRD A0,X1*X5    ADD ENTRY
          ADDWRD A0,X6-X6
          SA2    A6-B1
 ADK4     SA1    F.TDKN      SET NEW DECK ADDRESS
          SA3    L.TDKN
          IX6    X1+X3
          SA0    TDKN
          SA6    A2+B1
 ADK5     ADDWRD A0,X5       ADD NEW DECK
          SB2    B4+B1       REPLACE FILE NAME ADDRESS
          SA1    F.TNDK
          SA5    X1+B2
          SA2    T1
          BX5    -X0*X5
          LX2    36
          IX1    X2+X5
          ADDWRD A0,X1
 ADK6     SB5    B5-B6       ADVANCE TABLE
          SB4    B4+B6
          NZ     B5,ADK1     IF NOT END OF NEW DECKS
          SA1    F.TNME      SET ASSUMED IDENTIFIER ADDRESS
          BX6    X6-X6       CLEAR NEW DECK NAME TABLE
          LX7    X1
          SA6    L.TNDK
          SA7    MDSA
          EQ     ADKX        RETURN
 AMI      SPACE  4,20
**        AMI - ASSEMBLE MODIFICATION IDENTIFICATION.
*
*         EXIT   (X6) - LINE NAME.
*                (X7) - LINE NUMBER.
*
*         USES   ALL.
*
*         CALLS  ADW, ASD, ASN, STB.
 
 
 AMI      SUBR               ENTRY/EXIT
          SA1    MDTI
          ZR     X1,ERR1     IF NO DECK DIRECTIVE - INCORRECT DIRECTIVE
          SA5    CH          SAVE CURRENT CHARACTER POINTER
          RJ     ASN         ASSEMBLE IDENTIFIER NAME
          SA1    A5          CHECK NEXT CHARACTER
          SA4    AIDT        GET ASSUMED IDENTIFIER
          SA2    X1
          SB2    X2-1R.
          ZR     B2,AMI1     IF PERIOD
          NZ     X4,AMI2     IF ASSUMED IDENTIFIER PRESENT
          EQ     ERR1        INCORRECT DIRECTIVE
 
 AMI1     SX5    X1+B1       SKIP PERIOD
          SEARCH TNME,X6     SEARCH FOR IDENTIFIER
          SX4    A2
          NZ     X2,AMI2     IF FOUND
          ADDWRD A0,X6       ENTER IDENTIFIER
          SX4    A6+         SET ADDRESS
 AMI2     SX6    X5          SET CHARACTER POSITION
          SA6    A5
          RJ     ASD         ASSEMBLE NUMBER
          SA1    A5+         CHECK NEXT CHARACTER
          SX6    X4          SET ADDRESS
          SA2    X1
          SB2    X2-1R
          ZR     B2,AMIX     IF NOT BLANK - RETURN
          NE     B2,B1,ERR1  IF NOT COMMA
          SX6    X1+B1       SKIP COMMA
          SA6    A1
          SX6    X4          RESET ADDRESS
          EQ     AMIX        RETURN
 CCC      SPACE  4,10
**        CCC - COMPRESS CONVERTED LINE.
*
*         ENTRY  (B7) = LAST CHARACTER +1 OF CONVERTED LINE.
*
*         CALLS  CCD.
 
 
 CCC1     RJ     CCD         COMPRESS LINE
 
 CCC      SUBR               ENTRY/EXIT
          SX7    B7-1
          SA7    LCAC        STORE END OF LINE POSITION
          EQ     CCC1        COMPRESS LINE
 CCD      SPACE  4,15
**        CCD - COMPRESS LINE.
*
*         ENTRY  (CHAR) - CHARACTER STRING OF LINE.
*
*         EXIT   (CDTX) - COMPRESSED LINE.
*                (CDWC) - WORD COUNT OF COMPRESSED LINE.
*
*         USES   ALL.
 
 
*         PROCESS END OF LINE.
 
 CCD8     LX6    X6,B6       SHIFT UP LAST WORD
          MX3    -12
          SA6    A6+1
          BX4    -X3*X6
          SB2    A1+
          BX6    X6-X6
          ZR     X4,CCD9     IF LINE TERMINATED
          SA6    A6+1        TERMINATE LINE
 CCD9     SX7    A6-B2       SET WORD COUNT
          SA7    A1-B1
          SX6    A0          SET 64 CHARACTER INDICATOR
          SA6    PCSE
 
 CCD      SUBR               ENTRY/EXIT
          SA0    B0          INITIALIZE 64 CHARACTER INDICATOR
          SX0    2074B       (X0) = CONSTANT 60 FOR UNPACK
          SB4    100B
          SB3    -B1
          SA1    CDID        PRESET (A6)
          LX0    48
          SA5    CHAR        FIRST CHARACTER
          SB7    B4+B1
          BX6    X1
          SA6    A1
          SB2    6
          UX6,B6 X0          RESET REGISTERS
          SA2    LCAC        SET LAST CHARACTER POSITION
          SB5    -B1
          BX1    -X2
          SX7    1R
          EQ     CCD6        ENTER TO PROCESS FIRST CHARACTER
 
 CCD1     SB5    B5+1
 CCD2     LX6    6           00 CHARACTER
          SB6    B6-B2
          SX4    B4-B1       COMPRESSION = 77B
          SB3    B5-B7
          NZ     B6,CCD3     IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 CCD3     PL     B3,CCD4     IF .GT. 64 BLANKS
          SX4    B5-B1       COMPRESSION = COUNT - 1
          SB3    -B1
 CCD4     NZ     X4,CCD5     IF CHARACTER IS NOT  *00*
          LX6    6           INSERT *00*
          SA0    B1          64 CHARACTER SET CHARACTER ENCOUNTERED
          SB6    B6-B2
          SX4    B1          SET *01*
          NZ     B6,CCD5     IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 CCD5     BX3    X4          SAVE CHARACTER
          AX4    6           CHECK FOR ESCAPE CODE
          ZR     X4,CCD5.1   IF NO ESCAPE CODE
          LX6    6           SHIFT ASSEMBLY
          SB6    B6-B2
          BX6    X6+X4       MERGE NEW CHARACTER
          SB5    B3
          NZ     B6,CCD5.1   IF NOT END OF WORD
          SA6    A6+B1
          UX6,B6 X0          RESET REGISTERS
 CCD5.1   MX4    -6
          BX4    -X4*X3      CLEAN OFF ESCAPE CODE
          LX6    6           SHIFT ASSEMBLY
          SB6    B6-B2
          BX6    X6+X4       MERGE NEW CHARACTER
          SB5    B3
          NZ     B6,CCD6     IF NOT END OF WORD
          SA6    A6+B1
          UX6    B6,X0
 CCD6     IX3    X5-X7       CHECK CHARACTER
          BX4    X5
          SB5    B5+B1       COUNT BLANK
          SB3    X1          -( LWA + 1 ) OF STRING BUFFER
          SB3    B3+A5       CHECK FOR END OF LINE
          SA5    A5+B1       NEXT CHARACTER
          ZR     B3,CCD8     IF END OF LINE
          ZR     X3,CCD6     IF BLANK
          SB3    -1
          ZR     B5,CCD4     IF NO BLANKS
          BX4    X7
          SA5    A5-B1       BACKSPACE
          EQ     B5,B1,CCD4  IF 1 BLANK
          SB5    B5-1
          NE     B5,B1,CCD1  IF NOT 2 BLANKS
          SA5    A5-1        BACKSPACE
          EQ     CCD4
 EMT      SPACE  4,20
**        EMT - ENTER MODIFICATION TABLE.
*
*         ENTRY  (X1) - MODIFICATION REQUEST.
*                   4 = INSERT.
*                   3 = RESTORE.
*                   2 = DELETE.
*                (MDTI) - EDIT TABLE INDEX.
*                (MDSA) - ADDRESS OF MODIFICATION SET NAME.
*                (IDT1 - IDT1+1) - FIRST MODIFICATION LIMIT.
*                (IDT2 - IDT2+1) - SECOND MODIFICATION LIMIT.
*
*         CALLS  ADW.
 
 
 EMT      SUBR               ENTRY/EXIT
 
*         ENTER FIRST WORD
 
          SA2    MDTI        EDIT INDEX TO BITS 00 - 17
          LX1    57          MODIFICATION TO BITS 57 - 59
          SA3    A2+B1       MODIFIER NAME POINTER TO BITS 36 - 53
          IX1    X1+X2
          SA4    A3+B1       LINE NUMBER TO BITS 18 - 35
          LX3    18
          IX6    X3+X4
          LX6    18
          BX1    X1+X6
          ADDWRD TMOD,X1
 
*         ENTER SECOND WORD.
 
          SA2    IDT2        MODIFIER NAME POINTER TO BITS 36 - 53
          LX2    18
          SA3    A2+B1       LINE NUMBER TO BITS 18 - 35
          BX1    X2+X3
          LX1    18
          ADDWRD A0,X1
 
*         ENTER THIRD WORD
 
          SA2    MDSA        MODIFICATION SET ADDRESS TO BITS 42 - 59
          SA1    T+5         TEXT ADDRESS TO BITS 00 - 24
          LX2    42
          IX1    X2+X1
          ADDWRD A0,X1
          EQ     EMTX        RETURN
 IMP      SPACE  4,15
**        IMP - INITIALIZE MODIFICATION PROCESSING.
*
*         LINK MODIFICATION TABLE BY DECKS.  ENTER MODIFICATION TABLE
*         LINKAGE IN EDIT TABLE.  RESET FETS.
*
*         USES   ALL.
 
 
 IMP      SUBR               ENTRY/EXIT
          SA1    PCC         COMPILE PREFIX CHARACTER
          BX6    X1
          SA6    PC
          SA1    =10H   DECK -
          SX6    ALT         SET ALTERNATE TITLE LINE
          SX7    99999       FORCE PAGE EJECT
          SA6    TL
          SA7    LC
          BX6    X1
          SX7    B1          WORDS/ENTRY = 1
          SA6    SBTL+1
          SA7    LTBA
 
*         LINK MODIFICATION TABLE BY DECKS.
 
          SA1    L.TMOD      INITIALIZE REGISTERS
          SA2    F.TMOD
          SB2    X1
          MX0    42
          ZR     B2,IMP2     IF MODIFICATION TABLE EMPTY
          SA3    F.TDKI
          SB3    3
          SB4    X3
          SB2    B2-B3
          SA2    X2+B2       GET MODIFICATION TABLE ENTRY
          BX5    X0*X2       REMOVE DECK LINKAGE
 IMP1     SA1    B4+X2       GET DECK TABLE ENTRY
          SX3    A2          SET NEW DECK TO MOD LINK
          BX4    X0*X1       REMOVE PREVIOUS LINK FROM DECK ENTRY
          SB2    B2-B3
          SA2    A2-B3       DECREMENT TO NEXT MODIFICATION
          BX7    -X0*X1
          IX6    X4+X3       RESTORE EDIT ENTRY
          BX7    X5+X7
          SA6    A1+
          SA7    A2+B3       STORE LINKED MODIFICATION
          BX5    X0*X2       REMOVE EDIT LINKAGE
          PL     B2,IMP1     IF NOT AT END OF TABLE
 
*         ENTER MODIFICATION TABLE LINKAGE IN EDIT TABLE.
 
 IMP2     SA3    UM
          NZ     X3,IMP7     IF *U* MODE
          SA1    L.TDKI
          SA2    F.TDKI
          SB5    X1
          SA5    X2
          ZR     B5,IMP5     IF DECK TABLE EMPTY
 IMP3     SEARCH TEDT,X5     SEARCH EDIT TABLE
          ZR     X2,IMP4     IF NOT FOUND
          SX1    X5          ENTER MODIFICATION TABLE LINK
          BX6    X1+X2
          SA6    A2+
 IMP4     SB5    B5-B1
          SA5    A5+B1
          NZ     B5,IMP3     IF NOT END OF DECK IDENTIFIERS
 IMP5     SA1    UP
          NZ     X1,IMP9     IF *UPDATE* OPTION SELECTED
 
*         GUARANTEE THAT COPYRIGHT RECORD, IF PRESENT, IS FIRST.
 
 IMP6     SX6    7           COMMON DECK
          SA1    =C*COPYRT*  COPYRIGHT RECORD
          SEARCH TDKN,X6+X1,777776B
          ZR     X2,IMP6.3   IF COPYRIGHT RECORD IS NOT PRESENT
          MX2    42          CLEAR DECK FLAGS
          BX6    X2*X6
          SB5    A2          SAVE DECK ADDRESS
          SEARCH TEDT,X6
          SB4    A2          SAVE ENTRY ADDRESS
          NZ     X2,IMP6.1   IF DECK IN EDIT TABLE
          ADDWRD TEDT,X6
          SX1    B5
          ADDWRD TEDT,X1
 
*         MOVE  THE  COPYRIGHT DECK  TO THE FIRST ENTRY.
 
          SB4    A6-B1       SAVE ENTRY ADDRESS
 IMP6.1   SX4    X3-2
          NG     X4,IMP6.3   IF FIRST ORDINAL OF THE TABLE
          SA1    F.TEDT      FIRST ORDINAL LOCATION
          SB5    X1
          SA1    B4          PRESENT POSITON
          SA2    B4+B1       SECOND ENTRY
          SB4    A2+B1
 IMP6.2   BX6    X1
          BX7    X2
          SA1    B5
          SA2    B5+B1
          SA6    B5
          SA7    B5+B1
          SB5    A2+B1
          NE     B5,B4,IMP6.2 IF NOT FINISHED MOVING DOWN
 
*         RESET FETS.
 
 IMP6.3   SA1    T
          SX6    B0+
          SA6    M
          ZR     X1,IMPX     IF TEXT FILE NOT USED - RETURN
          WRITER A1,R
          SA1    X2+1        REWIND POINTERS
          SX7    X1
          SA7    A1+B1
          SA7    A7+B1
          MX7    60          INSURE NO HIT ON TEXT ADDRESS
          SA7    T+5
          EQ     IMPX        RETURN
 
*         FOR *U* MODE, ENTER DECK IDENTIFIER TABLE IN EDIT TABLE.
 
 IMP7     SA1    F.TDKI
          SA2    L.TDKI
          BX7    X7-X7       CLEAR EDIT LENGTH
          SB7    X2
          SA7    L.TEDT
          SB7    B7-B1
          ZR     B7,IMP5     IF NO DECKS
          SA5    X1+B1       FIRST ENTRY
 IMP8     ADDWRD TEDT,X5
          MX0    42
          SX1    6
          BX6    X0*X6
          SEARCH TDKN,X1+X6,777776B
          SX1    A2
          ADDWRD TEDT,X1
          SB7    B7-B1
          SA5    A5+B1
          NZ     B7,IMP8     IF MORE DECKS TO PROCESS
          EQ     IMP5
 
*         FOR *UPDATE* OPTION, ORDER EDIT TABLE ACCORDING TO DECK TABLE.
 
 IMP9     SA1    F.TDKN
          SA2    L.TDKN
          BX7    X7-X7       CLEAR DECK IDENTIFIER TABLE LENGTH
          SB7    X2
          SA7    L.TDKI
          SA5    X1+
          SB6    2
 IMP10    SEARCH TEDT,X5
          ZR     X2,IMP11    IF DECK NOT IN EDIT TABLE
          SA1    A2+B1       ENTER EDIT ENTRY
          BX0    X1
          ADDWRD TDKI,X2
          ADDWRD A0,X0
 IMP11    SB7    B7-B6
          SA5    A5+B6
          PL     B7,IMP10    IF MORE DECKS TO PROCESS
          SA1    L.TEDT      COPY BACK TO EDIT TABLE
          SA2    F.TEDT
          SB7    X1
          SB6    B0
          SA3    F.TDKI
 IMP12    EQ     B6,B7,IMP6  IF COMPLETE
          SA1    X3+B6
          BX6    X1
          SA6    X2+B6
          SB6    B6+B1
          EQ     IMP12       LOOP
 IPC      SPACE  4,10
**        IPC - INSERT PREFIX CHARACTER.
*
*         ENTRY  (PCC) = COMPILE FILE PREFIX CHARACTER.
*                (WCCA) = TABLE OF COMPILE FILE DIRECTIVES.
*
*         EXIT   (WCCA) = INITIALIZED WITH PREFIX CHARACTER IN UPPER
*                            6-BITS OF TABLE ENTRY.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
 
 
 IPC      SUBR               ENTRY/EXIT
          SA2    PCC         COMPILE FILE PREFIX CHARACTER
          SA1    WCCA-1      INITIALIZE LOOP
          LX2    54
 IPC1     SA1    A1+B1       INSERT CHARACTER
          BX6    X1+X2
          ZR     X1,IPCX     IF AT END OF TABLE
          SA6    A1
          EQ     IPC1        LOOP FOR REMAINDER OF TABLE
 LDC      SPACE  4,20
**        LDC - LIST DIRECTIVE LINE.
*
*         ENTRY  (CHAR) - LINE IN *S* FORMAT.
*                (CDLS) - LINE LIST STATUS.
*                (ERRM) - ERROR MESSAGE, IF NEEDED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  LER, UPN, WOF.
 
 
 LDC      SUBR               ENTRY/EXIT
          SA1    ERRM
          ZR     X1,LDC1     IF NO ERROR MESSSAGE
          SX7    1S"LO.E"
          SA1    =9L  *ERROR*
          SA7    CDLS
          SB3    CHSP
          RJ     UPN         UNPACK NAME
          LISTOP E,LDC1,MI   IF ERROR LIST ON
          SA1    EA          ADVANCE DIRECTIVE ERROR COUNTER
          SA2    X1
          SX6    X2+B1
          SA6    A2
          BX6    X6-X6       CLEAR ERROR
          SA6    ERRM
          EQ     LDCX        RETURN
 
 LDC1     SA1    LO          CHECK LIST OPTION
          SA2    CDLS
          BX6    X1*X2
          ZR     X6,LDC5     IF NO LIST FOR LINE
          SA1    RDDB
          SX6    2
          IX1    X1-X6
          SX2    125
          PL     X1,LDC3     IF READPL
          SA1    CDCT
          MX0    -16
          SX6    B1
          BX1    -X0*X1
          IX7    X6+X1
          SA7    A1          DIRECTIVE COUNT
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SB2    9
          MX0    -6
          LX6    24
 LDC2     BX7    -X0*X6
          SB2    B2-B1
          SA7    A7+B1
          LX6    6
          NZ     B2,LDC2     IF NOT COMPLETE
          SA4    IW          INPUT WIDTH
          SX2    X4+10
          SA1    A
          ZR     X1,LDC3     IF NO ALTERNATE FILE
          SX2    118
 LDC3     PRINT  -CHSP,X2
          SX6    1R
          SB2    8
          SA6    CHSP        RESTORE SPACES TO CHSP
 LDC4     SB2    B2-B1
          SA6    A6+B1
          NZ     B2,LDC4     IF NOT COMPLETE
 LDC5     SA1    ERRM
          ZR     X1,LDCX     IF NO ERROR MESSAGE - RETURN
          BX6    X6-X6       CLEAR ERROR MESSAGE
          SA6    A1
          SX0    X1
          RJ     LER         LIST ERROR MESSAGE
          EQ     LDCX
 PMP      SPACE  4
**        PMP - PROCESS MOVE AND PURDECK DIRECTIVES.
*
*         USE TABLE *TMVE* TO REORDER THE EDIT TABLE.
 
 
 PMP      SUBR               ENTRY/EXIT
          BX6    X6-X6
          SA6    T1
 PMP1     SA1    T1          CHECK MOVE TABLE
          SA2    L.TMVE
          IX7    X2-X1
          SX6    X1+B1       ADVANCE MOVE INDEX
          ZR     X7,PMPX     IF END OF TABLE - RETURN
          SA3    F.TMVE      LOOK UP MOVE ENTRY
          SB2    X1
          SA2    X3+B2
          SA6    A1
          SA3    F.TDKN      LOOK UP DECK NAME
          IX6    X2+X3
          LX3    18
          IX6    X6+X3
          SA6    T2
          SA1    X6
          SEARCH TEDT,X1     SEARCH FOR DECK NAME
          ZR     X2,PMP1     IF NOT FOUND
          SA1    A2+B1       SAVE EDIT ENTRY
          BX6    X2
          BX7    X1
          SA6    PMPA
          SA7    A6+B1
          SA2    F.TEDT
          SA1    L.TEDT      DECREMENT EDIT LENGTH
          SX6    X1-2
          SA6    A1
          IX1    X6-X3
          IX3    X2+X3
          BX6    X3
          SA6    PMPA+2
          ZR     X1,PMP2     IF NO MOVE
          MOVE   X1,X3+2,X3  PURGE EDIT ENTRY
 PMP2     SA1    T2
          MI     X1,PMP4     IF MOVE COMPLETE
          LX1    -18
          SA2    X1          SEARCH FOR DECK NAME
          SEARCH TEDT,X2
          ZR     X2,PMP1     IF NOT FOUND
          SB2    B1+B1
          SX6    A2+B2
          SA1    L.TEDT
          SA2    F.TEDT
          SA6    T2
          SX7    X1+B2       INCREMENT TABLE LENGTH
          SA7    A1
          SX3    X3+B2
          IX2    X2+X3
          IX1    X1-X3
          ZR     X1,PMP3     IF NO MOVE
          MOVE   X1,X2,X2+B2 ADD MOVED ENTRY
 PMP3     SA1    T2
          SA2    PMPA
          SA3    A2+B1
          BX6    X2
          BX7    X3
          SA6    X1
          SA7    X1+B1
          EQ     PMP1        LOOP
 
 PMP4     LX1    -18
          SX3    X1
          SA2    F.TDKN
          BX1    X3-X2
          ZR     X1,PMP1     IF NO SECOND ADDRESS TO PURGE
          SA2    X3
          SEARCH TEDT,X2
          ZR     X2,PMP1     IF NOT FOUND
          SX2    A2+2
          SA3    PMPA+2      PICK UP WHERE 1ST PURGE WAS PERFORMED
          IX1    X2-X3
          SX6    =C/NAMES SEPARATED BY *.* IN WRONG ORDER./
          ZR     X1,PMP1     IF NOTHING TO MOVE
          NG     X1,ERR      IF PURGE ORDER INCORRECT
          SA4    L.TEDT
          SA5    F.TEDT
          IX6    X4-X1
          IX5    X5+X4
          IX1    X5-X2
          SA6    A4
          MOVE   X1,X2,X3
          EQ     PMP1
 
 PMPA     CON    0
          CON    0
          CON    0
 RCS      SPACE  4,15
**        RCS - RESET CHARACTER SET.
*
*         RESET CURRENT CHARACTER SET.
*
*         ENTRY  (CSR) = REQUESTED CHARACTER SET NAME.
*                      = 0 - DISPLAY CHARACTER SET MESSAGE.
*
*         EXIT   (X6)  = ERROR MESSAGE ADDRESS IF NON-ZERO.
*                (CSC) = CURRENT CHARACTER SET.
*                (CSR) = 0.
*
*         USES   A - 1, 2, 3, 6, 7.
*                X - 1, 2, 3, 4, 6, 7.
*                B - NONE.
*
*         MACROS MESSAGE, TLX.
*
*         CALLS  NONE.
 
 RCS      SUBR               ENTRY/EXIT
          SA1    CSR         GET REQUESTED CHARACTER SET
          ZR     X1,RCS4     IF MESSAGE REQUEST
          MX3    42
          BX2    X1
          SA1    TCST-1      FWA-1 OF CHARSET TABLE
          SX6    RCSA        PRESET ERROR MESSAGE
 RCS1     SA1    A1+B1
          ZR     X1,RCSX     IF UNKNOWN CHARSET
          BX4    X3*X1
          BX7    X2-X4
          NZ     X7,RCS1     IF NO MATCH
          BX7    -X3*X1
          SA7    CSC         SET NEW CHARACTER SET
 RCS3     BX6    X6-X6       CLEAR ERROR MESSAGE FLAG
          SA6    CSR         CLEAR CHARACTER SET REQUEST
          EQ     RCSX        RETURN
 
 RCS4     SA2    RCSB
          NG     X1,RCS3     IF NO EXPLICIT CS REQUEST
          ZR     X2,RCS3     IF NO MESSAGE, RETURN
          MESSAGE X2,3,R
          EQ     RCS3        RETURN
 
 RCSA     DATA   C* UNKNOWN CHARACTER SET.*
 RCSB     CON    0           MESSAGE ADDDRESS IF NON-ZERO.
 RDD      SPACE  4,15
**        RDD - READ DIRECTIVE.
*
*         *READ*, *SKIP*, *REWIND* DIRECTIVES PROCESSED HERE.
*
*         EXIT   (X1) - .NE. 0, IF EOR/EOF ENCOUNTERED.
*
*         USES   ALL.
*
*         CALLS  ECD, LDC, UPN, WOF.
 
 
 RDD      SUBR               ENTRY/EXIT
 RDD1     SA5    RDDB
          NZ     X5,RDD9     IF READPL INPUT
          SA1    A
          NZ     X1,RDD6     IF ALTERNATE INPUT
          SA1    IW
          READK  I,CHAR,X1
          NZ     X1,RDDX     IF EOR/EOF/EOI - RETURN
 RDD2     SX6    B6+
          SA6    LCAC
 RDD3     SX6    1BS"LO.C"
          SA6    CDLS
          CARD   BKSP
          CARD   READ
          CARD   READPL
          CARD   RETURN
          CARD   REWIND
          CARD   SKIP
          CARD   SKIPR
          BX1    X1-X1       RETURN WITH NO EOR
          EQ     RDDX        RETURN
 
*         RETURN HERE TO CLEAR ALTERNATE INPUT AND LIST LINE.
 
 RDD4     BX6    X6-X6       CLEAR ALTERNATE INPUT
          SA6    A
          SA6    RDDB        CLEAR READPL FLAG
          RJ     LDC         LIST LINE
          MESSAGE CCDR,1     ISSUE CONSOLE MESSAGE
          SX6    1R          BLANK FILL BUFFER
          SB2    25
 RDD5     SA6    CHAR+IWMAX+B2
          SB2    B2-B1
          PL     B2,RDD5     IF NOT COMPLETE
          EQ     RDD1        PROCESS NEXT INPUT
 
*         ALTERNATE INPUT READ.
 
 RDD6     SA5    RDDB
          NZ     X5,RDD9     IF READPL INPUT
          SA1    IW
          READK  A,CHAR,X1
          ZR     X1,RDD2     IF NO EOR
          SA3    RDDA
          ZR     X3,RDD7     IF NOT *READ* N,*
          MI     X1,RDD7     IF EOF
          READ   A           BEGIN NEW READ
          READC  A,BUF,20    READ FIRST LINE
          MI     X1,RDD7     IF EOF
          SX6    X1-BUF      CHECK LENGTH
          NZ     X6,RDD6     IF NEXT RECORD NOT ZERO LENGTH
 
 RDD7     BX7    X7-X7       CLEAR ALTERNATE INPUT
          SA7    X2
          SA7    RDDA        CLEAR (*) FLAG
 RDD8     SA7    RDDB        CLEAR READPL FLAG
          LISTOP C,RDD1      IF NO LIST SET FOR DIRECTIVE
          PRINT  (=C*  *)
          PRINT  (=C*  *)
          EQ     RDD1        PROCESS NEXT INPUT
 
 RDD9     SA1    RDDB+1
          ZR     X1,RDD11    IF LAST LINE READ
          READC  N,BUF,BUFL  READ MHBS
          NZ     X1,RDD11    IF EOR
          READC  X2,CDTX,MXCCL  READ COMPRESSED LINE
          NZ     X1,RDD11    IF EOR
 RDD10    SA1    BUF
          SA2    =00177777177777000000B
          SA3    RDDB
          BX6    X2*X1
          IX6    X6-X3
          SA6    A3+B1
          PL     X1,RDD9     IF LINE INACTIVE
          MX0    -16         SET LINE ID
          SA2    F.TNCD
          AX1    18
          BX6    -X0*X1
          IX6    X6+X2
          AX1    18
          SA2    X6          LINE NAME
          BX6    -X0*X1      SEQUENCE NUMBER
          BX2    X0*X2
          IX6    X2+X6
          SA6    CDID
          RJ     ECD         EXPAND LINE
          SX6    B7          ADDRESS OF LAST CHARACTER FROM LINE + 1
          SA6    LCAC
          EQ     RDD3
 
*         TERMINATE READPL.
 
 RDD11    RECALL N
          SA1    X2+B1       SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          SA1    A           FILE NAME
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SB3    CHAR+IWMAX+1  ENTER NAME IN CHAR
          BX1    X6
          RJ     UPN         UNPACK NAME
          BX7    X7-X7       CLEAR MODIFIER TABLE
          SA1    N+7         REPLACE NPL NAME
          BX6    X1
          SA7    L.TNCD
          SA6    N
          EQ     RDD8
 
 RDDA     CON    0           -READ- (*) FLAG
 RDDB     CON    0           -READPL- FLAG
          CON    0
          SPACE  4
***       FILE MANIPULATION DIRECTIVES.
*
*         PROCESSED FROM INPUT FILE.  THESE DIRECTIVES ARE NOT ALLOWED
*         ON ALTERNATE INPUT.
 BKSP     SPACE  4,10
***       BKSP   FNAME
*
*         BACKSPACE FILE *FNAME* 1 RECORD.
 BKSP     SPACE  4,10
***       BKSP   FNAME,N
*
*         BACKSPACE FILE *FNAME* *N* RECORDS.
 
 
 BKSP     SX6    B1          SET BACKSPACE FLAG
          EQ     SKP1
 READ     SPACE  4,10
***       READ   FNAME,RNAME
*
*         USE FILE *FNAME* FOR DIRECTIVE INPUT.
*         *RNAME* IF PRESENT, SPECIFIES THE NAME OF THE RECORD TO
*         BE USED.  *FNAME* MUST BE IN SOURCE FILE FORMAT.
*         I.E.  THE FIRST WORD OF EACH RECORD IS THE NAME OF THE
*         RECORD.  THIS WORD IS DISCARDED BEFORE DIRECTIVE INPUT
*         IS PROCESSED.  THE SEARCH TERMINATES ON AN END OF FILE.
*         WHEN END OF RECORD IS REACHED, DIRECTIVE INPUT RETURNS TO
*         NORMAL INPUT FILE.
*
*         IF *RNAME* = (*), ALL RECORDS UP TO AN EOF OR A ZERO
*         LENGTH RECORD ARE READ.
 
 
 READ     RJ     SAF         SET ALTERNATE FILE
          SA6    A           SET FILE NAME
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R,
          NZ     B2,RAF6     IF NOT COMMA
          SA6    A1          SKIP COMMA
          RJ     ASN         ASSEMBLE RECORD NAME
          BX1    X6          CHECK NAME
          LX7    X6
          ZR     X6,RAF7     IF NO RECORD NAME
          LX7    18
          SX7    X7-1L*
          ZR     X7,RAF5     IF ASTERISK
          RJ     SFN         SPACE FILL NAME
          BX5    X6          SAVE NAME
          READ   A
 RAF1     READC  A,BUF,MXCCL  READ FIRST LINE
          MI     X1,RAF4     IF EOF
          SA1    BUF         SPACE FILL NAME
          RJ     SFN         SPACE FILL NAME
          BX7    X6-X5
          ZR     X7,RAF3     IF RECORDS MATCH
          SB2    BUF+BUFL
          READW  A,B6,B2-B6
          SX1    B6          LWA+1 OF DATA READ
          SX2    BUF         SET RECORD TYPE
          RJ     SRT         SET RECORD TYPE
          SA7    RAFA+1      ENTER NAME IN MESSAGE
          MESSAGE A7-B1,1
 
 RAF2     READW  A,BUF,BUFL  READ NEXT PART
          ZR     X1,RAF2     IF NOT EOR/EOF/EOI
          READ   X2          BEGIN NEW READ
          EQ     RAF1        PROCESS NEXT RECORD
 
 RAF3     RJ     LDC         LIST LINE
          SA1    A           SPACE FILL FILE NAME
          MX0    42
          BX1    X0*X1
          RJ     SFN         SPACE FILL NAME
          SB3    CHAR+IWMAX+1  ENTER NAME IN CHARACTER BUFFER
          BX1    X6
          RJ     UPN         UNPACK NAME
          MESSAGE CCDR,1     RESET CONSOLE MESSAGE
          EQ     RDD1        READ NEXT LINE
 
 RAF4     SX6    =C*RECORD NOT FOUND.*
          EQ    RAF8         SET ERROR MESSAGE
 
 RAF5     SX6    B1          SET ASTERISK FLAG
          SA6    RDDA
          READ   A           BEGIN READ
          READC  A,BUF,MXCCL  READ FIRST LINE
          EQ     RAF3
 
 RAF6     READ   A,R         LOAD BUFFER
          SA1    A+2
          SA3    A1+B1       (A+3)
          BX6    X1-X3
          NZ     X6,RAF3     IF DATA READ
          SX6    =C*EMPTY FILE.*
          EQ     RAF8        SET ERROR MESSAGE
 
 RAF7     SX6    =C*RECORD NAME MISSING.*
 RAF8     SA6    ERRM        SET ERROR MESSAGE
          EQ     RDD4        EXIT
 
 RAFA     CON    10H   SKIP /
          CON    0
 READPL   SPACE  4,10
***       READPL DNAME,C1,C2
*
*         READ LINES *C1* THROUGH *C2* FROM PROGRAM LIBRARY.
*
*         IF *C1* AND *C2* ARE MISSING, READ ENTIRE DECK.
 
 
 READPL   SA1    RDDB
          SX6    =C*OPERATION INCORRECT FROM ALTERNATE INPUT.*
          NZ     X1,ERR      IF ALTERNATE INPUT ACTIVE
          RJ     CRD         CONDITIONALLY READ DIRECTORY
          RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMAT ERROR
          SEARCH TDKN,X6,200000B   SEARCH FOR DECK
          SX6    =C*UNKNOWN DECK.*
          ZR     X2,ERR      IF DECK NOT FOUND
          SA1    A2+B1       SET RANDOM ADDRESS
          SX6    A2          SET IDENTIFIER ADDRESS
          SA6    RPLA
          MX0    30
          BX6    -X0*X1
          AX1    36
          SA3    X1          PROGRAM LIBRARY NAME
          SA6    N+6
          BX7    X3
          SX6    B1
          SA7    N
          SA6    RDDB
          SX6    IWMACS+1    SET LINE NUMBER COLUMN
          SA6    SC+1
          READ   N           INITIATE NEW READ
          READW  N,TIDT,TIDTL READ IDENT TABLE
          NZ     X1,PLE      IF EOR
          SA1    TIDT
          LX1    12
          SB2    X1-7700B
          NZ     B2,PLE      IF NO IDENT TABLE
          SA1    TIDT+1      ADD DECK NAME TO IDENTIFIER TABLE
          ADDWRD TNCD,X1
          SB5    TIDT        FWA OF IDENT TABLE
          RJ     PCS         PROCESS CHARACTER SET
          READW  N,T1,1      READ MODIFIER TABLE LENGTH
          NZ     X1,PLE      IF EOR
          SA1    T1          CHECK TABLE
          SB7    X1          SET TABLE LENGTH
          LX1    18
          SB2    X1-700100B
          SB3    X1-700200B
          ZR     B2,RPL1     IF NORMAL DECK
          NZ     B3,PLE      IF NOT COMMON DECK
 RPL1     ZR     B7,RPL2     IF NO MODIFIERS
          ALLOC  TNCD,B7     ALLOCATE FOR MODIFIERS
          READW  N,X2+B1,B7  READ MODIFIERS
 RPL2     SA1    CH          CHECK SEPARATOR CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R
          SA6    A1+
          ZR     B2,RPL9     IF READ ENTIRE DECK
          NE     B2,B1,ERR2  IF FORMAT ERROR
          SA1    MDTI        MODIFICATION TABLE INDEX
          SA2    AIDT        ASSUMED IDENTIFIER
          BX6    X1
          LX7    X2
          SA3    RPLA        DECK NAME ADDRESS
          SA6    A3
          SA7    A3+B1
          BX6    X3
          SX7    B1
          SA6    A2          ASSUMED IDENTIFIER = DECK NAME ADDRESS
          SA7    A1          INDEX = 1
          RJ     AMI         ASSEMBLE FIRST IDENTIFIER
          SA7    T1
          SA1    X6          FIND MODIFIER INDEX
          SEARCH TNCD,X1
          NZ     X2,RPL4     IF FOUND
 RPL3     SA1    RPLA        RESTORE MODNAME
          SA2    A1+1
          BX6    X1
          LX7    X2
          SA6    MDTI
          SA7    AIDT
          SX6    =C*UNKNOWN MODNAME.*
          EQ     RPL8
 
 RPL4     LX3    18          FORM FIRST LINE MASK
          SA1    T1
          LX1    36
          BX6    X1+X3
          SA6    A1
          RJ     AMI         ASSEMBLE SECOND IDENTIFIER
          SA7    T2
          SA1    X6+         FIND MODIFIER INDEX
          SEARCH TNCD,X1
          ZR     X2,RPL3     IF NOT FOUND
          SA1    T2          FORM LAST LINE MASK
          LX3    18
          LX1    36
          BX6    X1+X3
          SA6    A1
          SA1    RPLA        RESTORE MODNAME
          SA2    A1+1
          BX6    X1
          LX7    X2
          SA6    MDTI
          SA7    AIDT
          SA1    =00177777177777000000B
          SA5    T1
          BX0    X1
 
*         SEARCH FOR START OF TEXT.
 
 RPL5     READC  N,BUF,BUFL  READ MHBS
          NZ     X1,RPL7     IF EOR
          READC  X2,CDTX,MXCCL  READ COMPRESSED LINE
          NZ     X1,RPL7     IF EOR
          SA1    BUF
          BX1    X0*X1
          IX6    X1-X5
          NZ     X6,RPL5     IF NOT AT BEGINNING OF TEXT
 
 RPL6     RJ     LDC         LIST LINE
          SA1    T2          SET ALTERNATE READ
          BX6    X1
          SA6    RDDB
          MESSAGE CCDR,1     RESET CONSOLE MESSAGE
          EQ     RDD10       PROCESS LINE
 
 RPL7     SX6    =C*CARD NOT FOUND.*
 RPL8     SA6    ERRM
          RECALL N
          SA1    N+1         RESET IN = OUT = FIRST
          SX6    X1
          BX7    X7-X7
          SA6    A1+B1
          SA6    A6+B1
          SA7    L.TNCD
          EQ     RDD4        EXIT
 
*         READ ENTIRE DECK.
 
 RPL9     READC  N,BUF,BUFL  READ MHBS
          NZ     X1,RPL7     IF EOR
          READC  X2,CDTX,MXCCL  READ COMPRESSED LINE
          SX6    10          SET ALTERNATE READ
          SA6    T2
          EQ     RPL6
 
 RPLA     CON    0           MODIFICATION TABLE INDEX
          CON    0           ASSUMED IDENTIFIED
 RETURN   SPACE  4,10
***       RETURN FNAME,FNAME,...,FNAME
*
*         RETURN FILE(S) *FNAME*.
 
 
 RETURN   RJ     SAF         SET ALTERNATE FILE
          SA6    A           SET FILE NAME
          EVICT  A,R         RETURN FILE
          SA1    CH          CHECK NEXT CHARACTER
          BX6    X6-X6       CLEAR ALTERNATE FILE
          SA2    X1
          SB2    X2-1R,
          SA6    A
          NZ     B2,RDD4     IF NO COMMA - LIST LINE
          SX7    X1+B1       SKIP COMMA
          SA7    A1
          EQ     RETURN      PROCESS NEXT NAME
 REWIND   SPACE  4,10
***       REWIND FNAME,FNAME,...,FNAME
*
*         REWIND FILE(S) *FNAME*.
 
 
 REWIND   RJ     SAF         SET ALTERNATE FILE
          SA6    A           SET FILE NAME
          REWIND A,R         REWIND FILE
          SA1    CH          CHECK NEXT CHARACTER
          BX6    X6-X6       CLEAR ALTERNATE FILE
          SA2    X1
          SB2    X2-1R,
          SA6    A
          NZ     B2,RDD4     IF NO COMMA - LIST LINE
          SX7    X1+B1       SKIP COMMA
          SA7    A1
          EQ     REWIND      PROCESS NEXT NAME
 SKIP     SPACE  4,10
***       SKIP   FNAME
*
*         SKIP 1 RECORD ON FILE *FNAME*.
 SKIP     SPACE  4,10
***       SKIP   FNAME,N
*
*         SKIP *N* RECORDS ON FILE *FNAME*.
 
 
 SKIP     SX6    B0+         SET FORWARD FLAG
 SKP1     SA6    T2
          RJ     SAF         SET ALTERNATE FILE
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R
          ZR     B2,SKP2     IF BLANK
          NE     B2,B1,ERR1   IF NOT COMMA
          SA6    A1
          RJ     ASD         ASSEMBLE RECORD COUNT
          SB2    X7
 SKP2     SA1    T1          SET FILE NAME
          SA5    T2
          LX6    X1
          BX7    X7-X7       SEND SKIPPING MESSAGE
          SA6    A
          SA7    RAFA+1
          MESSAGE A7-B1,1
          NZ     X5,SKP3     IF BACKSPACE
          SKIPF  A,B2,R
          EQ     RDD4        EXIT
 
 SKP3     SKIPB  A,B2,R
          EQ     RDD4        EXIT
 SKIPR    SPACE  4,10
***       SKIPR  FNAME,RNAME
*
*         SKIP RECORDS ON FILE *FNAME* THROUGH RECORD *RNAME*.
 
 
 SKIPR    RJ     SAF         SET ALTERNATE FILE
          SA1    CH          CHECK NEXT CHARACTER
          SA2    X1
          SX6    X1+B1
          SB2    X2-1R,
          NZ     B2,ERR1     IF NOT COMMA
          SA6    A1          SKIP COMMA
          RJ     ASN         ASSEMBLE RECORD NAME
          BX5    X6
          SA1    T1          SET FILE NAME
          BX7    X1
          SA7    A
 SKR1     READ   A           BEGIN READ
          READW  X2,BUF,BUFL
          MI     X1,SKR3     IF EOF
          SX1    B6          LWA+1 OF DATA READ
          SX2    BUF         SET RECORD TYPE
          RJ     SRT         SET RECORD TYPE
          BX0    X7          SAVE NAME
          SA7    RAFA+1
          MESSAGE A7-B1,1
 SKR2     READW  A,BUF,BUFL
          ZR     X1,SKR2     IF NOT EOR/EOF/EOI
          BX7    X0-X5       COMPARE NAMES
          NZ     X7,SKR1     IF NO MATCH
          EQ     RDD4        EXIT
 
 SKR3     SX6    =C*RECORD NOT FOUND.*
          SA6    ERRM
          EQ     RDD4
 CRD      SPACE  4,10
**        CRD - CONDITIONALLY READ DIRECTORY.
*
*         USES   ALL.
*
*         CALLS  RDR.
 
 
 CRD      SUBR               ENTRY/EXIT
          SA1    DL
          PL     X1,CRDX     IF DIRECTORY ALREADY READ - RETURN
          SA5    P+7
          RJ     RDR         READ DIRECTORY
          NZ     X0,ABT      IF ERRORS IN OPL
          SA1    L.TDKN      SET ORIGINAL DECK TABLE LENGTH
          BX6    X1
          SA6    DL
          EQ     CRDX        RETURN
 RDR      SPACE  4,20
**        RDR - READ DIRECTORY FROM PROGRAM LIBRARY.
*
*         CHECK PROGRAM LIBRARY FORMAT.  READ DECK NAME TABLE.
*
*         ENTRY  (A5) - ADDRESS OF FILE NAME.
*                (X5) - FILE NAME.
*
*         EXIT   (X0) - 0, IF NO ERRORS.
*                (A0) - ADDRESS OF ERROR MESSAGE, IF ERROR.
*
*         USES   ALL.
*
*         CALLS  ABT, ADW, ATS, RDW=.
 
 
 RDR5     SA0    =C* ERROR IN DIRECTORY.*
 RDR6     SX0    B1+         ERROR RETURN
 
 RDR      SUBR               ENTRY/EXIT
          BX0    X0-X0       CLEAR ERROR
          ZR     X5,RDRX     IF NO PROGRAM LIBRARY - RETURN
          RECALL M
          BX6    X5
          SA6    X2
          SKIPEI X2
          SKIPB  M,2         BACKSPACE OVER DIRECTORY
          READ   M
          READW  X2,TIDT,TIDTL READ IDENT TABLE
          SA0    =C* PROGRAM LIBRARY EMPTY.*
          NZ     X1,RDR6     IF EOR - FILE NOT FOUND
          SA1    TIDT
          LX1    18
          SA2    A1+B1
          SB2    X1-770000B
          NZ     B2,RDR5     IF NO IDENT TABLE
          BX6    X2          SET PROGRAM LIBRARY NAME
          SA6    PL
          READW  M,T1,1      READ FIRST WORD
          NZ     X1,RDR5     IF EOR
          SA1    T1
          SX5    X1          SET DIRECTORY LENGTH
          LX1    18
          SB2    X1-700000B
          NZ     B2,RDR5     IF NOT DIRECTORY
          ZR     X5,RDR5     IF EMPTY
          ALLOC  TNDK,X5,S   ALLOCATE TABLE SLACK FOR LARGE BLOCK
 RDR2     READW  M,T1,2      READ RECORD NAME
          SA1    T1          CHECK TYPE
          SB2    X1-OPRT
          ZR     B2,RDR3     IF OPL DECK
          NE     B2,B1,RDR4  IF NOT OPL COMMON DECK
          ERRNZ  OPRT+1-OCRT CODE ASSUMES VALUE
 RDR3     ADDWRD TNDK,X1     ENTER DECK NAME
          SA1    T2          ENTER RANDOM INDEX
          ADDWRD A0,X1
 RDR4     SX5    X5-2
          NZ     X5,RDR2     IF NOT AT END OF DIRECTORY
          SX5    A5          ADD DECKS
          RJ     ADK         ADD DECK
          RECALL M           RESET SCRATCH BUFFER
          SA1    X2+B1
          SA2    M+7
          SX6    X1
          BX7    X2
          SA6    A1+B1
          SA6    A6+B1
          SA7    A1-B1
          BX0    X0-X0
          EQ     RDRX        RETURN
 SAF      SPACE  4,15
**        SAF - SET ALTERNATE INPUT FILE.
*
*         EXIT   (X6) - FILE NAME AND STATUS.
*                (X7) - FILE NAME, ZERO FILL.
*                (T1) - FILE NAME AND STATUS.
*
*         USES   X - 0, 1, 3, 6, 7.
*                A - 1, 6.
*                B - 2, 6, 7.
*
*         CALLS  ASN.
 
 
 SAF      SUBR               ENTRY/EXIT
          SA1    A
          ZR     X1,SAF1     IF ALTERNATE FILE NOT ACTIVE
          SX6    =C*OPERATION INCORRECT FROM ALTERNATE INPUT.*
          EQ     ERR
 
 SAF1     RJ     ASN         ASSEMBLE NAME
          ZR     X6,ERR2     IF NO NAME - FORMT ERROR
          MX0    42
          SB6    FETS        SET FET SEARCH
          SB7    FETSL
          SB2    FETLEN+FETODL
 SAF2     SA1    B6          READ FET NAME
          BX3    X6-X1
          SB6    B6+B2
          BX7    X0*X3
          NZ     X7,SAF3     IF NO MATCH
          SX6    =C*RESERVED FILE NAME.*
          EQ     ERR
 
 SAF3     NE     B6,B7,SAF2  IF MORE FETS TO PROCESS
          SX1    B1          SET CODED FILE STATUS
          BX7    X0*X6
          IX6    X7+X1
          SA6    T1          SET NEW FILE NAME
          EQ     SAFX        RETURN
 WTF      SPACE  4,12
**        WTF - WRITE LINE TO TEXT FILE.
*
*         ADD LINE TO TEXT TABLE, IF NOT FULL.  OTHERWISE WRITE TO
*         TEXT FILE.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 0, 1, 2, 3, 4, 6.
*                B - 2, 3.
*
*         CALLS  ATS, CCD.
 
 
 WTF      SUBR               ENTRY/EXIT
          SA1    CDWC        ADVANCE FTEXT ADDRESS
          SA2    T+5
          SA3    T           CHECK FTEXT FILE
          IX6    X1+X2
          SA6    A2
          NZ     X3,WTF2     IF TEXT FILE BEGUN
          ALLOC  TTXT,X1     ALLOCATE ROOM
          SA4    T
          SA1    CDWC
          NZ     X4,WTF2     IF TEXT FILE BEGUN
          SB3    X1
          IX3    X2+X3
          SB2    B0
          IX4    X3-X1
          SA1    CDTX
 WTF1     BX6    X1          COPY TEXT LINE
          SA6    X4+B2
          SB2    B2+B1
          SA1    A1+B1
          NE     B2,B3,WTF1  IF NOT AT END OF LINE
          EQ     WTFX        RETURN
 
 WTF2     WRITEW T,CDTX,X1
          EQ     WTFX        RETURN
          SPACE  4
**        ADDITIONAL COMMON DECKS.
 
 
*CALL     COMCSRT
          SPACE  4
**        INPUT DIRECTIVE PROCESSOR TABLE.
 
 
          HERE
          CON    0           END OF TABLE
 IDENT    SPACE  4
          IDENT
          QUAL   PRESET
 ERR      SPACE  4,4
          ERRMI  PBUF+PBUFL-*  DIRECTIVE PROCESSOR OVERFLOWS INTO PRESET
 PRESET   TITLE  MODIFY PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET MODIFY.
*
*         ENTRY  (A0) - FL.
*
*         USES   X - 1, 2, 4, 6.
*                A - 0, 1, 2, 4, 6.
*                B - 4, 5.
*
*         CALLS  ARG, IAF, ICS, IVI, IXQ, IZI, PCV, SMM, SOF.
*
*         MACROS CLOCK, DATE, GETFLC, GETPP, WRITEC.
 
 
 PRS      SUBR               ENTRY/EXIT
          BX6    X0          SAVE *ECS* FIELD LENGTH
          SA6    EFL
          SX6    A0-10B
          SA6    FL          SET FIELD LENGTH
          GETFLC SFL
          SA1    SFL
          MX2    -12
          LX1    -36
          BX6    -X2*X1      LAST COMMAND FL
          LX6    6           *100
          SX1    CMFL        COMPARE DEFAULT FL
          LX1    6
          IX2    X1-X6       DEFAULT - LAST COMMAND FL
          NG     X2,PRS1     IF LAST COMMAND FL .GT. DEFAULT FL
          BX6    X1
 PRS1     SA6    A1+         SET FL
          DATE   DATE        REQUEST DATE
          SA1    DATE        SET DATE IN SHORT TITLE
          BX6    X1
          SA6    TERDT
          SA1    ACTR        SET ARGUMENT COUNT
          SA2    DATE        SET DATE IN IDENT TABLE
          SB4    X1
          BX6    X2
          SA6    TIDT+2
          CLOCK  TIME        REQUEST TIME
          SA1    TIME        SET TIME IN SHORT TITLE
          BX6    X1
          SA6    TERTM
          SB5    ARGT        AGRUMENT TABLE ADDRESS
          SA4    ARGR        FIRST ARGUMENT
          RJ     ARG         PROCESS ARGUMENTS
          SA0    =C* ERROR IN MODIFY ARGUMENTS.*
          NZ     X1,ABT1     IF ARGUMENT ERROR
          RJ     SOF         SET OUTPUT FORMAT
          RJ     SMM         SET MODIFICATION MODE
          RJ     IAF         INITIALIZE ALL FILES
          RJ     IXQ         INITIALIZE  *X*  OR  *Q*  MODE PARAMETERS
          ZR     X1,ABT1     IF ERROR IN  *Q*  OR  *X*  MODE
          RJ     PCV         PROCESS CONVERSION OPTION
          NZ     X4,ABT1     IF ERROR IN *CV* OPTION
          RJ     IZI         INITIALIZE *Z* MODE INPUT
          RJ     IVI         INITIALIZE VARIOUS ITEMS
          RJ     ICS         INITIALIZE CHARACTER SET
          NZ     X6,ABT1     IF INCORRECT CHARACTER SET SPECIFIED
          GETPP  BUF,LL,BUF  GET PAGE SIZE PARAMETERS
          RJ     IOD         INITIALIZE OPTICAL DISK FET EXTENSIONS
          SA1    TO
          ZR     X1,PRSX     IF TERMINAL OUTPUT
          WRITEC O,BUF       WRITE PRINT DENSITY FORMAT CONTROL
 
          EQ     PRSX        RETURN
          TITLE  ARGUMENT TABLE AND PRESET TEMPORARIES.
 ARGT     SPACE  4,10
**        ARGT - ARGUMENT TABLE.
 
 
 ARGT     BSS    0
 A        ARG    -NSN,AM     COMPRESSED COMPILE
 BL       ARG    -NSN,BL     BURSTABLE LISTING
 C        ARG    C,C         COMPILE FILE
 CB       ARG    CASD,CASD,400B  *CB*  OPTION
 CG       ARG    NGTXT,CASF,400B *CG* OPTION
 CL       ARG    CLO,CASC,400B   *CL*  OPTION
 CS       ARG    CASE,CASE,400B  *CS*  OPTION
 CV       ARG    CVT,CVT     CONVERSION OPTION
 D        ARG    -NSN,DB     DEBUG MODE
 F        ARG    -NSN,FM     FULL MODIFY MODE
 I        ARG    I,I         INPUT FILE
 L        ARG    O,O         LIST OUTPUT FILE
 LO       ARG    LO,LO,400B  LIST OPTIONS
 N        ARG    NNPL,N      NEW PROGRAM LIBRARY
 NR       ARG    -NSN,NR     *NR*  OPTION
 P        ARG    P,P         PROGRAM LIBRARY
 Q        ARG    NASSM,QM    *Q*  OPTION
 S        ARG    NSOURCE,S   SOURCE FILE
 U        ARG    -NSN,UM     *U*  MODE
 X        ARG    NASSM,XM    *X*  MODE
 Z        ARG    -*,ZM       *Z*  MODE
          ARG
          SPACE  4,10
**        PRESET TEMPORARIES.
 
 
 
 NNPL     CON    0LNPL+3
 NSOURCE  CON    0LSOURCE+1
 NASSM    CON    0LCOMPASS
 NGTXT    CON    0LSYSTEXT
 NSN      CON    1
 CLO      CON    0LOUTPUT
          TITLE  MODIFY PRESET SUBROUTINES.
 IAF      SPACE  4,20
**        IAF - INITIALIZE ALL FILES.
*
*         CHECK FOR FILE NAME CONFLICTS AND INITIALIZE ALL FILES.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 5, 6, 7.
 
 
 IAF      SUBR               ENTRY/EXIT
 
*         CHECK FOR FILE NAME CONFLICTS.
 
          SB6    FETS        INITIALIZE  FOR FET SEARCH
          SB7    FETSL
          MX0    42
          SB2    FETLEN+FETODL  LENGTH OF EACH FET+EXTENSION
          SA0    =C* FILE NAME CONFLICT.*
 IAF1     SA1    B6+         OUTER SEARCH LOOP
          SB5    B6+B2       ADVANCE TO NEXT FET
          BX1    X0*X1       CLEAR C/S BITS
 IAF2     SA2    B5+         INNER SEARCH LOOP
          BX2    X0*X2       CLEAR C/S BITS
          BX7    X2-X1       COMPARE
          ZR     X2,IAF3     IF FILE NOT DEFINED
          ZR     X7,ABT1     IF FILE NAMES COMPARE
 IAF3     SB5    B5+B2       ADVANCE INNER SEARCH LOOP
          LT     B5,B7,IAF2  IF SEARCH NOT COMPLETE
          SB6    B6+B2
          NE     B6,B7,IAF1  IF NOT COMPLETE
 
*         INITIALIZE FILES.
 
          SA1    O           SET UP FOR INTERACTIVE I/O
          BX6    X0*X1
          SX2    A1          ADDRESS OF FET
          BX7    X7-X7
          IX6    X6+X2
          R=     A6,ARGR
          SA7    A6+B1
          EVICT  A,R
          EVICT  M,R
          SA1    S           CHCK FOR SOURCE REQUESTED
          ZR     X1,IAF4     IF NOT SOURCE FILE
          REWIND A1
          SA1    AM          CHECK FOR  *A*, *X*  OR  *Q*  SELECTED
          SA2    XM
          SA3    QM
          SA0    =C* S OPTION INCORRECT WITH X, Q, OR A.*
          BX4    X1+X2
          BX4    X4+X3
          NZ     X4,ABT1     IF EITHER  *A*,  *X*,  OR  *Q*  SELECTED
          SX7    CBUF+CBUFL  REDUCE COMPILE FILE BUFFER LENGTH
          SA7    C+4
 IAF4     SA1    N           CHECK FOR NEW PROGRAM LIBRARY
          ZR     X1,IAF5     IF NO NEW PROGRAM LIBRARY
          BX6    X1          SAVE FILE NAME
          SA6    N+7
          EVICT  A1,R
 IAF5     SA1    NR          CHECK FOR  *NR*  SELECTED
          NZ     X1,IAF6     IF *NR* SELECTED
          REWIND C,R
 IAF6     SA1    P           SAVE OLD PROGRAM LIBRARY FILE NAME
          BX6    X1
          BX7    X7-X7       CLEAR SCRATCH FILE NAME
          SA6    P+7
          SA7    A
          EQ     IAFX
          SPACE  4
**        IOD - INITIALIZE OPTICAL DISK FET EXTENSIONS.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 6, 7.
 
 
 IOD      SUBR               ENTRY/EXIT
 
*         CHECK FOR OPTICAL DISK FILE AND SET EXTENSION.
 
          SX6    FETS        INITIALIZE  FOR FET SEARCH
 IOD1     SA1    X6          LOAD FIRST FET WORD
          MX0    42
          SA6    IODA
          SX6    X6-M
          ZR     X6,IOD1.1   IF FILE M
          SA2    IODB
          BX3    X0*X1       FILE NAME
          SX2    X2
          BX6    X3+X2
          SA6    A2
          FILINFO  IODB      GET FILE INFORMATION
          SA3    IODB+1      GET DEVICE TYPE AND STATUS
          AX3    48
          SX2    X3-2ROD     OPTICAL DISK DEVICE TYPE
          NZ     X2,IOD2     IF NOT OPTICAL DISK DEVICE
 IOD1.1   SA2    IODA
          SX7    FETODL      OPTICAL DISK FET EXTENSION LENGTH
          SX3    X2+12B      SET OPTICAL FET BUFFER AFTER FET
          LX7    18
          BX7    X3+X7
          SA7    X2+11B      STORE POINTER AND LENGTH
          OPEN   X2,READNR,R
 IOD2     SX0    FETLEN+FETODL
          SA2    IODA
          IX6    X2+X0
          SB6    X6
          SB7    FETSL
          LT     B6,B7,IOD1  IF FET SCAN NOT COMPLETE
          SB6    0
          SB7    FETODL
 IOD3     SA1    B6+P+FETLEN MOVE P FET EXTENSION TO M
          BX6    X1
          SA6    B6+M+FETLEN
          SB6    B6+B1
          NE     B7,B6,IOD3  IF NOT DONE WITH MOVE
          EQ     IODX        RETURN
 
 IODA     BSSZ   1           FET ADDRESS STORAGE
 IODB     VFD    42/0,6/5,12/1  *FILINFO* PARAMETER BLOCK
          BSSZ   5
 ICS      SPACE  4,20
**        ICS - INITIALIZE CHARACTER SET.
*
*         CHECK AND INITIALIZE CHARACTER SET AND
*         ENSURE COMPRESSED COMPILE FILE IS NOT IN USE.
*
*         ENTRY  (CSR) = CHARACTER SET NAME.
*
*         EXIT   (X6)  = 0, IF NO ERROR ENCOUNTERED.
*                (A0)  = ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
*                (CSC) = CURRENT CHARACTER SET.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 7.
*                B - NONE.
*
*         MACROS TSTATUS.
*
*         CALLS  RCS, STF.
 
 ICS      SUBR               ENTRY/EXIT
          SA2    I
          MX3    42
          BX4    X3*X2
          ZR     X4,ICS2     IF *Z* INPUT
          SX2    A2
          RJ     STF
          NZ     X6,ICS2     IF NOT CONNECTED *INPUT* FILE
          TSTATUS ICSA       GET TERMINAL CHARACTER SET
          MX3    -1
          SA2    ICSA+1
          LX2    -2
          BX1    -X3*X2      (X1) = 0 FOR DISPLAY, 1 FOR ASCII
          BX6    -X1
          SA6    TI          TERMINAL INPUT CHARACTER SET FLAG
 ICS2     RJ     /DIRECT/RCS RESET CHARACTER SET
          SA0    X6          SET POSSIBLE ERROR MESSAGE
          EQ     ICSX        RETURN
 
 ICSA     BSSZ   2           TSTATUS RETURN BLOCK
 IVI      SPACE  4,15
**        IVI - INITIALIZE VARIOUS ITEMS.
*
*         SPACE FILL COMMAND, PRESET DECK INENTIFIER TABLE
*         AND SET ASSUMED MODIFIER NAME.
*
*         USES   X - 1, 6.
*                A - 0, 1, 6.
*                B - 4, 5.
*
*         CALLS  ADW, SFN.
 
 
 IVI      SUBR               ENTRY/EXIT
          SB4    B0+         BLANK FILL COMMAND
          SB5    8
 IVI1     SA1    CCDR+B4
          RJ     SFN         SPACE FILL NAME
          SB4    B4+B1
          SA6    A1
          NE     B4,B5,IVI1  IF NOT COMPLETE
          BX6    X6-X6
          SA6    A6+B1       SET END OF LINE
          ADDWRD TDKI,X6-X6  PRESET DECK IDENTIFIER TABLE
          SA1    =7L*******  SET ASSUMED MODIFIER NAME
          ADDWRD TNME,X1
          ADDWRD A0,X6-X6
          EQ     IVIX        RETURN
 IXQ      SPACE  4,20
**        IXQ - INITIALIZE  *X*  OR  *Q*  MODE PARAMETERS.
*
*         ENTRY  (XM) - COMMAND *X* MODE PARAMETER.
*                (QM) - COMMAND *Q* MODE PARAMETER.
*                (ZM) = CONTROL STATEMENT *Z* MODE PARAMETER.
*
*         EXIT   (X1) - 0, IF ERROR ENCOUNTERED.
*                (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2.
*
*         CALLS  SFN, ZTB.
*
*         MACROS REWIND.
 
 
 IXQ4     SX1    B1+
 
 IXQ      SUBR               ENTRY/EXIT
          SA1    XM          CHECK  *X*  OR  *Q*  SELECTED
          SA2    QM
          BX1    X1+X2
          MX0    -6
          ZR     X1,IXQ4     IF NEITHER SELECTED
          RJ     SFN         SPACE FILL ASSEMBLER NAME
          BX6    X0*X6
          SX7    1R(
          BX6    X6+X7
          SA1    C           SET COMPILE FILE NAME
          MX2    42          CLEAR C/S BITS
          BX1    X2*X1
          SA0    =C* X OR Q INCORRECT WITHOUT COMPILE.*
          ZR     X1,IXQX     IF NO COMPILE FILE
          SA7    AM          SELECT MODIFY  *A*  MODE
          SA2    LO          CHECK USER SELECTED LIST OPTIONS
          SA6    CASG        SET ASSEMBLER NAME
          NZ     X2,IXQ1     IF USER SELECTED LIST OPTION
          SX7    1S"LO.E"    SELECT ERROR LIST
          SA7    LO          SET LIST OPTION
 IXQ1     SA5    IXQA        SET UP PARAMETER STENCIL
          SA4    =0L0
          LX1    -12         MOVE ASSEMBLER INPUT FILE NAME INTO PLACE
          BX1    X1+X5       OVERLAY WITH STENCIL
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA1    CASC        GET LIST OPTION SPECIFIED
          SA6    A6+B1       SET ASSEMBLER LIST OPTION
          SA5    A5+B1       SET UP STENCIL FOR ASSEMBLER LIST OPTION
          BX7    X4-X1       CHECK FOR DISPLAY  *0*
          NZ     X7,IXQ2     IF COMPASS LIST SELECTED
          SA7    CMNF        CLEAR COMPILE FILE COMMENTS FLAG
 IXQ2     LX1    -12         POSITION ARGUMENT
          BX1    X1+X5       OVERLAY WITH STENCIL
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA1    CASD        ASSLEMBLER BINARY OUTPUT FILE
          SA6    A6+B1       SET LIST OPTION
          SA5    A5+B1       BINARY OUTPUT PARAMETER STENCIL
          LX1    -12         POSITION ARGUMENT
          BX1    X1+X5
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA1    CASE        ASSEMBLER *S* OPTION
          SA6    A6+B1       BINARY OUTPUT FILE NAME
          SA5    A5+B1
          LX1    -12
          BX1    X1+X5
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SA1    CASF        ASSEMBLER *G* OPTION
          SA5    A5+B1
          BX2    X4-X1
          ZR     X2,IXQ3     IF *G* NOT SELECTED
          SA4    IXQB        CLEAR *S* IF *G* SELECTED
          BX6    X4
 IXQ3     SA6    A6+B1       *S*  OPTION TO COMMAND
          LX1    -12         SET *G* OPTION
          BX1    X1+X5
          RJ     ZTB         CONVERT ZEROES TO BLANKS
          SX7    2RA)
          SA6    A6+B1       *G* OPTION TO COMMAND
          LX7    48
          SA1    XM          CHECK FOR MODIFY  *X*  MODE
          SA7    A6+B1       COMMAND TERMINATOR
          ZR     X1,IXQ4     IF  *X*  NOT SELECTED - RETURN
          REWIND O           REWIND OUTPUT FILE
          SA1    ZM          CHECK FOR MODIFY *Z* MODE
          NZ     X1,IXQX     IF SELECTED
          REWIND I           REWIND INPUT FILE
          EQ     IXQ4        RETURN
 
 IXQA     CON    2LI=+1R,    INPUT COMMAND STENCIL
          CON    2LL=+1R,    LIST COMMAND STENCIL
          CON    2LB=+1R,    BINARY OUTPUT COMMAND STENCIL
          CON    2LS=+1R,    *S* OPTION COMMAND STENCIL
          CON    2LG=+1R,    *G* OPTION COMMAND STENCIL
 IXQB     CON    10HS=0      ,
 IZI      SPACE  4,20
**        IZI - INITIALIZE *Z* MODE INPUT.
*
*         CLEARS THE FILE NAME IN THE *INPUT* FILE FET AND
*         ENTERS THE *Z* DIRECTIVES IN THE *INPUT* FILE
*         CIRCULAR BUFFER.
*
*         ENTRY  (ZM) = NONZERO IF *Z* MODE SELECTED.
*
*         EXIT   (I) = FILE NAME CLEARED.
*                    = CIRCULAR BUFFER PRESET WITH CONTROL STATEMENT
*                      *Z* MODE DIRECTIVES.
*
*         USES   A - 2, 6.
*                X - 2, 6.
*                B - 2, 3.
*
*         CALLS  ZAP.
 
 
 IZI      SUBR               ENTRY/EXIT
          SA2    ZM          CHECK FOR *Z* MODE
          ZR     X2,IZIX     IF NOT SELECTED, RETURN
          SA2    I           CLEAR *INPUT* FILE NAME
          MX6    -18
          BX6    -X6*X2
          SA6    A2
          SX2    A2          SET FET ADDRESS FOR *ZAP*
          RJ     ZAP         PROCESS *Z* MODE DIRECTIVES
          SA2    IW
          SX6    1R          CLEAR INPUT BUFFER
          SB2    CHAR+X2
          SB3    CHAR+IWMAX
 IZI1     EQ     B2,B3,IZIX  IF COMPLETE
          SA6    B2
          SB2    B2+B1
          EQ     IZI1        CONTINUE CLEARING BUFFER
 PCV      SPACE  4,15
**        PCV - PROCESS  *CV*  OPTION.
*
*         ENTRY  (CVT) - .NE. 0, IF *CV* OPTION SELECTED.
*
*         EXIT   (X4) - 0, IF NO ERROR.
*                (A0) - ADDRESS OF ERROR MESSAGE, IF APPROPRIATE.
*
*         USES   X - ALL.
*                A - 0, 1, 5, 6.
*                B - 2, 3, 4, 5, 7.
*
*         CALLS  DXB.
 
 
 PCV1     SA1    CSMR        SET NEW PROGRAM LIBRARY CHARACTER SET
          SX6    64B
          MI     X1,PCV2     IF SYSTEM IS 64 CHARACTER SET
          SX6    B0+
 PCV2     SA6    CNPL        CHARACTER SET OF NEW PROGRAM LIBRARY
 
 PCV      SUBR               ENTRY/EXIT
          SA5    CVT         CHECK FOR CONVERSION SPECIFIED
          BX4    X4-X4       CLEAR ERROR
          SB7    B0          SET OCTAL BASE
          ZR     X5,PCV1     IF NO CONVERSION SPECIFIED
          SA1    MAD64
          BX1    X5-X1       COMPARE CVT AND MAD64
          NZ     X1,PCV0     IF MAD64 NOT SPECIFIED
          SX6    B1
          SA6    MADCV       SET MADIFY CONVERSION FLAG
          SA1    MOD64
          BX6    X1
          SA6    CVT         TREAT AS 63 TO 64 CONVERSION
          BX5    X6          UPDATE X5 AS WELL
 PCV0     BSS    0
          RJ     DXB         CONVERT TO BINARY
          SA0    =C* CV OPTION INCORRECT.*
          NZ     X4,PCVX     IF INCORRECT  *CV*  OPTION
          SA6    A5+         SET OPTION
          SB2    X6-63B      CHECK OPTION
          BX6    X6-X6
          SA6    C           CLEAR COMPILE FILE IF CONVERTING
          ZR     B2,PCV2     IF  *63*
          SX6    64B
          EQ     B1,B2,PCV2  IF  *64*
          SX4    B1+         SET ERROR
          EQ     PCVX        IF NOT  *64*  OR  *63*
 
 MAD64    CON    5LMAD64
 MOD64    CON    2L64
 SLC      SPACE  4,20
**        SLC - SET LIST CONTROL.
*
*         EXIT   (LO) INITIALIZED.
*
*         USES   X - ALL.
*                A - 0, 1, 3, 6, 7.
*                B - 2, 3, 4.
 
 
 SLC3     SA6    LO
 
 SLC      SUBR               ENTRY/EXIT
          SX4    B1+         BIT CONSTANT
          SA1    LO          GET *LO* OPTIONS
          MX0    -6
          BX6    X6-X6       INITIALIZE RESULT REGISTER
          ZR     X1,SLCX     IF  NOT SELECTED
          SA0    =C* -LO- ERROR MUST BE IN -ECTMWDSIA-.*
          SB2    SLCA        LIST OPTION TABLE
 SLC1     LX1    6           PICK NEXT LETTER
          BX5    -X0*X1
          ZR     X5,SLC3     IF COMPLETE
          SB3    B0+
 SLC2     SA3    B2+B3       GET NEXT OPTION
          BX2    X5-X3       COMPARE
          ZR     X3,ABT1     IF END OF OPTION TABLE
          SB3    B3+B1       ADVANCE INDEX
          NZ     X2,SLC2     IF NO MATCH
          SB4    B3-B1
          LX7    X4,B4
          BX6    X6+X7       ADD CURRENT OPTION
          EQ     SLC1        LOOP FOR NEXT LETTER
 
 SLCA     BSS    0           OPTION TABLE
 OPTION   HERE
          CON    0           END OF TABLE
 SMM      SPACE  4,20
**        SMM - SET MODIFICATION MODE.
*
*         SET MODIFICATION MODE ACCORDING TO  *F*  AND
*         *U*  OPTIONS.  THE  *F*  OPTION OVER-RIDES THE
*         *U*  OPTION.
*
*         EXIT   (UM) INITIALIZED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
 
 
 SMM      SUBR               ENTRY/EXIT
          SA1    FM
          SA2    UM
          BX6    X6-X6       SET TO CLEAR  *U*  MODE
          NZ     X1,SMM1     IF  *F*  MODE SELECTED
          BX6    X2          RESET  *U*  MODE
 SMM1     SA6    A2          CLEAR/SET  *U*  MODE
          EQ     SMMX        RETURN
SOF       SPACE  4,20
**        SOF - SET OUTPUT FORMAT.
*
*         SET TERMINAL OUTPUT FLAG AND DEFAULT LIST OPTIONS.
*
*         ENTRY  (LO) = CONTROL STATEMENT *LO* PARAMETERS.
*                     = 0 IF OMITTED.
*
*         EXIT   (LO) = LIST OPTION BIT MAP.
*                     = DEFAULT OPTIONS IF OMITTED FROM
*                       CONTROL STATEMENT.
*                (TO) = 0 IF OUTPUT ASSIGNED TO
*                       INTERACTIVE TERMINAL.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*
*         CALLS  SLC, STF.
 
 
 SOF      SUBR               ENTRY/EXIT
 
*         SET TERMINAL FILE DEFAULT OPTIONS.
 
          SX2    O           CHECK OUTPUT FILE RESIDENCE
          RJ     STF
          SA6    TO          SET TERMINAL OUTPUT FLAG
          SA2    SOFA
          ZR     X6,SOF2     IF ASSIGNED TO TERMINAL
 
*         SET NON-TERMINAL FILE DEFAULT OPTIONS.
 
          SA1    XM
          NZ     X1,SOF2     IF *X* PARAMETER SELECTED
          SA2    SOFB        SET *X* DEFAULT OPTIONS
 
*         PROCESS SPECIFIED OR DEFAULT OPTIONS.
 
 SOF2     SA1    LO          READ CONTROL STATEMENT OPTIONS
          NZ     X1,SOF3     IF OPTIONS ENTERED
          BX6    X2          STORE DEFAULT OPTIONS
          SA6    A1
 SOF3     RJ     SLC         SET LIST CONTROLS
          EQ     SOFX        RETURN
 
 SOFA     CON    0LE         DEFAULT TERMINAL OPTIONS
 SOFB     CON    0LECTMWDS   DEFAULT NON-TERMINAL OPTIONS
 COMMON   SPACE  4,10
**        PRESET COMMON DECKS.
 
 
 QUAL$    EQU    1           PREVENT QUALIFICATION
*CALL     COMCARG
*CALL     COMCCPM
*CALL     COMCSTF
*CALL     COMCUSB
*CALL     COMCZAP
*CALL     COMCZTB
 MODIFY   TTL    MODIFY - SOURCE LIBRARY EDITING PROGRAM.
          SPACE  4
*CALL     COMCLFM
          END    MODIFY   SOURCE LIBRARY EDITING PROGRAM