MODIFY
          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
