*DECK UPDATE
          IDENT  UPDATE,ORGP,UPDATE 
          LIST   F
**DOCK    TITLE  SPACE,4,10                                             01254120
**DOCK    EJECT  4,10                                                   01254121
*         CONTROL DATA PROPRIETARY PRODUCT. 
*         COPYRIGHT CONTROL DATA CORP. 1971, 1972, 1973, 1974, 1975,
*                                      1976, 1977, 1978, 1979, 1980,
*                                      1981, 1982.
          TITLE  PROGRAM LIBRARY MAINTENANCE PROGRAM - UPDATE           01257462
          SPACE  1
          ABS 
          SPACE  1
          SPACE  1
*********************************************************************** 
*                                                                     * 
*           MODIFICATION OF 6000 UPDATE V1.2 FOR 7000 SCOPE V2        * 
*                                                                     * 
*                                                                     * 
* 1.0 GENERAL                                                         * 
*                                                                     * 
*     THE FOLLOWING GUIDELINES WERE USED IN CONVERTING 6000 UPDATE 1.2* 
*     FOR THE 7000 SCOPE V2 OPERATING SYSTEM                          * 
*                                                                     * 
*     1.1 THE RESULTING PRODUCT SHOULD EXECUTE UNDER VERSION 2 OF THE * 
*         7000 SCOPE OPERATING SYSTEM.                                * 
*                                                                     * 
*     1.2 EXTERNAL FEATURES SHOULD REMAIN THE SAME.                   * 
*                                                                     * 
*     1.3 MODIFICATIONS SHOULD BE LOCALIZED TO AS GREAT AN EXTENT AS  * 
*         POSIBLE IN ORDER THAT 6000 PSR REPLIES MAY BE EASILY        * 
*         INCORPORATED INTO THE MODIFIED PROGRAM.                     * 
*                                                                     * 
*                                                                     * 
* 2.0 EXTENT OF MODIFICATIONS                                         * 
*                                                                     * 
*     2.1 SYSTEM ACTION REQUESTS                                      * 
*         6000 SYSTEM ACTION REQUEST MACROS AND ROUTINES WERE MODIFIED* 
*         OR REPLACED WITH 7000 SYSTEM ACTION REQUEST MACROS.         * 
*                                                                     * 
*     2.2 I/O OPERATIONS                                              * 
*         ALL I/O ROUTINES WERE MODIFIED TO INTERFACE WITH THE 7000   * 
*         RECORD MANAGER (7RM).  THE 6000 I/O  MACROS WERE MODIFIED   * 
*         TO INTERFACE WITH THE 7000 I/O ROUTINES.  IN ADDITION, SOME * 
*         NEW I/O INTERFACE ROUTINES WERE ADDED.                      * 
*         FILE FETS WERE RETAINED AND WERE LINKED TO ASSOCIATED 7RM   * 
*         FITS.  BUFFERS FOR CODED FILES WERE ELIMINATED BUT BUFFERS  * 
*         FOR BINARY FILES WERE RETAINED.                             * 
*                                                                     * 
*                                                                     * 
* 3.0 FILE STRUCTURES FOR 7000 SCOPE V2 UPDATE                        * 
*                                                                     * 
*     UPDATE IS CONCERNED WITH TWO FILE TYPES - SEQUENTIAL AND RANDOM * 
*     AND TWO FILE MODES - CODED AND BINARY.                          * 
*                                                                     * 
*     3.1 CODED FILES                                                 * 
*         CODED FILES MAY BE RECORD TYPE W OR Z WITH EACH RECORD      * 
*         CONSISTING OF A CARD OR LINE IMAGE.  A RECORD IS WRITTEN OR * 
*         READ  BY EXECUTION OF A PUTW OR GETW MACRO.  ALL CODED FILES* 
*         ARE SEQUENTIAL FILES.                                       * 
*                                                                     * 
*     3.2 BINARY FILES                                                * 
*         BINARY FILES MAY BE RECORD TYPE W OR S.  THE MAXIMUM AMOUNT * 
*         OF DATA TRANSFERRED BETWEEN UPDATE AND 7RM BY ANY ONE CALL IS 
*         512 (DECIMAL) WORDS.  W-TYPE RECORDS ARE LIMITED TO 512     * 
*         WORDS IN LENGTH.  A BINARY RECORD AS SEEN BY UPDATE IS A 7RM* 
*         SECTION (WHICH MAY CONSIST OF ANY NUMBER OF W-TYPE RECORDS).* 
*                                                                     * 
*     3.3 SEQUENTIAL AND RANDOM FILES                                 * 
*         ALL FILES PROCESSED BY 7000 SCOPE V2 UPDATE ARE SEQUENTIAL  * 
*         IN STRUCTURE.  HOWEVER, CERTAIN FILES MAY BE ACCESSED BY    * 
*         UPDATE IN A RANDOM MANNER PROVIDING THAT THEY ARE RECORD TYPE 
*         W AND ARE NOT BLOCKED.  DURING THE GENERATION OF A SO-CALLED* 
*         RANDOM FILE, THE WORD ADDRESS OF THE BEGINNING OF EACH      * 
*         UPDATE RECORD (7RM SECTION) IS RETURNED TO UPDATE BY THE    * 
*         MODIFIED I/O ROUTINES.  WHEN A RANDOM FILE IS CLOSED,AND A  * 
*         6000 TYPE INDEX SPECIFIED, THE INDEX IS WRITTEN AS THE LAST * 
*         W-FORMAT RECORD OF THE FILE.  THIS INDEX RECORD IS SIMILAR  * 
*         TO A 6000 SCOPE RANDOM FILE INDEX RECORD EXCEPT THAT TWO    * 
*         WORDS ARE ADDED AT THE BEGINNING OF THE RECORD.             * 
*                WORD 1  BITS 59-18 = DIRECT$ IN DISPLAY CODE         * 
*                        BITS 17-00 = 0                               * 
*                WORD 2 LENGTH OF THE INDEX (RECORD LENGTH - 2)       * 
*                                                                     * 
*         WHEN A RANDOM FILE IS OPENED, THE OPEN76 ROUTINE CHECKS THE * 
*         LAST RECORD OF THE FILE FOR DIRECT$ IN THE FIRST WORD.  IF  * 
*         THE INDEX RECORD IS PRESENT, THE INDEX IS READ INTO THE     * 
*         INDEX AREA SPECIFIED BY THE FILE FET.                       * 
*                                                                     * 
*         DURING THE READING OF A RANDOM FILE, UPDATE SETS INTO THE   * 
*         FET THE WORD ADDRESS OF THE BEGINNING OF THE RECORD(SECTION)* 
*         TO BE READ.   THE POSITION MACRO IS EXECUTED WITH THIS      * 
*         ADDRESS AS A PARAMETER BEFORE READING THE RECORD.           * 
*                                                                     * 
*********************************************************************** 
          TITLE 
  
          SPACE  4
**        UPDATE                                                        01256859
*                                                                       01256860
*         6000 SERIES SOURCE LANGUAGE LIBRARY MAINTAINENCE PROGRAM      01256861
*                                                                       01256862
*         UPDATE IS AN ABSOLUTE CP PROGRAM CALLED BY THE SYSTEM CONTROL 01256863
*         CARD UPDATE (PARAM).  UPDATE REQUIRES A MINIMUM OF 35000B     01256864
*         WORDS OF CM.  ALL SYSTEM INTERFACE IS HANDLED THROUGH RA+1.   01256865
*         UPDATE IS NEARLY ALWAYS A TWO PASS PROCESS.  PASS 1 READS     01256866
*         INPUT AND CREATES INTERNAL TABLES WHICH ARE USED TO GUIDE PASS01256867
*         2 OPERATIONS.  CODE USED ONLY IN PASS 1 IS ASSEMBLED AND      01256868
*         EXECUTED IN FILE BUFFERS WHICH ARE NOT USED AS BUFFERS UNTIL  01256869
*         PASS 2.  PASS 1 IS ASSEMBLED IN OVERLAY BLOCK, PASS 2 CODE IN 01256870
*         PROGRAM BLOCK.  IN PASS 2, OVERLAY BLOCK IS USED FOR BUFFERS. 01256871
* 
*         UPDATE BUILD INFORMATION--
* 
*         UPDATE REQUIRES THE COMPASS OLDPL AS A SECONDARY PL 
*          IN ORDER TO GET THE COMMON-COMMON-DECKS FOR I/O
* 
*         IPTEXT AND CPUTEXT ARE REQUIRED FOR ALL BUILD ASSEMBLIES. 
*         PFMTEXT IS REQUIRED FOR NOS/BE ASSEMBLIES, IN ADDITION. 
* 
*         A DEBUG VERSION OF UPDATE (USING IDP) CAN BE GENERATED BY 
*          *DEFINE-ING =UPDEBUG= WHEN UPDATING, AND ADDITIONALLY
*          PROVIDING THE IDP OLDPL AND ANY NECESSARY TEXT OLDPLS. 
  
  
          B1=1
          SST 
          IPARAMS 
*IF DEF,UPDEBUG 
*CALL DBG=MAC 
*ENDIF
  
  
**
* 
*         ENVIRONMENT 
* 
*         THE ENV MACRO IS USED TO SELECT CONDITIONAL CODE BASED ON 
*         OPERATING SYSTEM DIFFERENCES.  THE SYMBOLS ENV1-ENV11 ARE 
*         SET TO 1 TO INDICATE A PARTICULAR SYSTEM. 
* 
*         ENV1   NOS         ENV7, ENV8, ENV9, SPARES 
*         ENV2   SCOPE 2 (7600)    ENV3        SPARE
*         ENV4   NOS/BE      ENV5, ENV6        SPARES 
* 
*         ENV10  SET IF -SCOPE33- IS DEFINED.  THIS ENABLES $ STRINGS 
* 
*         ENV11  SET IF -SCOPE33=1-  USED FOR DOWNWARD COMPATIBILITY
          SPACE  2
 CP#RM    EQU    1
 SCOPE33  EQU    34 
 NOT      SET    1
 ACT      SET    0
 ENV      MACRO  Y,ENVI,X 
          IRP    ENVI 
 X        IFEQ   ENV_ENVI,0 
          IRP 
 FLG      SET    1
 X        ELSE
 FLG      SET    0
 X        ENDIF 
 X        IFEQ   FLG,Y
          ENDM
          ECHO   1,P=(1,2,3,4,5,6,7,8,9,10,11)
 ENV_P    SET    0
  
*         DETERMINE SYSTEM
  
          IFC    EQ,*"OS.NAME"*KRONOS*
 ENV1     SET    1           ASSEMBLED IF NOS 
          ELSE
 SCP      IFC    EQ,*"OS.VER"*2.1 * 
 ENV2     SET    1           ASSEMBLED IF SCOPE 2 
 SCP      ELSE
 ENV4     SET    1           ASSEMBLED IF NOS/BE
          ENDIF 
          IF     -DEF,SCOPE33 
 ENV11    SET    1
          ELSE
          IFEQ   SCOPE33,1
 ENV10    SET    1
          ENDIF 
  
  
          ENV    ACT,(1,7,8,9),X
          ENTRY  UPDATE 
          ENTRY  RFL= 
RFL=      EQU    35000B 
ORGP      EQU    101B+2 
          ELSE
ORGP      EQU    101B 
          ENDIF 
  
  
          ORG    ORGP 
          SPACE  4
**        THE UPDATE VERSION AND MODIFICATION LEVEL.
*         PLACED IN HEADER LINE OF EACH LISTING PAGE. 
  
 VERSION  MICRO  1,3,*1.4*
 PSRLEVEL MICRO  1,3,*871*
  
          IFC    EQ,*"MODLEVEL"*"JDATE"*,2
 VERSION  MICRO  1,7,*"VERSION"-"PSRLEVEL"*       NO ML=PARAMETER 
          SKIP   1
 VERSION  MICRO  1,7,*"VERSION"-"MODLEVEL"* 
          EJECT  4                                                      01256872
          TITLE  UPDATE MACROS
**        MACROS                                                        01254123
*                                                                       01254124
*                                                                       01254125
* CALL COMCMTM               MANAGE TABLE MACROS
*CALL COMCMTM 
          SPACE  4
**        CHKFILE FILE                                                  01254154
*                                                                       01254155
*         LOADS A1 WITH FET FWA AND GENERATES A RETURN JUMP TO THE      01254156
*         SUBROUTINE CHKFILE                                            01254157
*                                                                       01254158
*         ENTRY  FILE - FET ADDRESS OF FILE                             01254159
          SPACE  1
CHKFILE   MACRO  FILE 
          =A1    FILE 
          RJ     CHKFILE
          ENDM
          SPACE  2
**        CLASIFY                                                       01254161
*                                                                       01254162
*         LOADS A1 WITH CURCARD AND SETS CCKEY TO ZERO. A CALL TO       01254163
*         CLASIFY SHOULD PRECEDE A CALL TO CCJUMP IF X1 HAS BEEN        01254164
*         DISTURBED SINCE LAST CCJUMP CALL.                             01254165
          SPACE  1
CLASIFY   MACRO 
          SA1    CURCARD
CCKEY     SET    0
          ENDM
          SPACE  2
**        PRINT  FWA,LGN                                                01254167
*                                                                       01254168
*         SETS UP ENTRY INFORMATION FOR PRINT ROUTINE AND GENERATES A   01254169
*         RJ TO SUBROUTINE PRINT                                        01254170
*                                                                       01254171
*         ENTRY  FWA - FIRST WORD ADDRESS OF CHARACTER STRING BOUNDED   01254172
*                      BY DELIMITERS TO BE PRINTED                      01254173
*                LGN - LENGTH OF CHARACTER STRING. IF OMITTED LENGTH IS 01254174
*                      CALCULATED BY DEFINING FWA AS A MICRO, THEN      01254175
*                      USING THIS LENGTH. 
 PRINT    MACRO  FWA,LGN,LFN
Q         IFC    EQ,$LGN$$
 NAME=    MICRO  1,,$FWA$ 
 CNTR=    MICCNT NAME=
 CNTR=    SET    CNTR=+9
          =B7    CNTR=/10 
          =B6    =H$FWA$
 Q        ELSE
          =B7    LGN
          =B6    FWA
 Q        ENDIF 
          =A0    LFN OUTPUT 
          RJ     PRINT
          ENDM
          SPACE  2
 PRNTCARD MACRO  LFN
          =A0    LFN OUTPUT 
          RJ     PRNTCARD 
          ENDM
          SPACE  2
**        CCJUMP NAM,ADR                                                01254188
*                                                                       01254189
*         CREATES A LEFT SHIFT OF X1 SO THAT THE FLAG BIT FOR THE       01254190
*         DESIRED CARD TYPE IS IN BIT 59, AND A NEGATIVE JUMP TO THE    01254191
*         APPROPRIATE ADDRESS TO PROCESS THAT CONTROL CARD. THE CELL    01254192
*         CCKEY IS USED TO REMEMBER HOW FAR THE CONTENTS OF X1 (CURCARD)01254193
*         HAVE BEEN SHIFT SINCE THE LAST TIME THE CLASIFY MACRO WAS     01254194
*         CALLED. IF THE CURRENT CARD IS A CONTROL CARD, THE APPROPIATE 01254195
*         BIT IS SET. IF THE CARD IS NOT A CONTROL CARD, CURCARD IS SET 01254196
*         TO ZERO.                                                      01254197
*                                                                       01254198
*         ENTRY  NAM - NAME OF SOME UPDATE CONTROL CARD                 01254199
*                ADR - ADDRESS WHERE SPECIFIED CONTROL CARD IS PROCESSED01254200
          SPACE  1
CCJUMP    MACRO  NAM,ADR
CCKEY     SET    59+CCKEY-NAM 
          IFGT   CCKEY,60,1 
CCKEY     SET    CCKEY-60 
          LX1    CCKEY
          NG     X1,ADR 
CCKEY     SET    NAM+1
          ENDM
          SPACE  2
**        CLEAR  LFN                                                    01254216
*                                                                       01254217
*         LOADS FIRST WORD ADDRESS OF FET INTO A1 AND GENERATES A RJ TO 01254218
*                                                                       01254219
*         SUBROUTINE CPCLEAR                                            01254220
*                                                                       01254221
*         ENTRY  LFN - NAME OF FILE TO BE CLEARED                       01254222
*                OP  - OPCODE TO SET INTO FET (COMPLETE)
          SPACE 
 CLEAR    MACRO  LFN,OP 
 '?CIO#FC SET    1
          ECHO   3,P=(READ,WRITE,WRITER),Q=(13B,17B,27B)
          IFC    EQ,/P/OP/,2
 '?CIO#FC SET    Q
          STOPDUP 
          =X5    '?CIO#FC 
          =X2    LFN
          RJ     CPCLEAR
          ENDM
          SPACE  2
          SPACE  2
**        TABL   WORD,ABB,NUM                                           01254240
*                                                                       01254241
*         GENERATES 2 CM WORD ENTRIES FOR ABBREVIATION TABLE.           01254242
*                                                                       01254243
*         ENTRY  WORD - EXPANDED UPDATE DIRECTIVE                       01254244
*                ABB - ONE OR TWO CHARACTER ABBREVIATION                01254245
*                NUM - NUMBER OF CHARACTERS IN WORD                     01254246
*         EXIT   ENTRY WORD 1 - ABB RIGHT JUSTIFIED                     01254247
*                ENTRY WORD 2 - VFD 54/0RWORD,6/NUM                     01254248
          SPACE  1
TABL      MACRO  WORD,ABB,NUM 
+         VFD    60/0R_ABB
+         VFD    54/0L_WORD,6/NUM 
          ENDM
          SPACE  2
**        PARAM  NAME,LABEL,SPEC                                        01254270
*                                                                       01254271
*         CREATES ENTRIES IN THE PARAMETER TABLE USED BY SUBROUTINE     01254272
*         CLASSIFY. DEFINES THE NAME OF EACH OF THE UPDATE DIRECTIVES   01254273
*         AS ITS POSITION WITHIN THE PARAM TABLE.                       01254274
*                                                                       01254275
*         ENTRY  NAME - NAME OF UPDATE DIRECTIVE                        01254276
*                LABEL - IF DEFINED, IS EQUATED TO CURRENT POSITION IN  01254277
*                        PARAMETER TABLE                                01254278
*                SPEC - IF DEFIND, NO TABLE ENTRY IS MADE BUT NAME      01254279
*                        IS STILL DEFINED.                              01254280
          SPACE  1
PARAM     MACRO  NAME,LABEL,SPEC
          IF     DEF,SNUM,1 
SNUM      SET    SNUM+1 
          IF     -DEF,SNUM,1
SNUM      SET    0
NAME      EQU    SNUM 
          IFC    EQ,$$SPEC$,4 
          IFC    EQ,$$LABEL$,1
+         VFD    54/0L_NAME,6/SNUM
          IFC    NE,$$LABEL$,1
LABEL     VFD    54/0L_NAME,6/SNUM
          ENDM
          SPACE  2
**        VOID
* 
*         VOIDS STACK ON CY176 MACHINES 
*         SO ENTRY POINT STUFFING WILL WORK 
          SPACE  1
 VOID     MACRO 
          RJ     *+1         VOID THE STACK 
+         DATA   0
          ENDM
          SPACE  4
**        READWC, WRITEWC 
* 
*         SIMILAR TO READW, WRITEW, EXCEPT THAT 
*         THE CHECKSUMMING ROUTINES ARE USED. 
  
 READWC   MACRO  FILE,BUF,N 
  '?CIO#M3  FILE,(BUF),N,RDWC 
          ENDM
  
 WRITEWC  MACRO  FILE,BUF,N 
  '?CIO#M3  FILE,(BUF),N,WTWC 
          ENDM
          SPACE  4
  
          ENV    ACT,(2,3),VER2 
          SPACE  4
**        '?7IO#M3, '?CIO#M3
* 
*         REPLACES '?CIO#M3 MACRO 
*         (USED BY READW, READWC, READC, WRITEW, WRITEWC, WRITEC) 
* 
*         SETS B2 = 0 IF BUFFER IS IN SCM 
*                 = 1 IF BUFFER IS IN LCM 
          SPACE  1
 '?7IO#M3 OPSYN  '?CIO#M3 
          PURGMAC '?CIO#M3
 '?CIO#M3 MACRO  FILE,BUF,N,WHO,LCM 
          =B2    LCM 0
  '?7IO#M3 FILE,(BUF),N,WHO 
          ENDM
          SPACE  2
**        RBINCL, RBINL, WBINCL, WBINL
* 
*         SIMILAR TO READWC, READW, WRITEWC, WRITEW 
*         EXCEPT THAT BUFFER IS IN LCM
          SPACE  1
 RBINCL   MACRO  FILE,BUF,N 
  '?CIO#M3 FILE,(BUF),N,RDWC,1
          ENDM
          SPACE  1
 RBINL    MACRO  FILE,BUF,N 
  '?CIO#M3 FILE,(BUF),N,RDW,1 
          ENDM
          SPACE  1
 WBINCL   MACRO  FILE,BUF,N 
  '?CIO#M3 FILE,(BUF),N,WTWC,1
          ENDM
          SPACE  1
 WBINL    MACRO  FILE,BUF,N 
  '?CIO#M3 FILE,(BUF),N,WTW,1 
          ENDM
          SPACE  2
* 
*********************************************************************** 
*    OPEN MACRO.  OPEN FILE FOR SUBSEQUENT PROCESSING.  PARAMETERS    * 
*    ARE FET ADDRESS (FILE) AND FILE TYPE (TYPE).  ACCEPTABLE FILE    * 
*    TYPE DESIGNATORS ARE WRITE,READ,OR ALTER.  A FILE TYPE DESIGNATOR* 
*    MAY HAVE THE LETTERS NR APPENDED INDICATING NO REWIND AT OPEN    * 
*    TIME.  THE MACRO SETS A0 TO THE FET ADDRESS, X6 TO THE 7DM FILE  * 
*    PROCESSING DIRECTION CORRESPONDING TO THE SPECIFIED TYPE, AND    * 
*    X7 TO ZERO IF NO REWIND IS SPECIFIED.  SUBROUTINE OPEN76 IS      * 
*    CALLED.                                                          * 
*********************************************************************** 
          SPACE  1
          PURGMAC  OPEN 
 OPEN     MACRO  F,T
          LOCAL  L,N1,N2
          R=     A0,F 
 N1       MICRO  1,,*T* 
 L        MICCNT N1 
 N2       MICRO  L-1,2,*T*
          IFC    EQ,*"N2"*NR*,3 
          SX7    B0 
 N1       MICRO  1,L-2,*T*
          IFNE   ,,1
          SX7    B1 
          IFC    EQ,*"N1"*WRITE*,1
          SX6    #OUTPUT# 
          IFC    EQ,*"N1"*READ*,1 
          SX6    #INPUT#
          IFC    EQ,*"N1"*ALTER*,1
          SX6    #IO# 
          RJ     OPEN76 
          ENDM
          SPACE  4
*********************************************************************** 
*    READ MACRO.  FILL BINARY BUFFER.                                 * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS  * 
*    AND READ76 IS CALLED TO FILL BUFFER.                             * 
*********************************************************************** 
          SPACE  1
          PURGMAC  READ 
 READ     MACRO  FILE,RECALL
          R=     A0,FILE
          RJ     READ76 
          ENDM
          SPACE  4
          SPACE  4
*********************************************************************** 
*    WRITER MACRO.   WRITE END-OF-RECORD ON FILE                      * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS  * 
*    AND WEOR76 IS CALLED.                                            * 
*********************************************************************** 
          SPACE  1
          PURGMAC WRITER
 WRITER   MACRO  F,RECALL,LEVEL 
          R=     A0,F 
          RJ     WEOR76 
          ENDM
          SPACE  4
*********************************************************************** 
*    WRITEF MACRO.   WRITE END-OF-FILE                                * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS  * 
*    AND WEOF76 IS CALLED.                                            * 
*********************************************************************** 
          SPACE  1
          PURGMAC  WRITEF 
 WRITEF   MACRO  F,RECALL 
          R=     A0,F 
          RJ     WEOF76 
          ENDM
          SPACE  4
*    REWIND MACRO.   REWIND FILE.                                     * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS  * 
*    AND REWIND76 IS CALLED.                                          * 
*********************************************************************** 
          SPACE  1
          PURGMAC  REWIND 
  
 REWIND   MACRO  F,RECALL 
          R=     A0,F 
          RJ REWIND76 
          ENDM
          SPACE  4
*********************************************************************** 
*    CLOSE MACRO.  CLOSE FILE.
*    PARAMETERS ARE ADDRESS OF FILE FET (F) AND REWIND REQUEST(RECALL)* 
*    A0 IS SET TO FET ADDRESS AND X7 IS SET TO NON-ZERO IF THE RECALL * 
*    PARAMETER = REWIND INDICATING FILE IS TO BE REWOUND.  CLOSE76    * 
*    IS CALLED.                                                       * 
*********************************************************************** 
          SPACE  1
          PURGMAC  CLOSE
 CLOSE    MACRO  F,REQ
          =A0    F
 CLV.     IFC    EQ,/REQ/REWIND/
          =X7    1
 CLV.    ELSE 
 CLV1.    IFC    EQ,/REQ/UNLOAD/
          =X7    -1 
 CLV1.    ELSE
          =X7    0
 CLV1.    ENDIF 
 CLV.     ENDIF 
          RJ     CLOSE76
          ENDM
          SPACE  4
*********************************************************************** 
*    EVICT MACRO.   EVICT FILE.                                       * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS, * 
*    X7 IS SET NEGATIVE INDICATING UNLOAD, AND CLOSE76 IS CALLED.     * 
*********************************************************************** 
          SPACE  1
          PURGMAC EVICT 
 EVICT    MACRO  F
          R=     A0,F 
          SX7    -B1
          RJ     CLOSE76
          ENDM
          SPACE  4
*********************************************************************** 
*    BKSP MACRO.  SKIP BACK ONE LOGICAL RECORD.                       * 
*    PARAMETER IS ADDRESS OF FILE FET.                                * 
*********************************************************************** 
          SPACE  1
          PURGMAC BKSP
 BKSP     MACRO  FILE 
          LOCAL  A
          SA1    FILE+FETFIT
          SA3    X1 
          ZR     X3,A              IF NOT OPENED
          STORE  X1,DX=0
          SKIPBL X1,1 
A         BSS 
          ENDM
          SPACE  4
*********************************************************************** 
*    UNLOAD MACRO.   UNLOAD FILE.                                     * 
*    PARAMETER IS ADDRESS OF FILE FET (F).  A0 IS SET TO FET ADDRESS, * 
*    X7 IS SET NEGATIVE INDICATING UNLOAD, AND CLOSE76 IS CALLED.     * 
*********************************************************************** 
          SPACE  1
          PURGMAC UNLOAD
 UNLOAD   MACRO  F
          R=     A0,F 
          SX7    -B1
          RJ     CLOSE76
          ENDM
* 
          SPACE  4
*********************************************************************** 
*    RECALL MACRO.  NOT NEEDED BY SCOPE 2                             * 
*********************************************************************** 
          SPACE  1
          PURGMAC RECALL
          MACRO  RECALL,L,F 
          IFC    NE,/L//,1
 L  BSS  0
          ENDM
VER2      ENDIF 
  
          SPACE  2
**        READPL NAME                                                   01254302
*                                                                       01254303
*         CREATES A LABELED RJ TO ROUTINE ROPL. THE LABEL IS NECESSARY  01254304
*         IN ORDRR TO EASILY ALTER THIS JUMP TO A JUMP TO READOPL.      01254305
*                                                                       01254306
*         ENTRY  NAME - LABEL TO BE GIVEN RJ INSTRUCTION                01254307
          SPACE  1
READPL    MACRO  NAME 
READPL_NAME   RJ     ROPL 
          ENDM
          SPACE  2
  
  
*                                                                       01254310
*         CREATES 13 WORD FETS                                          01254311
*                                                                       01254312
*         ENTRY  NAME - FILE NAME TO BE PLACED IN FET                   01254313
*                MODE - 0 FOR BINARY FETS, 1 FOR CODED FETS             01254314
*                RANDOM - 0 FOR SEQUENTIAL FILES, 1 FOR RANDOM FILES    01254315
*                LETTER - THE FOURTH LETTER OF THE FOUR LETTER NAME     01254316
*                         OF THE BUFFER TO BE USED                      01254317
*                FUDGE - SPECIAL PARAMETER FOR COMPILE FILE             01254318
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
FET       MACRO  NAME,MODE,RANDOM,LETTER,FUDGE,LINK,LCMF
VER2      ELSE
FET       MACRO  NAME,MODE,RANDOM,LETTER,FUDGE,LCMF 
VER2      ENDIF 
  
          IFC    NE,$$FUDGE$,1
FUDGE     VFD    42/0L_NAME,18/2*MODE+1 
          IFC    EQ,$$FUDGE$,1
NAME      VFD    42/0L_NAME,18/2*MODE+1 
          VFD    13/RANDOM,29/8,18/BUF_LETTER 
          VFD    60/BUF_LETTER
          VFD    60/BUF_LETTER
          VFD    60/BUF_LETTER+LBUF_LETTER
          VFD    38/,1/LCMF,21/ 
          CON    0
          VFD    24/0,18/1,18/BUFINDX 
          BSSZ   5
  
          ENV    ACT,(2,3),VER2 
          CON    LINK 
VER2      ENDIF 
  
          ENDM
          SPACE  2
**        FETC, RFETC, FETB, RFETB NAME,LETTER,FUDGE                    01254320
*                                                                       01254321
*         CALL FET MACRO WITH PROPER PARAMETERS SET TO GENERATE FETS    01254322
*                                                                       01254323
*         ENTRY  NAME - SAME AS FOR FET MACRO                           01254324
*                LETTER - SAME AS FOR FET MACRO                         01254325
*                FUDGE - SAME AS FOR FET MACRO                          01254326
          SPACE  1
*    BINARY SEQUENTIAL FILE                                            *
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
FETB      MACRO  N,LT,LI,LF 
          FET    N,U,0,LT,,LI,LF
VER2      ELSE
 FETB     MACRO  NAME,LETTER,FUDGE
          FET    NAME,1,0,LETTER,FUDGE
VER2      ENDIF 
  
          ENDM
          SPACE  1
*    CODED SEQUENTIAL FILE                                             *
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
FETC      MACRO  N,LT,AD,LI,LF
          FET    N,0,0,LT,AD,LI,LF
VER2      ENDIF 
  
          ENDM
          SPACE  1
*    BINARY RANDOM FILE                                                *
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
RFETB     MACRO  N,LT,LI,LF 
          FET    N,1,1,LT,,LI,LF
VER2      ELSE
 RFETB    MACRO  NAME,LETTER,FUDGE
          FET    NAME,1,1,LETTER,FUDGE
VER2      ENDIF 
  
          ENDM
          SPACE  2
**        OPTS   LET,NOR,LOC,NUM                                        01254332
*                                                                       01254333
*         CREATES ENTRIES FOR OPTIONS TABLE                             01254334
*                                                                       01254335
*         ENTRY  LET - OPTION TO BE SEARCHED FOR ON CONTROL CARD        01254336
*                NOR - NORMAL PARAMETER TO BE PLACED IN CELL SPECIFIED  01254337
*         BY LOC                                                        01254338
*                LOC - CELL TO BE MODIFIED WHEN PARAMETER IS GIVEN      01254339
*                NUM - NUMBER OF ALLOWABLE PARAMETER CHARACTERS         01254340
          SPACE  1
OPTS      MACRO  LET,NOR,LOC,NUM
          VFD    6/1R_LET,18/=0L_NOR,18/6*NUM,18/LOC
          ENDM
          ENDM
          TITLE 
          EJECT 
**        UPDATE TABLES                                                 01254342
*                                                                       01254343
*         STATIC TABLES                                                 01254344
*                                                                       01254345
**        CLASSIFY CONTROL WORD TABLE                                   01254354
*                                                                       01254355
*         CONSISTS OF ENTRIES CREATED BY CALLS TO PARAM MACRO.  PARMLIST01254356
*         DEFINES THE BEGINNING OF THE TABLE.  FIRST TWO ENTRIES MUST BE01254357
*         DECK AND COMDECK.  ALL DIRECTIVES WHICH ARE PLACED ON THE     01254358
*         PROGRAM LIBRARY (THE CARDS HAVE SEQUENCE NUMBERS) MUST APPEAR 01254359
*         BEFORE ANY OTHER ENTRIES.  SPARLIST DEFINES THE NUMBER OF     01254360
*         ENTRIES WHICH FALL IN THIS FIRST CATAGORY.  LPARLIST DEFINES  01254361
*         TOTAL LENGTH OF TABLE.  THE LAST ENTRY MUST BE THE SPECIAL    01254362
*         ENTRY FOR THE /, REFERRED TO AS SLASH.  TABLE IS IN PROGRAM   01254363
*         BLOCK.                                                        01254364
          SPACE  1
PARMLIST  BSS    0
          PARAM  DECK 
          PARAM  COMDECK
          PARAM  TEXT,ENDOTEXT                                          0081   8
          PARAM  ENDTEXT                                                0081   9
          PARAM  YANK 
          PARAM  SELYANK
          PARAM  CALL 
          PARAM  WEOR 
          PARAM  CWEOR
          PARAM  YANKDECK 
          PARAM  DEFINE 
          PARAM  DO 
          PARAM  DONT 
          PARAM  IF 
          PARAM  ENDIF
          PARAM  WIDTH
SPARLIST  EQU    *-PARMLIST 
          PARAM  DELETE 
          PARAM  INSERT 
          PARAM  IDENT
          PARAM  RESTORE
          PARAM  BEFORE 
          PARAM  PURGE
          PARAM  LIST 
          PARAM  SEQUENCE 
          PARAM  MOVE 
          PARAM  SKIP 
          PARAM  READ 
          PARAM  ADDFILE
          PARAM  NOLIST 
          PARAM  CHANGE 
          PARAM  ABBREV 
          PARAM  NOABBREV 
          PARAM  REWIND 
          PARAM  END
          PARAM  COMPILE
          PARAM  SELPURGE 
          PARAM  COPY 
          PARAM  PURDECK
          PARAM  DECLARE
          PARAM  PULLMOD
          PARAM  LIMIT
          PARAM  SLASH,,X 
LPARLIST  EQU    *-PARMLIST 
          EJECT  1                                                      01257443
          USE    OVERLAY
          SPACE  1
PASS2     EQU    *
          SPACE  1
**        ABBREVIATION TABLE                                            01254366
*                                                                       01254367
*         TAB1 CONTAINS ENTRIES FOR DIRECTIVES WHICH HAVE ONE CHARACTER 01254368
*         ABBREVIATIONS.  LTAB1 DEFINES LENGTH OF TAB1.  TAB2 CONTAINS  01254369
*         ENTRIES FOR DIRECTIVES WHICH HAVE TWO CHARACTER ABBREVIATIONS.01254370
*         LTAB2 DEFINES LENGTH OF TAB2.  BOTH TABLES CONSIST OF ENTRIES 01254371
*         CREATED BY TABL MACRO CALLS, 2 WORDS/ENTRY.  THESE TABLES ARE 01254372
*         SEARCHED BY PROCABB AND ARE IN OVERLAY BLOCK.                 01254373
          SPACE  2
TAB1      BSS    0
          TABL   PURGE,P,5
          TABL   DELETE,D,6 
          TABL   RESTORE,R,7
          TABL   INSERT,I,6 
          TABL   YANK,Y,4 
          TABL   WEOR,W,4 
          TABL   COMPILE,C,7
          TABL   BEFORE,B,6 
          TABL   LIST,L,4 
          TABL   SEQUENCE,S,8 
          TABL   MOVE,M,4 
          TABL   TEXT,T,4 
LTAB1     EQU    *-TAB1 
          SPACE  1
TAB2      BSS    0
          TABL   ENDTEXT,ET,7 
          TABL   SELPURGE,SP,8
          TABL   SELYANK,SY,7 
          TABL   IDENT,ID,5 
          TABL   DECK,DK,4
          TABL   CALL,CA,4
          TABL   SKIP,SK,4
          TABL   READ,RD,4
          TABL   COMDECK,CD,7 
          TABL   CWEOR,CW,5 
          TABL   NOLIST,NL,6
          TABL   CHANGE,CH,6
          TABL   NOABBREV,NA,8
          TABL   PURDECK,PD,7 
          TABL   YANKDECK,YD,8
          TABL   DECLARE,DC,7 
          TABL   ADDFILE,AF,7 
          TABL   COPY,CY,4
          TABL  PULLMOD,PM,7
          TABL   DEFINE,DF,6
          TABL   DONT,DT,4
          TABL   ENDIF,EI,5 
          TABL   REWIND,RW,6
          TABL   LIMIT,LT,5 
          TABL   WIDTH,WI,5 
          OPTS   H,0,HEADER,1 
LTAB2     EQU    *-TAB2 
          EJECT 
**        SPECIAL CONSTANTS AND KEYS                                    01256874
*                                                                       01256875
*          THE CODE FOR VARIOUS OPTIONS AND UPDATE FUNCTIONS IS         01256876
*         BRACKETED BY IF STATEMENTS AND IS ASSEMBLED ONLY IF CERTAIN   01256877
*         PARAMETERS ARE DEFINED AT ASSEMBLY TIME.                      01256878
*                                                                       01256879
*         DECLKEY  CONTROLS *DECLARE CARD CODE                          01256880
*         CHAR64   CONTROLS CODE ASSOCIATED WITH 00B CHARACTER (COLON)  01256881
*         PMODKEY  CONTROLS * PULLMOD CARD CODE                         01256882
*         EDITKEY  CONTROLS E(EDIT) AND M(MERGE) CONTROL CARD OPTIONS   01256883
*         AUDITKEY CONTROLS AUDIT CODE (LIST OPTIONS 5-9)               01256884
*         OLDPLKEY CONTROLS CODE TO READ PRE-VERSION 1.2 OLDPLS         01256885
*         EXTOVLP  CONTROLS OVERLAP TYPES 2, 3, 4                       01256886
*         DYNAMFL  CONTROLS DYNAMIC FIELD LENGTH ADJUSTMENT             01256887
*         SCOPE33  IF EQUAL 34, UPDATE INTERFACES WITH SCOPE 3.4        01256888
*                  IF EQUAL 1, UPDDATE INTERFACES WITH SCOPE 3.3        01256889
*                  IF NOT DEFINED, UPDATE INTERAACES WITH SCOPE 3.1.6   01256890
*         IP.CSET  CONTROLS THE CHARACTER INTO WHICH THE DISPLAY CODE   0214   4
*                  63B IS MAPPED FOR OUTPUT.  IF IP.CSET IS SET TO      0214   5
*                  IP.C63 THE 63B REPRESENTS A COLON AND 00B IS NOT     0214   6
*                  SUPPORTED.  IF IP.CSET IS SET TO IP.C64 THE 63B      0214   7
*                  REPRESENTS A PER CENT AND THE 00B REPRESENTS A       0214   8
*                 COLON.                                                0214   9
*                                                                       01256891
*         IN ADDITION, THE SIZES OF BUFFERS, INPUT AND OUTPUT RECORDS,  01256892
*         ENTRIES IN TABLES, ETC. MAY BE CHANGED AT ASSEMBLY TIME BY    01256893
*         ALTERING THE SIZE DEFINITIONS AS FOLLOWS:                     01256894
*                                                                       01256895
*         SIZPAGE  CONTROLS NUMBER OF LINES PRINTED PER PAGE IN LISTINGS01256896
*                  (DEFAULT 56)                                         01256897
*         CARDSIZE CONTROLS BASIC LENGTH OF RECORD PROCESSED BY UPDATE  01256898
*                  (DEFAULT 8)                                          01256899
*         SZFPAGE  CONTROLS SIZE OF AREA USED TO CONTAIN TEXT TO BE     01256900
*                  INSERTED (DEFAULT 3200)                              01256901
*         ENTLINE  CONTROLS THE NUMBER OF ENTRIES/LINE OUTPUT IN UPDATE 01256902
*                  TABLE LISTINGS (DEFAULT 8)                           01256903
*         RECURDEP CONTROLS DEPTH TO WHICH CARDS MAY BE BACKED UP AS A  01256904
*                  RESULT OF *BEFORE CARDS, ETC. (DEFAULT 10)           01256905
*         LGSTAB   CONTROLS LARGEST AMOUNT OF ADDITIONAL FIELD LENGTH   01256906
*                  WHICH UPDATE WILL REQUEST (DEFAULT 10000B)           01256907
*         L.CHB    CONTROLS MAXIMUM NUMBER OF CHBS ALLOWED FOR ONE CARD 01256908
*                  AND CONSEQUENTLY THE MAXIMUM NUMBER OF PERMANENT     01256909
*                  MODIFICATION TO ONE CARD (DEFAULT 100)               01256910
          SPACE  2
          IF     -DEF,IP.C63,1
IP.C63    EQU    998D              DEFINE AT ANYTHING UNCOMMON
          IF     -DEF,IP.CSET,1 
IP.CSET   EQU    IP.C63            DEFAULT = 63 CHARACTER SET 
*                                  CHARACTER SET SUPPORT                0214  14
DECLKEY   EQU    1
CHAR64    EQU    1
PMODKEY   EQU    1
EDITKEY   EQU    1
AUDITKEY  EQU    1
OLDPLKEY  EQU    1
EXTOVLP   EQU    1
DYNAMFL   EQU    1
 EJECT    EQU    1000        LARGER THAN ANY LEGAL PAGE SIZE
 HDRSIZE  EQU    4           HEADER SIZE
 HDRSLOP  EQU    1           SIZE CALCULATION MARGIN - FUZZ 
 S.8BIT   EQU    55                BIT FOR 8-BIT FLAG IN CARD HEADER
 L.IDW    EQU    16                IDENT WIDTH ON LISTING 
L.CIW     EQU    14                DEFAULT IDENT WIDTH ON COMPILE FILE
 CARDLGTH EQU    256               MAXIMUM CARD LENGTH (CHARACTERS) 
 CARDSIZE EQU    CARDLGTH/10+1     WORDS
 CARDSZE8 EQU    CARDLGTH/5+1      WORDS
 SQLSIZE  EQU    CARDLGTH*19/100+2 WORDS
 SQLSIZE8 EQU    CARDLGTH*2/5+2    WORDS
ENTLINE   EQU    8                 NUMBER OF TABLE ENTRIES PRINTED/LINE 
RECURDEP  EQU    10                SAVECARD STACK DEPTH 
LGSTTAB   EQU    20000B      MOST FL TO GET AT ONE TIME 
L.CHB     EQU    100B 
LBUFI     EQU    1001B             LENGTH OF I-BUFFER (INPUT) 
  
          ENV    ACT,(2,3),VER2 
LFET      EQU    14                FET LENGTH 
LBUFO     EQU    0                 LENGTH OF O-BUFFER (OUTPUT)
LBUFP     EQU    2501B             LENGTH OF P-BUFFER (OLDPL) 
LBUFL     EQU    1001B             LENGTH OF L-BUFFER (OLDPL2)
LBUFR     EQU    1001B             LENGTH OF R-BUFFER (READFIL) 
LBUFS     EQU    0                 LENGTH OF S-BUFFER (SOURCE)
LBUFC     EQU    1001B             LENGTH OF C-BUFFER (COMPILE) 
LBUFN     EQU    1001B             LENGTH OF N-BUFFER (NEWPL) 
LRANIDX   EQU    10                RANIDX WILL BE 10 WORD SCM AREA
VER2      ELSE
LFET      EQU    13                LENGTH OF FETS 
LBUFO     EQU    1001B             LENGTH OF O-BUFFER (OUTPUT)
LBUFP     EQU    10001B            LENGTH OF P-BUFFER (OLDPL) 
LBUFL     EQU    10001B            LENGTH OF L-BUFFER (OLDPL2)
LBUFR     EQU    1001B             LENGTH OF R-BUFFER (READFIL) 
LBUFS     EQU    1001B             LENGTH OF S-BUFFER (SOURCE)
LBUFC     EQU    2501B             LENGTH OF C-BUFFER (COMPILE) 
LBUFN     EQU    10001B            LENGTH OF N-BUFFER (NEWPL) 
LRANIDX   EQU    LBUFN             RANIDX WILL BE BUFN
VER2      ENDIF 
  
LBUFM     EQU    1001B             LENGTH OF M BUFFER (UPDTSCR) 
LBUFD     EQU    1001B             LENGTH OF D BUFFER (UPDTCDK) 
********************************************************************     UPDA176
*                LBUFF ON SCOPE 2 MUST BE A MULTIPLE OF 1000 PLUS 1.     UPDA176
LBUFF     EQU    6001B             LENGTH OF F BUFFER (UPDTEXT)          UPDA176
*                LBUFF ON SCOPE 2 MUST BE A MULTIPLE OF 1000 PLUS 1.     UPDA176
********************************************************************     UPDA176
 SZFPAGE  EQU    LBUFF-3           SIZE OF FTEXT PAGE 
          EJECT                                                         01256912
          SPACE  1
          USE    *
          COMMENT UPDATE "VERSION" TEXT MAINTENANCE UTILITY 
          SPACE  4
**        FETS ARE SET UP FOR ALL FILES IN LOW CORE FOLLOWING THE STATIC01256920
*         TABLES.  SOME FETS ARE USED FOR MORE THAN 1 FILE.  WHEN       01256921
*         POSSIBLE, THE ADDRESS OF THE FIRST WORD ON AN FET IS EQUATED  01256922
*         TO THE NAME OF THE FILE INVOLVED.  EACH FET POINTS TO A BUFFER01256923
*         WHICH IS DEFINED AS BUF(X).  BUFFER LENGTH IS LBUF(X), X IS A 01256924
*         LETTER WHICH, WHEN POSSIBLE, IS THE SAME AS THE CONTROL CARD  01256925
*         OPTION WHICH EFFECTS THAT FILE.                               01256926
*         FETS AND BUFFERS ARE DEFINED FOR INPUT (I), OUTPUT (O), COMP  01256927
*         (C), (COMPILE IS NOT USED BECAUSE IT IS THE NAME OF A CONTROL 01256928
*         CARD), UPDTSCR(M), UPDTCDK(D), OLDPL(P), NEWPL(N), OLDPL2(L),  CP190
*         READFIL (R), UPDTEXT (F), AND SOURCE (S).  AUDITFL USES THE   01256930
*         READFIL BUFFER AND FET.  PTEMP (UPDTPMD) USES THE INPUT BUFFER01256931
*         AND FET.
*         OLDPL2 IS THE FET (BUFFER) USED FOR READING SECONDARY OLDPLS.  CP190
*                                                                       01256934
FILES     BSS    0
          SPACE  2
  
          ENV    ACT,(2,3),VER2 
          FETC   INPUT,I,,INPUT76,1 
          FETC   OUTPUT,O,,OUTPT76,1
          FETC   COMPILE,C,COMP,COMP76
          RFETB  UPDTSCR,M,UPSCR76
          RFETB  UPDTCDK,D,UPCDK76
          RFETB  OLDPL,P,OLDPL76,1
          RFETB  OLDPL2,L,OLDPL276,1                                     CP190
          RFETB  NEWPL,N,NEWPL76,1
          FETC   READFIL,R,,RDFIL76,1 
          RFETB  UPDTEXT,F,UPTXT76
          FETC   SOURCE,S,,SRCE76 
          FETC   AUDITFL,R,,ADTFL76 
VER2      ELSE
          FETB   INPUT,I
          FETB   OUTPUT,O 
          FETB   COMPILE,C,COMP 
          RFETB  UPDTSCR,M
          RFETB  UPDTCDK,D
          RFETB  OLDPL,P
          RFETB  OLDPL2,L                                                CP190
          RFETB  NEWPL,N
          FETB   READFIL,R
          RFETB  UPDTEXT,F
          FETB   SOURCE,S 
AUDITFL   EQU    READFIL
VER2      ENDIF 
  
          SPACE  1
          IF     DEF,PMODKEY,1
PTEMP     EQU    INPUT
          SPACE  2
          SPACE  1
XXXXX     BSS    0
          ORG    READFIL
          DATA   0
          ORG    NEWPL
          DATA   0
          ORG    OLDPL2                                                  CP190A 
          DATA   0                                                       CP190A 
          ORG    SOURCE 
          DATA   0
          ORG    XXXXX
..1       SET    XXXXX-FILES
  
          ENV    ACT,(2,3),VER2 
          SPACE  4
 INPUT76  FILE   LFN=INPUT,PD=INPUT,OF=N,MRL=5120 
 OUTPT76  FILE   LFN=OUTPUT,PD=I-O,OF=N,MRL=5120
 COMP76   FILE   PD=I-O,MRL=5120
 UPSCR76  FILE   LFN=UPDTSCR,MRL=5120,PD=I-O
 UPCDK76  FILE   LFN=UPDTCDK,MRL=5120,PD=I-O
 OLDPL76  FILE   PD=I-O 
 OLDPL276 FILE   PD=I-O                                                  CP190
 NEWPL76  FILE   PD=I-O,MRL=5120
 RDFIL76  FILE   PD=I-O,MRL=5120
 UPTXT76  FILE   LFN=UPDTEXT,MRL=5120,PD=I-O
 SRCE76   FILE   PD=I-O,MRL=5120
 ADTFL76  FILE   PD=I-O,MRL=230 
 TEMPIN76 FILE   LFN=UPDTTPL,PD=I-O,MRL=5120
 XXXXX2   BSS 
          ECHO   2,P1=(INPUT76,OUTPT76,COMP76,UPSCR76,UPCDK76,OLDPL76,NE
,WPL76,RDFIL76,UPTXT76,SRCE76,ADTFL76,TEMPIN76,OLDPL276)                 CP190
          ORG    P1 
          CON    0
          ORG    XXXXX2 
          SPACE  4
*                FET DEFINITIONS,ETC
* 
*         LOCATIONS RELATIVE TO FWA OF FET
 FETFIRST EQU    1           FIRST POINTER
 FETRAND  EQU    1           RANDOM BIT DESIGNATOR
 FETIN    EQU    2           IN POINTER 
 FETOUT   EQU    3           OUT POINTER
 FETLIMIT EQU    4           LIMIT POINTER
FETLCMF   EQU    5                 LCM FLAG FOR SCOPE 2 
 FETRCLC  EQU    6           RECORD LOCATION OR POINTER 
 FETINDX  EQU    7           INDEX LENGTH AND ADDRESS 
* 
 FETMODE  EQU    2           STATUS BIT DESIGNATING BINARY OR CODED 
 EOR6000  EQU    20B         EOR STATUS BIT 
* 
 FETFIT   EQU    13          POINTER TO FIT 
 FETRD    EQU    11B         READ STATUS
 FETWR    EQU    15B         WRITE STATUS 
 FETTYPE  EQU    11                FILE TYPE (W-TYPE=0) 
 RL7000   EQU    512         RECORD LENGTH
 EOIPOS   EQU    10                POSITION ADDRESS OF EOI
NFILES    EQU    ..1/LFET 
          ELSE
NFILES    EQU    ..1/LFET 
VER2      ENDIF 
  
          EJECT  4                                                      01257447
**        FLAG AND CONTROL CELLS                                        01257448
*                                                                       01257449
*         THE FETS ARE FOLLOWED BY A SERIES OF WORDS USED TO            01257450
*         CONTAIN FLAGS AND CONTROL WORDS USED BY UPDATE                01257451
*         DURING PROCESSING                                             01257452
          TITLE  FLAGS, CONTROL CELLS, AND TEMPORARY STORAGE
           SPACE  2                                                     01257454
*                                                                      *
*    CAUTION **********  TEMPORY CELL BOUNDED BY LINES OF ASTERISKS    *
*    ARE ORDER AND POSITION DEPENDENT AND SHOULD REMAIN CONTIGUOUS.    *
*                                                                      *
          SPACE  2
          SPACE  1
*         **************************************************************01256940
TITLE     DIS    7,1
  
          DIS    2,UPDATE "VERSION".
  
DATE      DIS    1, 
TIME      DIS    1, 
          DIS    1,      PAGE 
 PAGENO   BSSZ   2                 PAGE NUMBER AND END OF LINE
*         **************************************************************01256942
          SPACE  1
          SPACE  1
*         **************************************************************01256944
 CARD1    DIS    1, 
 CARD2    DIS    1, 
 CARD3    DIS    1, 
 CARD4    DIS    1, 
 IDFIELD  DIS    2, 
 IDFIELD8 BSSZ   4
* 
 DNAME    DIS    1, 
 ALLBUF   BSS    1                 ALSO USED AS CARD-1
 CARD     BSSZ   CARDSIZE+1 
 CARD8    BSSZ   CARDSZE8+1 
 SQLGN    BSSZ   1
 SQIMAGE  BSSZ   SQLSIZE+1
 SQLGN8   BSSZ   1
 SQIMAGE8 BSSZ   SQLSIZE8+1 
 ALLSIZE  EQU    *-ALLBUF 
* 
 CARDID   BSSZ   1
 TCARDID  BSSZ   1
 TSQLGN   BSSZ   1+SQLSIZE8 
 SRALINE  BSSZ   SQLSIZE           USED FOR 63-64 CONVERSION ONLY 
 LINE     BSSZ   2*14              PLACE TO BUILD OUTPUT LINES
*         **************************************************************01256946
          SPACE  1
          SPACE  1
*         **************************************************************01256948
AUDITEXT  DIS    5, 
          DATA   8L 
          SPACE  1
TOTITLE   DIS    5,0     SUMMARY OF UPDATE IDENTIFIERS WITHIN DECK -
DNTITLE   DATA   8LYANK$$$
          SPACE  1
TITLEONE  DIS    6,0         LIST OF CONTROL, ACTIVE, AND/OR INACTIVE CA
,RDS IN 
DNTITLE1  BSSZ   2
          SPACE  1
TOTITLE1  DIS    5,          IDENTIFIER               TOTAL    ACTIVE 
          DATA   8L 
          SPACE  1
ID1       BSSZ   4                 IDENT ORDINAL AT BEGINNING OF RANGE
N1        EQU    ID1+1             BEGINNING SEQUENCE NUMBER
ID2       EQU    N1+1              IDENT ORDINAL AT END OF RANGE
N2        EQU    ID2+1             END SEQUENCE NUMBER
          SPACE  1
TCHAR     BSSZ   4                 TEMP STORAGE FOR CHAR
CHAR      EQU    TCHAR+1           NEXT CHARACTER TO BE SCANNED 
COLUMN    EQU    CHAR+1            COLUMN POINTER 
TCOL      EQU    COLUMN+1          TEMP STORAGE FOR COLUMN
          SPACE  1
PRCNTLN   DIS    2,0
          DATA   C+ PURGED IDENTS WERE FOUND   +
          SPACE  1
PRECHB    DIS    1, 
CHBTEMP   BSSZ   10 
          SPACE  1
SEQFLAG                            NON-ZERO INDICATES SEQUENCING
TSEQFLG                            NON-ZERO MEANS THIS DECK SEQUENCEC 
          SPACE  1
WRCMS     DIS    1,UPDATING 
IDFLG 
          DATA   0                                                      0779   5
*         **************************************************************01256950
          SPACE  2
ABBFLAG   DATA   1LX               ABBREVIATION FLAG
ABMSG     DATA   C+         1 UPDATE ERRORS, JOB ABORTED.+
ACTAUDIT  DATA   1                 FLAG ON WHEN DECK IS BEING AUDITED 
ADDFLAG                            FLAG ON DURING ADDFILE PROCESSING
ADDCNT                             OLD STYLE ADDFILE COUNT
AFLIST                       IF +NON ZERO, LIST ADDFILE INPUT 
*                            IF -NON ZERO, *NOLIST TURNED OFF THE 
*                            LISTING OF ADDFILE INPUT 
ALTUNIT                            ALTERNATE UNIT FLAG
*         THE FOLLOWING TWO WORDS - MASCII AND ASCIIBLK MUST BE CONTIGOU
 MASCII   DATA   40004000400040004000B    ASCII CHARACTER MASK
 ASCIIBLK DATA   00400040004000400040B  ASCII BLANKS
 ABZBYTE  DATA   00405555555555555555B  FAKE OUT WRITEH 
 AUDIT    VFD    54/5LA1234,6/4    OUTPUT FLAGS 
 AUDITCF  CON    1L1         CONNECTED FILE DEFAULT LIST OPTION 
AUDTITLM  DIS    3,MASTER AUDIT, IDENT CARD TOTAL 
BIDEN     DATA   C+0*** IDENT LONGER THAN NINE CHARACTERS              *
,**   + 
BDORMG    DATA   C+0*** BAD ORDER ON YANK DIRECTIVE ***+
BEFFLAG                            BEFORE FLAG FOR READ OLDPL ROUTINE 
BLKFILL                            HOLDS BLANK FILLED COMDECK NAME.      CP190
BUFINDX                            WORD FOR RANDOM INDEX
CARDSTAT  DIS    2,5
CHARKEY                            FLAG FOR OLDPL CONVERSOIN
 CHG63    DATA   1R4               OLDPL CSET HEADER VALUE
*                                  USED IF NO OLDPL (CREATION RUN)
*                                  LATER USED AS CHARACTER  INTO
*                                  WHICH 63B (PERCENT OR COLON) IS CONVERTED
*                                  00 = 63 PL READ BY 64 UPDATE         0214  17
*                                  55 = 64 PL READ BY 63 UPDATE         0214  18
CLDKS 
COMCHAR   DATA   1L/
COMCOUNT
COMFLG                             FLAG ON WHEN PROCESSING COMDECK
COMLOC                             LOCATION FOR INDEX ON COMDKS WRITES
CORESIZE                           TOTAL FIELD LENGTH 
CPYFMLIB                           COPY RANDOM TO EITHER SEQ. OR RANDOM 
CPYTOLIB                           COPY SEQUENTIAL TO RANDOM
CREFLG                             CREATION RUN FLAG
CURCARD                            CURRENT CARD TYPE
CURSTAT   EQU    CARDSTAT+1        CURRENT STATUS 
CURDK                              CURRENT DECK ORDINAL 
CURNO                              CURRENT PAGE NUMBER
          SPACE  1
          IF     DEF,PMODKEY,1
CURPRC    BSSZ   11                PULLMOD TEMPORARIES
DCKLGTH                            2NDARY PL DECK LIST LENGTH.           CP190
DECKFLG                            WORD THAT CONTAINS DECK BIT (BIT 3)   CP190
DECKFLAG  DATA   1L5
DEFAULT                            FLAG SHOWING CHANGED CARD
DEFDECK   VFD    42/6RFAKEIT,18/0                                       1197   5
A         IF     DEF,DECLKEY
DECLDECK                           INDEX TO DECLARED DECK 
DERRMSG   DATA   C+           DECLARE ERRORS   +
DTYPERR                            DECLARE ERROR TOTAL
A         ENDIF 
DEFTITLE  DATA   C+VALUES DEFINED FOR THIS UPDATE+
DIRCOM1   DIS    3,    CORRECTION IDENTIFIERS 
DIRCOM2   DIS    3,     DECK LIST                                       0697   8
DIRCOM3   DIS    3,DECK LIST AS WRITTEN, IF NEWPL 
DIRLTH                             LENGTH OF PRIMARY OLDPL DIRECTORY.    UPDA168
 DIRNEWPL BSSZ   1                 FLAG IF NEWPL IS PERM (DIRECT) FILE
DKSTRUC                            DECK STRUCTURE HAS BEEN CHANGED
DOMESS    DATA   C+0*** DO/DONT IDENT            NOT YANKED/YANKED, NULL
, DO/DONT. ***  + 
 DPRINT   DATA   -1                FLAG FOR PRE-SPACE IN CARD LISTINGS
DUPDECK   DATA   C+ ***DUPLICATE DECK            NEWPL ILLEGAL *** +
DUPM      DATA   C+0*** DUPLICATE FILE NAME OF             , JOB ABORTED0602   8
,.+ 
EDITFLAG                           EDITING IS TO BE DONE
EIGHTY                             EIGHTY COLUMN FLAG 
ERRMODE                            ERROR MODE FLAG
ERRORS                             ERROR FLAG TO INHIBIT PROCESSING 
FAST                               FLAG TO BYPASS ALL NON *DECK CARDS 
FASTFLG                            DO QUICK MODE OF UPDATING
FERMES    DATA   C+           FATAL ERRORS+ 
FILEINFO  BSSZ   5                 SEE FILINFO MACRO IN CPUTEXT FOR 
*                                  FORMAT OF RETURNED FILE INFORMATION. 
FLGCHAR   DATA   1L*
FLL       DATA   0                 CELL USED WHEN MAKING MEMORY REQUESTS
FMODE                              F MODE SELECTED
 FOOT1    DATA   C+          0        1         2         3         4 
,      5         6         7         8+ 
 FOOT2    DATA   C+          1234567890123456789012345678901234567890123
,4567890123456789012345678901234567890+ 
FROMSCD                            INDICATES WHERE TO RETURN TO.         UPDA165
FSTIME
FTITL     DIS    3, CARDS ENCOUNTERED IN INPUT
FULLCOL                            FLAG TO INDICATE 80 COLUMN DATA
          SPACE  1
          IF     DEF,PMODKEY,1
GFILE     DATA   6LSOURCE          DEFAULT PULLMOD FILE NAME
GETLIMT   BSSZ   4
DUMLTEMP  EQU    GETLIMT
TGETLIMT  EQU    GETLIMT+2
HEADER                       FLAG TO CHANGE OLDPL HEADER
IDNAM                              NAME OF LAST IDENT 
INDX                               HOLDS TABLE POINTER AND PL ADDRESS.   CP190
INSFLG                             INSERTIONS FLAG
INITFIL   DATA   0           VALUE INDICATES EOR AS FOLLOWS 
*                            -1  ON MAIN INPUT
*                             0  ON ALT INPUT FROM *READ
*                             1  ON ALT INPUT FROM *ADDFILE 
 HOLD     BSSZ   1                 HOLDING CELL FOR SEQUENTIAL PL NAME
IYANK 
IYANKDK 
********************************************************************* 
  
 JPS      BSS    1           CURRENT JOB PAGE SIZE
 JPD      BSS    1           CURRENT JOB PRINT DENSITY
 JPW      BSS    1           DEFAULT PRINT WIDTH
 TTY      CON    1           (TTY) = 0 IF TTY OUTPUT FILE 
  
********************************************************************* 
LCHBTAB                            LENGTH OF CHB TABLE
LFPAGE                             SIZE OF FTEXT TAGE 
LINCOUNT                           LINES/PAGE COUNT USED DURING AUDIT 
LISTA     BSSZ   10                FLAGS FOR LIST OPTIONS 
LISTONE   EQU    LISTA+1
LISTTWO   EQU    LISTONE+1
LISTHREE  EQU    LISTONE+2
LISTFOUR  EQU    LISTONE+3
LISTFIVE  EQU    LISTONE+4
LISTSIX   EQU    LISTONE+5
LISTSEVN  EQU    LISTONE+6
LISTEIGT  EQU    LISTONE+7
LISTNINE  EQU    LISTONE+8
 LISTFORA BSSZ   1                 HOLDS DECLARED VALUE FOR L=4 
LLIMIT    DATA   6000              LINE LIMIT 
LLIMBP    EQ     PRINT4            BLOCK TO KEEP FROM REPEATING LIMIT 
 LLMESS   DATA   C+0*** OUTPUT LINE LIMIT EXCEEDED.  LIST OPTIONS 3 AND 
,4 CANCELLED. ***+
LONG      DIS    6,0*** FILENAME OF              IS TOO LONG, UPDATE ABO0602  10
,RTED***
LPCNT     DATA   1000              LINES THIS PAGE
LTTS      DIS    3, COMMON DECKS ENCOUNTERED
LTTT      DIS    3,DECKS WRITTEN TO COMPILE FILE
MAXCORE                            LARGEST VALUE FOR TABLE SIZES
MAXMEM    VFD    30/-1,30/0        COMMUNICATION WORD FOR MAXFL INQUIRY 
MEMCALL   VFD    24/0LMEMP,18/0,18/MAXMEM 
MERGE                              FLAG FOR MERGING OLDPLS
          ENV    ACT,(2,3),VER3                                          CP190
MESG1A    DATA   C+ SECONDARY OLDPL NOT RANDOM.+                         CP190
MESG1B    DATA   C+ MAKE ALL SECONDARY OLDPLS RANDOM.+                   CP190
MESG2A    DATA   C+ OLDPLS HAVE DIFFERENT CHARACTER SETS.+               CP190
MESG2B    DATA   C+ USE OLDPLS WITH SAME CHARACTER SETS.+                CP190
VER3      ELSE                                                           CP190
MESG1     DATA   C+ SECONDARY OLDPL NOT RANDOM.             MAKE ALL SEC CP190
,ONDARY OLDPLS RANDOM.+                                                  CP190
MESG2     DATA   C+ OLDPLS HAVE DIFFERENT CHARACTER SETS.   USE OLDPLS W CP190
,ITH SAME CHARACTER SETS.+                                               CP190
VER3      ENDIF                                                          CP190
MESG3     DATA   C+ ERR IN SECONDARY PL DECK LIST LENGTH.+               CP190
MESG7     DATA   C+INSUFFICIENT FIELD LENGTH, UPDATE ABORT.+
MISIDENM  DIS    7,0*** YANK, SELYANK, OR YANKDECK IDENT             NOT
, KNOWN *** 
          SPACE  2
*         **************************************************************
 MODEOPT  EQU    *
 MODEP    BSSZ   1                 MODE (6 OR 8 BIT) REQUESTED FOR FILE.
 MODEN    BSSZ   1                  THIS TABLE IS PARALLEL TO THE OPTIONS 
 MODEI    BSSZ   1                  TABLE USED TO CRACK CONTROL CARDS.
 MODEO    DATA   -1 
 MODEC    BSSZ   1            -1 = 6 BIT, +1 = 8 BIT, 0 = NOT SPECIFIED 
 MODEM    BSSZ   1
 MODES    BSSZ   1
 MODET    BSSZ   1
 MODEK    BSSZ   1
 MODEG    DATA   -1 
*         **************************************************************
          SPACE  2
 MODENF   DATA   -1                FINAL NEWPL MODE FLAG
MODFLG                             MODIFICATION FLAG
MOVEFLAG                           OLDPL MUST BE RANDOM 
NEWAD                              NEW-STYLE ADDFILE FLAG               0213   8
NEWAD2                                                                  0213   9
NFERRMSG  DATA   C+           NON-FATAL ERRORS +
NFERROR                            NON-FATAL ERROR COUNT
NOIFILE                      SET NZ WHEN EOR OF INPUT HAS BEEN READ 
NOCOMMON                           COMMON DECKS NOT OUTPUT TO COMPILE 
NOPROP                             NON-PROPAGATE CONDECK FLAG 
NORANDOM                           DISK NEWPL WILL NOT BE RANDOM IF ON
NOREWFLG                           NO REWIND FLAG 
 NULCARD  DATA   1,1L        ALL-BLANK CARD IMAGE (LGTH+IMAGE)
NUMDECKS                           NUMBER OF DECK NAMES ADDED TO DECKS
OFFSET                             AMOUNT THAT SECONDARY OLDPL ORDINALS  CP190B 
*                                  OFFSET BECAUSE OF TABLE DISPLACEMENT. CP190B 
OPLCSET                            CHARACTER SET OF OLDPL.               CP190
OPLMCC                             MASTER CONTROL CHAR OF OLDPL.         CP190
ORD                                ORDINAL OF SECONDARY OLDPL CARD.      CP190B 
ORDERFLG                           FLAG NON-ZERO IF COMPILE ORDER NEW 
ORGLGTH                            ORIGINAL DIRECTORY LENGTH.            UPDA165
          SPACE  1
          IF     DEF,DYNAMFL,1
ORIGSIZE                           STARTING FIELD LENGTH
OVLFLG                             OVERLAP FLAG 
OVLPMSG   DATA   C+           OVERLAPPING CORRECTIONS + 
OVMFLG                             COUNT OF OVERLAPPING CORRECTIONS 
          SPACE  1
          IF     DEF,PMODKEY,1
PBIAS                              BIAS WITHIN PTEMP FILE 
 PCLINES                           PRNTCARD LINE COUNTER
 PCLNEXT                           PRNTCARD TEMP
 PCWLL                             PRNTCARD WORDS IN LAST LINE
PFLAG 
PGCNT                              PAGE COUNT 
POINTER                            POINTER TO CURRENT IDENT COUNTER 
PHLAG                              FLAG TO INDICATE THAT COL, CHAR,      CP190
*                                  SQLGN AND SQIMAGE HAVE BEEN STORED.   CP190
POPT                               SECONDARY OLDPL COUNTER.              CP190
 PRCC                              CARRIAGE CONTROL IN PROCESS
 PREOL                             SAVE EOL IF SHORTENING LINE
 PRENTRY                           HOLDS PRINT RECURSION
 PRPARMS                           .. 
 PRINTED  BSSZ   1           FLAG TO KEEP CARD FROM BEING PRINTED TWICE 
 PRTEMP                            TEMPORARY CELL FOR PRINT 
PURGCNT                            COUNT OF PURGED IDENTS 
PURGFLAG                           FLAG ON WHEN CURRENT DECK PURGED 
QFLAG                              FLAG USED IN Q RANDOM MODE 
QRANDFLG                           FLAG ON WHEN Q RANDOM WAITING COMDECK
QUALIF                             SKIP FLAG FOR IF-S 
RANDNPL                            RANDOM NEWPL FLAG
RANDOPL                            RANDOM OLDPL FLAG
RANDTEMP                           ADDRESS FOR RANDOM INDEX NEWPL 
          IF     DEF,EXTOVLP,1
 RANGDEL  BSSZ   1                 SINGLE/RANGE DELETE FLAG 
RCMES     DATA   C+STACK DEPTH EXCEEDED+
RDCHSUM                            THIS CELL HOLDS CHECKSUM ON READS
RECCALL   DATA   H+0*** RECURSIVE CALL ON COMDECK+
          DATA   10H
          DATA   C+IGNORED.  FATAL ERROR.***+ 
 RJRBIN   BSSZ   1                 READ TYPE FLAG 0=CHECKSUM
 RJROPL   BSSZ   1                 OPL TYPE FLAG   0=NEW STYLE
 RJWBIN   BSSZ   1                 WRITE TYPE FLAG 0=CHECKSUM 
 RLCMPL   BSSZ   1           ACCUM PARTIAL REC LENGTH FOR SC2 
  
          ENV    ACT,(2,3),RT 
 RTW      VFD    29/-0,3/0,2/3B,4/0,22/-0 MASK TO SET RT, BT ON SCOPE 2.
 RT       ENDIF 
  
BTERROR   DATA   C+   RANDOM NEWPL CANNOT BE A BLOCKED FILE + 
SCDKNM                             SECONDARY OLDPL NAME  (TEMP)          CP190
SCNDPL    BSSZ   7                 2NDARY OLDPL NAME TABLE.              CP190
SCNUM                              NO. OF SECONDARY OLDPLS SPECIFIED.    CP190
SCRLOC                             CALL FOR SYSTEM TO PUT SCRATCH INDEX 
SCRMES    DATA   C+COPYING             TO COMPILE FILE+ 
SELYKYK   DATA   1                 SET NON ZERO.                         UPD0315
SEQBIAS                            BIAS TO BE APPLIED TO SEQUENCE NUMBER
SEQNUM                             CURRENT CARD SEQUENCE NUMBER 
SEQNUM2                            USED TO SEQ SECONDARY OLDPL CARDS.    CP190
 SIXTH    CON    1S48/6+1          CONSTANT 1/6 
SIXTY3                             0 = PL SAME AS CSET                  0214  20
*                                  63 = NOT SAME                        0214  21
SIZCORE                            THIS CELL HOLDS THE TOTAL TABLE SPACE
          SPACE  1
          ENV    ACT,(2,3),S2LCM
SIZECORL                           TOTAL AMOUNT OF LCM REQUIRED 
SIZMEL    DIS    ,+                   A           WORDS OF LCM.+
SIZMES    DIS    ,+  THIS UPDATE REQUIR           WORDS OF SCM+ 
S2LCM     ELSE
SIZMES    DIS    ,+  THIS UPDATE REQUIR           WORDS OF MEMORY.+ 
S2LCM     ENDIF 
          SPACE  1
SKIPID                             FLAG TO SKIP IDENT 
SKIPM     DIS    2,SKIPPING 
SQRESFLG                           FLAG TO INDICATE NEEDED RESTORE SEQ
SRANIX    BSSZ   5                 SECONDARY OLDPL RANDOM INDEX.         CP190
LSRANIX   EQU    5                 RANDOM INDEX LENGTH.                  CP190
STAT                               STATUS OF CARD READ FROM 2NDARY PL.   CP190
TBLPTR                             POINTER INTO COMDECK TABLE.           CP190
* 
TCRBIN    BSSZ   1
TCRBIN1   BSSZ   1
TCRBIN2   BSSZ   1
TCRBIN3   BSSZ   1
TCRBIN4   BSSZ   1
TCRDEC    BSSZ   1
TCRDEC2   BSSZ   1
TCRDEC3   BSSZ   1
TCRDEC4   BSSZ   1
TCRDEC5   BSSZ   1
TCROPL    BSSZ   1
TCWBIN    BSSZ   1
TCWBIN2   BSSZ   1
TCWBIN3   BSSZ   1
TCWBINC   BSSZ   1
TCWDEC    BSSZ   1
TCWDEC2   BSSZ   1
* 
TEMP                               TEMPORARY CELL 
TEMP1                              TEMPORARY CELL 
TEMP2                              TEMPORARY CELL                        UPDA164
TEMP3                              TEMPORARY STORAGE.                    UPDA165
 TEMP4    BSSZ   1           TEMPORARY STORAGE
TEMPAUD   VFD    42/7LUPDTAUD,18/1
TEMPID
TEMPIN    VFD    42/7LUPDTTPL,18/3
  
          ENV    ACT,(2,3),VER2 
          CON    TEMPIN76 
VER2      ENDIF 
  
TEMPNEW   VFD    42/7LUPDTNEW,18/3
  
          ENV    ACT,(2,3),VER2 
          CON    NEWPL76
VER2      ENDIF 
  
TEMPNPL   VFD    30/5LNEWPL,30/3
          ENV    ACT,(2,3),VER2 
          BSS    1           TEMP STORAGE FOR FIT POINTERS
VER2      ENDIF 
TMODFLAG                           FLAG TO INDICATED MODIFIED DECK CARD 
TXTBIAS                            BIAS FUR CURRENT TEXT PAGE 
TXTFLAG                            FLAG IS ON WHEN TEXT BEING PROCESSED 
WAITMSG   DATA   C+WAITING FOR   45000B WORDS + 
 UCW                               UCARD W CTL WORD 
 WCW                               RDC= W CTL WORD
WHATZIT                            63 = 63 UPDATE READING 64 PL         0214  23
*                                   0 = ALL ELSE                        0214  24
WORKLGTH                           TEMPORY LENGTH OF DECKS OR DKLIS 
WRCHSUM                            CELL TO HOLD WRITE CHECKSUM
WRCOMMON                           NZ = DONT WRITE COMDECK TO SOURCE
WRSCRACH                           FLAG ON WHEN WRITING DECK TO SCRATCH 
 WIC      CON    72                CARD WIDTH (DEFAULTS)
 WIW      CON    L.CIW             IDENT WIDTH
 WIS      CON    1                 SPACES BETWEEN CARD AND IDENT
 WII      CON    13                ACTIVE WIDTH OF IDENT FIELD
XFLAG                              NZ INDICATES COMDECK IN WRONG PLACE
XMODE                              FLAG FOR COMPAS INTERFACE MODE 
 YFLAG                       END OF UPDATE CLEANUP FLAG 
YANKFLAG  DATA   1L5               FLAG PLUS WHEN DECK YANKED 
YNKFLG                       FLAG + IF PASS1 YANK PROCESSING
*                            FLAG - IF PASS2 YANK PROCESSING
ZIP                                INPUT IS SQUEEZED
          EJECT 
          TITLE  TABLE MANAGEMENT ROUTINES
**        DYNAMIC TABLES                                                01254385
*                                                                       01254386
*         UPDATE DYNAMIC TABLES ARE USED FOR VARIOUS PURPOSES AND OCCUPY01254387
*         THE REGION BETWEEN THE LAST LOCATION USED AS PERMANENT STORAGE01254388
*         AND THE END OF THE ALLOTTED FIELD LENGTH.  THERE ARE THREE    01254389
*         STATIC TABLES WHICH HOLD PARAMETERS WHICH DEFINE THE CURRENT  01254390
*         STATUS AND LOCATION OF EACH OF THE DYNAMIC TABLES.  THESE     01254391
*         THREE TABLES ARE CONTIGUOUS AND CONTAIN                       01254392
*                1. DYNAMIC TABLE ORIGINS                               01254393
*                2. DYNAMIC TABLE LENGTHS                               01254394
*                3. DYNAMIC TABLE UNUSED ROOM/TABLE STATUS              01254395
*         THE ORIGINS TABLE STARTS AT ORIGINS, LENGTHS AT SIZES, ROOM   01254396
*         AT ROOMS.  EACH TABLE NAME IS DEFINED AS THE INDEX VALUE WHICH01254397
*         MAY BE ADDED TO ORIGINS, SIZES, OR ROOMS TO FIND THE VALUES   01254398
*         FOR THAT PARTICULAR TABLE.  O.NAME IS EQUATED TO ORIGINS+NAME 01254399
*         AND DEFINES THE LOCATION OF THE CELL WHICH CONTAINS THE ORIGIN01254400
*         OF TABLE "NAM".  THE CELLS STARTING AT ROOMS CONTAIN THE      01254401
*         MAXIMUM LENGTH TO WHICH A TABLE MAY GROW BEFORE IT OVERFLOWS  01254402
*         THE NEXT TABLE AND SPACE MUST BE RE-ALLOCATED.  IF THE ROOM   01254403
*         CELL FOR A GIVEN TABLE IS MINUS, THAT TABLE IS SKIPPED IN THE 01254404
*         ALLOCATION PROCESS.  THE TABLES ARE ARRANGED SO THAT THE MORE 01254405
*         COMMONLY USED TABLES ARE POSITIONED BEFORE THE LESS USED.     01254406
*         NACTTAB INDICATES THE NUMBER OF TABLES WHICH ARE INITIALLY    01254407
*         TURNED ON (ROOM FOR THESE TABLES SET TO ZERO).  ALL OTHER     01254408
*         TABLES ARE INITIALLY SET OFF (ROOM = -0).  AS THESE "OFF"     01254409
*         TOTAL NUMBER OF TABLES.  NOTE THAT L.TNAM IS FOUND AT         01254410
*         O.TNAM+NTABLES, THE VALUE OF ROOM FOR A GIVEN TABLE IS FOUND  01254411
*         TNAM+NTABLES AND THE VALUE OF ROOM FOR A GIVEN TABLE IS FOUND 01254412
*         AT L.TNAM+NTABLES.                                            01254413
*                                                                       01254414
*         DIRECT                                                        01254415
*                                                                       01254416
*         CONTAINS THE IDENTIFIER DIRECTORY, 1 WORD FOR EACH ENTRY, VFD 01254417
*         54/OL (IDENT NAME), 1/YANK BIT,1PURGE BIT,1/SEQUENCE BIT,1    01254418
*         MODIFICATION BIT,1/3,1/NO-PRINT BIT.  THE YANK BIT IS SET BY A01254419
*         YANK CARD FOR AN ENTIRE UPDATE RUN, OR BY SELYANK FOR ONE DECK01254420
*         DURING A RUN.  PURGE BIT IS SIMILARLY SET BY PURGE OR SELYANK,01254421
*         SEQUENCE BIT BY SEQUENCE, MODIFICATION BIT (USED BY SEARCH) BY01254422
*         A REFERENCE TO THIS IDENT ON INSERT, BEFORE, RESTORE, OR      01254423
*         DELETE CARD.                                                  01254424
*                                                                       01254425
**T       54/IDENT,1/Y,1/P,1/S,1/M,1/I,1/L
*                                                                       01254427
*         Y - YANK BIT      P - PURGE BIT       S - SEQUENCE BIT        01254428
*         M - MOD TO THIS IDENT     I - INITIAL YANK BIT
*         L - THIS IDENT WILL NOT BE WRITTEN ON LISTING 
*                                                                       01254430
*         DECKS                                                         01254431
*         CONTAINS THE DECK LIST AS READ FROM THE OLDPL.  2 WORDS/ENTRY.01254432
*         WORK 1 VFD 54/OL (DECK NAME), 1/YANK DECK BIT), 4/0,          01254433
*         1/(PURDECK BIT).  WORD 2 VFD 60/(INDEX ADDRESS IF RANDOM      01254434
*         OLDPL).  FOR DECKS BEING INSERTED, THIS WORD IS ZERO.         01254435
*                                                                       01254436
**T       54/DECK NAME,4/A,1/B,1/C
**T       60/RANDOM INDEX ADDRESS                                       01254438
*                                                                       01254439
*         A - YANKDECK BIT     B - INITIAL YANKDECK BIT 
*         C - PURDECK BIT 
*                                                                       01254441
*         DICT                                                          01254442
*                                                                       01254443
*         CONTAINS DICTIONARY OF INSERTS, DELETES, ETC.                 01254444
*                                                                       01254445
**T       24/CODE, 18/SEQ1,18/ORD1                                      01254446
**T,      24/DECL, 18/SEQ2,18/ORD2                                      01254447
**T,      24/BIAS,18/NUM,18/ORD3                                        01254448
*                                                                       01254449
*         CODE - TYPE OF ENTRY - BEFORE=10B, DELETE=02B, INSERT=20B     01254450
*                                RESTORE=06B, ADDFILE=01B               01254451
*         SEQ1 = SEQUENCE NUMBER AT START OF RANGE                      01254452
*         ORD1 = IDENTIFIER ORDINAL (INDEX WITHIN DRIECT) AT START OF   01254453
*                RANGE.                                                 01254454
*         DECL = INDEX WITHIN DECTAB OF DECLARED DECKNAME (IF ANY)      01254455
*         SEQ2 = SEQUENCE NUMBER AT END OF RANGE                        01254456
*                (SEQ2 AND ORD2 ARE DEFINED ONLY FOR DELETE AND RESTORE)01254457
*         BIAS = INDEX WITHIN CARDS FTEXT FILE OF START OF FIRST CARD   01254458
*                TO BE INSERTED (IF ANY).                               01254459
*         NUM  = NUMBER OF CARDS TO BE INSERTED (IF ANY).               01254460
*         ORD3 = IDENTIFIER ORDINAL OF IDENT UNDER WHICH THIS ENTRY     01254461
*                WAS CREATED (IDENT TO BE GIVEN TO CARDS INSERTED).     01254462
*                                                                       01254463
*         TDICT                                                         01254464
*                                                                       01254465
*         CONTAINS ENTRIES FROM DICT.  ENTRIES APPLYING TO A GIVEN CARD 01254466
*         ARE MOVED ALL AT ONCE FROM DICT TO TDICT, THEN PROCESSED FROM 01254467
*         TDICT ACCORDING TO TYPE                                       01254468
*                                                                       01254469
*         CDKTBL                                                         CP190
*                                                                        CP190
*         CONTAINS LIST OF COMMON DECKS THAT ARE ON SECONDARY OLDPLS.    CP190
*         WILL ALSO CONTAIN DECKS FROM SECONDARY OLDPLS IF SECONDARY     CP190
*         OLDPL HAS NOT BEEN UPGRADED TO CONTAIN DECK BITS.              CP190
*         TWO WORD ENTRIES. FIRST WORD CONTAINS COMDECK (DECK) NAME      CP190
*         AND THE SECOND WORD CONTAINS THE ADDRESS OF WHERE YOU CAN      CP190
*         FIND THAT COMDECKS (DECKS) OLDPL NAME AND THE PRU NO. OF       CP190
*         THAT COMDECK.                                                  CP190
*                                                                        CP190
**T       60/COMDECK NAME                                                CP190
**T,      30/ADDRESS OF PL NAME,30/PRU NO.                               CP190
*                                                                        CP190
*         NEWDKS                                                        01254470
*                                                                       01254471
*         CONTAINS ENTRIES SIMILAR TO DECKS.  TABLE IS CREATED AS DECKS 01254472
*         ARE PROCESSED DURING PASS 2.  CONTAINS ONLY DECKS WHICH WOULD 01254473
*         BE (OR ARE) WRITTEN TO NEWPL IN NEWPL ORDER.                  01254474
*                                                                       01254475
*         COMPFL                                                        01254476
*                                                                       01254477
*         CONTAINS A LIST OF DECKS WRITTEN TO COMPILE FILE, IN COMPILE  01254478
*         FILE ORDER. 1 WORD/ENTRY.  VFD 60/0L NAME.                    01254479
*                                                                       01254480
*         CNTR                                                          01254481
*                                                                       01254482
*         USED WHEN PROCESSING PRE-VERSION 1.2 OLDPL"S TO CONTAIN       01254483
*         SEQUENCE COUNTS FOR EACH IDENT.  SEQUENCE NUMBERS WERE NOT    01254484
*         KEPT OF OLD-STYLE OLDPL"S.                                    01254485
*                                                                       01254486
*         COMIND                                                        01254487
*                                                                       01254488
*         LIST OF COMMON DECKS AND THEIR LOCATION ON THE FILE UPDTCDK   01254489
**T       58/DECK NAME,2/A                                              01254490
**T,      60/ADDRESS ON UPDTCDK                                         01254491
*                                                                       01254492
*         A - MODIFICATION BIT                                          01254493
*                                                                       01254494
*         DKLIS                                                         01254495
*                                                                       01254496
*         CONTAINS LIST OF DECKS TO BE PROCESSED.  ENTRIES ARE OBTAINED 01254497
*         FROM *COMPILE CARDS AND FROM *ADDFILE CARDS.  MEANINGLESS IN F01254498
*         MODE.  1 WORD/ENTRY:                                          01254499
*                                                                       01254500
**T       56/DECK NAME,2/A,1/B,1/C                                      01254501
*                                                                       01254502
*         A - KEY1, B - FAKE, C - NO-WRITE                              01254503
*                                                                       01254504
*         KEY1 IS SET THE FIRST TIME THIS DECK IS PROCESSED.  SOME      01254505
*         OPERATIONS MAY INTERRUPT THE PROCESSING OF THIS DECK AND THIS 01254506
*         BIT GUARANTEES THE NAME WILL NOT BE ENTERED IN OUTPUT TABLES  01254507
*         TWICE.  FAKE BIT IS SET WHEN THE ENTRY IS GENERATED BY        01254508
*         *ADDFILE.                                                     01254509
*                                                                       01254510
*         TXTLIM                                                        01254511
*                                                                       01254512
*         CONTAINS RECORD NUMBER AND ADDRESS ON UPDTEX WHERE THIS RECORD01254513
*         OF INPUT TEXT MAY BE FOUND.                                   01254514
**T       60/RECORD NUMBER                                              01254515
**T,      60/ADDRESS OF UPDTEX                                          01254516
*                                                                       01254517
*         PURYAN                                                        01254518
*                                                                       01254519
*         CONTAINS ENTRIES CREATED BY *SELPURGE AND *SELYANK CARDS      01254520
*                                                                       01254521
**T       42/MASK,18/ORDINAL                                            01254522
**T,      60/DECK NAME                                                  01254523
*                                                                       01254524
*         COUNT                                                         01254525
*                                                                       01254526
*         USED TO ESTABLISH SEQUENCE NUMBERS ON IDENT BEING PROCESSED ON01254527
*         THE CURRENT RUN.  1 WORD/ENTRY.                               01254528
*                                                                       01254529
*         SCRIND                                                        01254530
*                                                                       01254531
*         CONTAINS INDEX OF RECORDS WRITTEN ON SCRATCH FILE UPDTSCR     01254532
**T       60/DECK NAME                                                  01254533
**T,      60/INDEX                                                      01254534
*                                                                       01254535
*         DECTAB                                                        01254536
*                                                                       01254537
*         CONTAINS DECKNAMES.  ENTRIES ARE CREATED BY *DECLARE CARD.    01254538
*         USED TO CHECK VALIDITY OF MODIFICATIONS IN DECLARE MODE.  1   01254539
*         WORD/ENTRY.                                                   01254540
*                                                                       01254541
*         AUDCNT                                                        01254542
*                                                                       01254543
*         USED DURING AUDIT PROCESSING TO ACCUMULATE IDENTIFIER CARD    01254544
*         TOTALS.  PARALLEL TO DIRECT, EXCEPT TWO WORDS PER ENTRY.
*                                                                       01254546
**T       30/A, 30/B
**T,      30/C, 30/D
*                                                                       01254548
*         A=NUMBER OF CARDS, B=NUMBER OF ACTIVE CARDS                   01254549
*         C=NUMBER OF CARDS THIS DECK, D=NUMBER/ACTIVE CARDS THIS DECK  01254550
*                                                                       01254551
*         SVMOD                                                         01254552
*                                                                       01254553
*         CONTAINS TDICT ENTRIES WHICH ARE SAVED ALONG WITH THE CARD TO 01254554
*         WHICH THEY APPLY WHEN IT IS NECESSARY TO BACK UP PROCESSING AS01254555
*         FOR *BEFORE CARDS.  SAME FORMAT AS DICT.                      01254556
*                                                                       01254557
*         SVCRD 
*                                                                       01254559
*         CONTAINS SQUEEZED IMAGE OF SAVED CARDS                        01254560
*                                                                       01254561
**T       1/A,2/B,18/SEQNUM,8/LCHB,8/SQLGN,15/INDEX,8/NO. MODS
**T,      60/CHB                                                        01254563
**T,      60/SQUEEZED CARD IMAGE                                        01254564
*                                                                       01254565
*         A=CARDSTAT, B=CURSTAT                                         01254566
*                                                                       01254567
*         COMBAK                                                        01254568
*                                                                       01254569
*         CONTAINS ENTRIES INDICATING STATUS OF COMMON DECK INTERRUPTED 01254570
*         WHEN ONE COMMON DECK CALLS ANOTHER.  2 WORDS/ENTRY:           01254571
*                                                                       01254572
**T       30/INDEX ON UPDTCDK,30/NO. OF CARDS READ                      01254573
**T,      60/DECK NAME                                                  01254574
*                                                                       01254575
*         MODKEY                                                        01254576
*                                                                       01254577
*         CONTAIN THREADED LISTS, ONE FOR EACH IDENT BEING *PULLMODED.  01254578
*                                                                       01254579
*         TYPE 1 - INDICATES CONTROL CARD TO BE GENERATED               01254580
*                                                                       01254581
**T       6/CODE,18/PTR TO NEXT ENTRY,18/SEQNUM,18/ORDINAL              01254582
**T,      24/UNUSED,18/SEQNUM,18/ORDINAL                                01254583
*                                                                       01254584
*         TYPE 2 - POINTS TO CARD IMAGE ON UPDTPMD                      01254585
*                                                                       01254586
**T       24/POINTER TO NEXT ENTRY,18/LGTH OF ENTRY,18/INDEX OF ENTRY   01254587
*                                                                       01254588
*         PMODS                                                         01254589
*                                                                       01254590
*         CONTAINS 1 WORD ENTRY FOR EACH IDENT SPECIFIED ON A PULLMOD   01254591
*         CARD.  POINTS TO MODKEY ENTRIES                               01254592
*                                                                       01254593
**T       6/KEYS,18/PTR TO 1ST ENTRY,18/PTR TO LAST ENTRY,18/IDENT ORD  01254594
*                                                                       01254595
*         KEYS - BITS 54-59 = STATUS KEYS                               01254596
*                     56,57 = INSERTS (PERM, TEMP)                      01254597
*                     58,59 = DELETES (PERM, TEMP)                      01254598
*                                                                       01254599
*         DEFTAB                                                        01254600
*                                                                       01254601
*         CONTAINS PARAMETERS DEFINED ON DEFINE CARDS                   01254602
*                                                                       01254603
**T       60/PARAMETER                                                  01254604
          SPACE  1
ORIGINS   BSS    0
          SPACE  1
          ENV    NOT,(2,3),S2LCM
 DIRECT   TABLE                    IDENTIFIER DIRECTORY 
S2LCM     ENDIF 
          SPACE  1
 DECKS    TABLE  2                 LIST OF POSSIBLE DECKS 
 DICT     TABLE  3                 CORRECTION DICTIONARY
 TDICT    TABLE  3                 CONDENSED DIRECTORY FOR IMMEDIATE USE
 CDKTBL   TABLE  2                 TABLE OF COMDECKS ON 2NDARY OLDPLS.
 NEWDKS   TABLE  2                 TABLE OF DECKS ON NEWPL
 COMPFL   TABLE                    DECKS WRITTEN TO COMPILE FILE
  
 CNTR     TABLE                    CARD COUNTERS
 COMIND   TABLE  2                 COMMON DECK INDICES
 DKLIS    TABLE                    ASSEMBLY LIST FROM COMPILE CARDS 
 TXTLIM   TABLE  2                 PAGE DIRECTORY FOR TEXT FILE 
 PURYAN   TABLE  2                 SELECTIVE PURGE/YANK TABLE 
 SCRIND   TABLE  2                 DIRECTORY FOR SCRATCH FILE 
 COUNT    TABLE                    SEQUENCE NUMBER COUNTERS FOR INSERTS 
          SPACE  1
          IF     DEF,DECLKEY,1
 DECTAB   TABLE 
          SPACE  1
          IF     DEF,AUDITKEY,1 
 AUDCNT   TABLE  2
 SVCRD    TABLE                    PUSHDOWN STACK FOR BACKUP UP CARDS 
 COMBAK   TABLE  2                 STACK FOR COMDECK BACKUP 
          IF     DEF,PMODKEY,3
 PMID     TABLE 
 MODKEY   TABLE  2                 MODS AS THEY ARE PULLED
 PMODS    TABLE                    MODS TO BE PULLED
 DEFTAB   TABLE                    DEFINITION TABLE 
           EJECT  4                                                     01257445
 TABLES   HERE
          SPACE  3
          ENV    ACT,(2,3),S2LCM
* 
*         INFORMATION FOR LCM DIRECTORY TABLE 
* 
 F.DIRECT DATA   0                 IDENTIFIER DIRECTORY (IN LCM)
L.DIRECT  DATA   0                 LENGTH OF DIRECT TABLE 
S2LCM     ENDIF 
          TITLE  READ CARD, SQUEEZE LINE, PROCESS ABBREVIATIONS         01257467
          EJECT 
          USE    OVERLAY
**        PASS ONE                                                      01257008
*                                                                       01257009
*         ALL PASS 1 CODE IS ASSEMBLED IN SPACE WHICH WILL BE USED AS   01257010
*         BUFFERS DURING PASS 2.  IN ADDITION, ALL PASS 1 SUBROUTINES   01257011
*         WHICH ARE USED BY CREATION RUN PROCESSING ARE ASSEMBLED       01257012
*         WITHIN BUFM, WHICH IS THE ONLY BUFFER NOT USED DURING         01257013
*         CORRECTION RUN PASS 1 OR DURING A CREATION RUN.  ANYONE MAKING01257014
*         MODIFICATIONS TO UPDATE SHOULD BE AWARE OF THESE CONSTRAINTS. 01257015
*                                                                       01257018
          SPACE  1
**        READCD READ INPUT CARDS                                       01254606
*                                                                       01254607
*         READCD IS USED TO READ CARDS FROM THE INPUT                   01254608
*         FILE.  CERTAIN CONTROL CARDS ARE ALSO PROCESSED               01254609
*         HERE.  ON NORMAL EXIT, CARD WILL CONTAIN THE                  01254610
*         BLANK FILLED CARD IMAGE WHICH WAS READ, SQIMAGE               01254611
*         WILL CONTAIN THE SQUEEZED CARD IMAGE AND SQLGN                01254612
*         WILL CONTAIN THE LENGTH OF THE IMAGE IN SQIMAGE.              01254613
*         IF THE CARD WAS A CONTROL CARD, THE PROPER BIT                01254614
*         WILL BE TURNED ON IN CURCARD TO INDICATE THE                  01254615
*         TYPE OF CONTROL CARD.  IF AN END OF RECORD WAS                01254616
*         ENCOUNTERED, X1 WILL BE NON-ZERO.                             01254617
*                                                                       01254618
*         ON ENTRY TO READCD, THE CELL DNAME IS CLEARED                 01254619
*         IF THE PREVIOUS CARD WAS A CONTROL CARD.  IF A                01254620
*         COPY OPERATION IS IN PROGRESS, AN ALTERNATE UNIT              01254621
*         IS BEING READ, OR THE FILE BEING READ IS ALREADY              01254622
*         IN SQUEEZED FORMAT, A JUMP IS MADE TO THE AP-                 01254623
*         PROPRIATE SECTION OF CODE TO HANDLE THE SITUATION.            01254624
*         IN ANY OTHER CASE, A CALL TO RDEC IS MADE TO                  01254625
*         READ THE NEXT CARD FROM THE MAIN INPUT FILE                   01254626
*         INPUT.  IF AN END OF FILE IS NOT ENCOUNTERED,                 01254627
*         SQUEEZE IS CALLED TO PRODUCE THE SQUEEZED IMAGE               01254628
*         IN SQIMAGE AND THE CARD IS CLASSIFIED (BY                     01254629
*         MAKING A CALL TO CLASSIFY).  IF THE CARD IS                   01254630
*         NOT A CONTROL CARD, A NORMAL EXIT IS MADE,                    01254631
*         OTHERWISE, A CONTROL CARD MARKER IS SET UP IN                 01254632
*         DNAME.  IF THE CARD CAN BE PROCESSED WITHIN                   01254633
*         READCD (THESE CARDS ARE READ, TEXT, REWIND,                   01254634
*         SKIP,SLASH, NOLIST, LIST, ABBREV, NOABBREV,                   01254635
*         END AND LIMIT) A JUMP IS MADE TO THE APPROPRIATE              01254636
*         LOCATION.  AFTER ONE OF THESE CONTROL CARDS IS                01254637
*         PROCESSED, A JUMP IS MADE TO THE BEGINNING OF                 01254638
*         READCD AND THE NEXT CARD IS READ.  IF THE CARD                01254639
*         CANNOT BE PROCESSED IN READCD, X1 IS SET TO                   01254640
*         ZERO, AND A NORMAL EXIT IS MADE.                              01254641
*                                                                       01254642
*         IF A CARD IS BEING READ FROM AN ALTERNATE UNIT,               01254643
*         THE READFIL FET IS USED.  IF AN END OF RECORD                 01254644
*         IS ENCOUNTERED, THE FILE NAME AND CONTROL FLAGS               01254645
*         ARE CLEARED AND A NORMAL EXIT FROM READCD IS                  01254646
*         MADE WITH X1 NON-ZERO IF THE READ IN PROGRESS                 01254647
*         IS FROM AN ADDFILE.  IF AN ADDFILE READ IS NOT                01254648
*         IN PROGRESS AND AN END OF RECORD IS ENCOUNTERED,              01254649
*         A JUMP IS MADE TO THE BEGINNING OF READCD TO TRY              01254650
*         TO READ FROM THE MAIN INPUT FILE.  IF AN END OF               01254651
*         RECORD IS NOT ENCOUNTERED, THE CARD IS READ                   01254652
*         INTO CARD, SQUEEZED BY CALLING SQUEEZE, AND                   01254653
*         CLASSIFIED (BY CALLING CLASSIFY),  PROCESSING                 01254654
*         CONTINUES AS IT DOES FOR CARDS WHICH WERE READ                01254655
*         FROM THE MAIN INPUT FILE EXCEPT THE CERTAIN CON-              01254656
*         TROL CARDS WHICH ARE HANDLED IN THE NORMAL CASE               01254657
*         CANNOT BE HANDLED DURING A READ FROM AN ALTERNATE             01254658
*         CARD (READ, REWIND, AND SKIP).                                01254659
*                                                                       01254660
*         IF THE FILE BEING READ IS ALREADY IN SQUEEZED                 01254661
*         FORMAT, THE FIRST WORD READ SHOULD CONTAIN THE                01254662
*         LENGTH OF THE SQUEEZED CARD IMAGE THAT FOLLOWS.               01254663
*                                                                       01254671
*         CALLS  SQUEEZE, CLASSIFY, ATTACH, GETCH, SCNN, PRINT, SCITEM, 
*                UCARD, ADDWORD, READC, READW 
          SPACE  2
 READCDI  JP     *+1S17            ENTRY FOR INITIAL READ 
          CHKFILE  INPUT
          OPEN   INPUT,READNR 
          ENV    ACT,(2,3),VER2 
          SX2    INPUT
          RJ     CHKFMT 
 VER2     ENDIF 
          CLEAR  INPUT,READ 
  
          SA1    READCDI           ENTRY POINT
          SA5    MODEI             INPUT FILE MODE
          BX6    X1 
          SA6    READCD            SAVE ENTRY IN MAIN ENTRY 
          VOID
          ZR     X5,READCDI3       DEFAULT TERMINAL TO 6-BIT
          NG     X5,READCDI3       6-BIT READ REQUESTED 
* 
          SA1    INPUT+1           ** STF FUNCTION ** 
          MX3    -12
          LX1    -48
          BX4    -X3*X1 
          SX6    X4-2RTT           NOS
          ZR     X6,STFX
          AX4    6
          SX6    X4-61B            NOS/BE 
 STFX     BSS    0
* 
          NZ     X6,READCDI3       NOT A TERMINAL 
          SA2    INPUT+1
          MX7    1                 SET BIT 42 IN WORD 2 
          SX6    11B               SET BITS 19, 22 IN WORD 6
          LX7    42+1 
          BX7    X2+X7             ENABLE USE OF WORD 6 
          LX6    19 
          SA6    INPUT+5
          SA7    A2 
* 
 READCDI3 MX6    0
          SA6    CARD              FLAG NO DATA 
          SA1    ZIP                SEE IF Z MODE 
          NZ     X1,READCD21        YES 
          READC  INPUT,CARD8,CARDSZE8+1  WORST CASE, TRY 8-BIT
          NZ     X1,READCD2B       IMMEDIATE EOR
          SA1    CARD8             EXAMINE CARD IMAGE 
          SA2    FLGCHAR
          MX0    -8 
          LX1    12                LOOK AT FIRST CHARACTER
          SA2    X2+SIXTAB         CONVERT FLAG CHARACTER TO ASCII
          BX1    -X0*X1 
          IX2    X1-X2             IS IT 8-BIT *
          SX7    B1 
          ZR     X2,READCDI4       YES, 8-BIT FILE
          MOVE   CARDSIZE+1,CARD8,CARD  6-BIT, MOVE CARD
          MX7    0
          SA7    CARD8             CLEAR CARD8 PRESENT
          SX7    -B1               FLAG 6-BIT 
 READCDI4 SA7    MODEI             FLAG INPUT MODE FOR LATER
          MX1    0
          EQ     READCD2B          JOIN MAIN LINE READ
READCD7   RJ     SQUEEZE           COMPRESS CARD FROM ALTUNIT 
          SB4    LPARLIST 
          RJ       CLASSIFY 
          SA2    SKIPID 
          NZ     X2,READCD50
          CLASIFY 
          ZR     X1,READCD
          SA3    DEFAULT
          SA2    =10H ***** 
          ZR     X3,READCD7A
          SA2    =10H ///// 
          MX6    0
          SA6    A3 
READCD7A  BX6    X2 
          SA6    DNAME
          CCJUMP ENDTEXT,READCD17  ENDTEXT CARD                         0081  11
          CCJUMP SLASH,READCD8
          CCJUMP NOLIST,READCD12
          CCJUMP TEXT,READCD18
          CCJUMP LIST,READCD13
          CCJUMP ABBREV,READCD14
          CCJUMP NOABBREV,READCD15
          CCJUMP END,READCDA
          CCJUMP LIMIT,READCD23 
          IF     DEF,DECLKEY,1
          CCJUMP DECLARE,READCD19 
          CCJUMP SKIP,READCD9 
          CCJUMP READ,READCD9 
          CCJUMP REWIND,READCD9 
          MX1    0
READCD    PS
 READCDA  SX6    B0                CLEAR ALL *CARD PRESENT* FLAGS 
          MX7    0
          SA6    CARD 
          SA7    CARD8
          SA6    SQLGN
          SA7    SQLGN8 
          SA6    PRINTED
          SA7    CURCARD
          SA6    DEFAULT
          SA2    =1H
          BX6    X2 
          SA6    DNAME
          SA1    ALTUNIT           CHECK IF WE ARE READING FROM ALTERNAT
          NG     X1,CORCOPYP       COPYING CARDS
          NZ     X1,READCD3 
READCD2   SA1    ZIP
          NZ     X1,READCD21       ALREADY SQUEEZED 
          SA1    NOIFILE
          NZ     X1,READCD         EXIT IF NO FILE
          SA1    MODEI             I-FILE MODE
          PL     X1,READCD2A       8-BIT READ 
          READC  INPUT,CARD,CARDSIZE
          EQ     READCD2B 
 READCD2A READC  INPUT,CARD8,CARDSZE8 
 READCD2B BX6    X1 
          SA6    NOIFILE           SAVE EOR/EOF FLAG
          NZ     X1,READCD         EOR ENCOUNTERED
          RJ     SQUEEZE
* 
READCD22  SB4    LPARLIST 
          RJ     CLASSIFY          CHECK FOR READ ETC CARDS 
          SA2    SKIPID 
          NZ     X2,READCD50
          CLASIFY 
          ZR     X1,READCD
          SA4    DEFAULT
          SA2    =10H ***** 
          ZR     X4,READCD99
          SA2    =10H ///// 
READCD99  BX6    X2 
          SA6    DNAME
          CCJUMP ENDTEXT,READCD17  ENDTEXT CARD                         0081  14
          CCJUMP READ,READCD4 
          CCJUMP TEXT,READCD18
          CCJUMP REWIND,READCD5 
          CCJUMP SKIP,READCD6 
          CCJUMP SLASH,READCD8
          CCJUMP NOLIST,READCD12
          CCJUMP LIST,READCD13
          CCJUMP ABBREV,READCD14
          CCJUMP NOABBREV,READCD15
          CCJUMP END,READCDA
          CCJUMP LIMIT,READCD23 
          SPACE  1
          IF     DEF,DECLKEY,1
          CCJUMP DECLARE,READCD19 
READCD1   MX1    0                 INDICATE NORMAL EAD
          EQ     READCD 
          SPACE  1
READCD4   RJ     ATTACH            /READ CARD ENCOUTERED
          NZ     X6,READCD+1
          SX6    B1                SET FLAG 
          SA1    TCRBIN1
          BX7    X1 
          SA7    CARD3
          SA6    ALTUNIT
 READCD4A CLEAR  READFIL,READ 
          EQ     READCD8
          SPACE  1
READCD3   BSS    0
          SA1    MODEI
          PL     X1,READCD3A
          READC  READFIL,CARD,CARDSIZE
          EQ     READCD3B 
 READCD3A READC  READFIL,CARD8,CARDSZE8 
 READCD3B BSS    0
          ZR     X1,READCD7        IF NOT EOF ON ALTUERNATE UNIT
          ENV    ACT,(2,3),VER2 
          STORE  RDFIL76,BT=NO      RESET DEFAULTS
          STORE  RDFIL76,RT=W 
          STORE  RDFIL76,FL=5120
          STORE  RDFIL76,MRL=5120 
 VER2     ENDIF 
          SA1    ADDFLAG
          MX6    0
          SA2    =1H
          BX7    X2                CLEAR FILE NAME FROM CARD
          SA7    CARD3
          SA6    ALTUNIT
          SA2    INITFIL
          SX7    X2+B1             = 0 INDICATES EOR FROM *READ DURING
          SA7    A2                    PROCESSING OF *ADDFILE 
          ZR     X7,READCD         IF FROM *READ DURING *ADDFILE
          SA6    A1                TURN OFF *ADDFILE FLAG.
          NZ     X1,READCD
          EQ     READCD2
  
READCD5   RJ     ATTACH            REWIND 
          NZ     X6,READCD+1
          REWIND READFIL
          EQ     READCD4A 
          SPACE  1
          SPACE  1
READCD6   RJ     ATTACH            SKIP,N 
          NZ     X6,READCD+1
          RJ GETCH               SKIP OVER COMMA
          RJ     SCNN              GET RECORD COUNT 
          SB7    X6 
  
          ENV    ACT,(2,3),VER2 
          STORE  RDFIL76,DX=READCD6B
 READCD6A SKIPFL RDFIL76,10000
          EQ     READCD6A 
 READCD6B BSS    1
          SB7    B7-B1
          GE     B7,B1,READCD6A 
VER2      ELSE
 READCD6A SKIPF  READFIL,B7 
VER2      ENDIF 
  
          ENV    ACT,(2,3),VER2 
          STORE  RDFIL76,DX=0 
VER2      ENDIF 
          EQ     READCD4A 
  
          SPACE    1
READCD8   SA1    LISTTWO
          ZR     X1,READCDA 
          PRNTCARD
          EQ     READCDA
          SPACE  1
READCD9   SA1    NFERROR           FETCH NON FATAL ERROR COUNT. 
          SX6    X1+B1             INCREMENT NON FATAL ERROR COUNT. 
          SA6    A1                STORE NEW VALUE. 
          SA1    LISTONE
          ZR     X1,READCDA        IF LIST OPTION ONE NOT SELECTED. 
          RJ     PRINTERR          PRINT CARD IN ERROR. 
          PRINT  BDREAD,7          PRINT ERROR MESSAGE. 
          EQ     READCDA           GO GET NEXT CARD.
          SPACE  1
READCD12  MX6    0
          SA6    LISTFOUR 
          EQ     READCD8
          SPACE  1
 READCD13 SA3    LISTFORA          RESUME LIST ONLY IF L=4 SELECTED 
          BX6    X3 
          SA6    LISTFOUR 
          EQ     READCD8
          SPACE  1
READCD14  SX6    B1 
          SA6    ABBFLAG
          EQ     READCD8
          SPACE  1
READCD15  MX6    0
          SA6    ABBFLAG
          EQ     READCD8
          SPACE  1
READCD17  SA3    TXTFLAG           ENDTEXT CARD                         0081  16
          SX6    X3-1                                                   0081  17
          SA6    A3                                                     0081  18
          PL   X6,READCD1                                               1704   5
          RJ   TXTERR                                                   1704   6
          EQ     READCD8
          SPACE  1                                                      0081  20
READCD18  SA3    TXTFLAG           TEXT CARD                            0081  21
          SX6    X3+B1                                                  0081  22
          SA6    A3                                                     0081  23
          EQ     READCD1                                                0081  24
          SPACE  1
A         IF     DEF,DECLKEY
          SPACE  1
READCD19  RJ     SCITEM 
          ZR     X7,READCD20
          BX1    X7 
          SA2    F.DECTAB 
          SA3    L.DECTAB 
          SB4    X3 
READ19A   ZR     B4,READ19B 
          SB4    B4-B1
          SA3    X2+B4
          IX3    X3-X1
          NZ     X3,READ19A 
          SX3    B4+B1
          EQ     READ19C
 READ19B  ADDWRD DECTAB,X1
READ19C   SX7    X3 
          LX7    36 
READCD20  SA7    DECLDECK 
          EQ     READCD8
          SPACE  1
A         ENDIF 
          SPACE  1
 READCD21 READW  INPUT,SQLGN,1
          NZ     X1,READCD         EOR
          SA1    SQLGN
          ZR     X1,READCD22       NULL CARD
          READW  INPUT,SQIMAGE,X1 
          RJ     SQUEEZE
          EQ     READCD22 
          SPACE  1
READCD50  CLASIFY 
          CCJUMP IDENT,READCD51    JUMP IF IDENT
          CCJUMP READ,READCD53     IF *READ DIRECTIVE.
          EQ     READCD+1          ELSE GET NEXT CARD.
  
READCD53  SA2    ALTUNIT
          NZ     X2,READCD9        IF ALTERNATE UNIT - ERROR. 
          EQ     READCD4           ELSE SET UP ALTERNATE FILE.
          SPACE  1
READCD51  SA1    =10H ***** 
          SA4    DEFAULT
          ZR     X4,READCD52
          SA1    =10H ///// 
READCD52  BX6    X1 
          MX7    0
          SA6    DNAME
          SA7    A2 
          MX1    0
          EQ     READCD 
          SPACE  1
READCD23  RJ     SCNN 
          SA6    LLIMIT 
          EQ     READCD8
          EJECT  4                                                      01257469
**        SQUEEZE  SQUEEZE OUT BLANKS                                   01254675
*                                                                       01254676
*         SQUEEZE PROCESSES THE CARD THAT HAD JUST BEEN                 01254677
*         READ AND IS IN THE AREA FROM CARD TO CARDSIZE-1.              01254678
*         IT SQUEEZES OUT THE BLANKS AND CREATES THE                    01254679
*         SQUEEZED CARD IMAGE IN SQIMAGE WITH THE LENGTH                01254680
*         OF SQIMAGE IN SQLGN.  IF ABBFLAG IS SET, PROCABB              01254681
*         IS CALLED TO CHECK FOR AND EXPAND ANY CONTROL                 01254682
*         CARD ABBREVIATIONS.  MORE THAN 2 CONTIGUOUS                   01254683
*         BLANKS ARE REPRESENTED BY 00NNB, WHERE NN IS 1                01254684
*         LESS THAN THE NUMBER OF BLANKS REPRESENTED.  IF               01254685
*         PROCABB FOUND AND EXPANDED AN ABBREVIATION,                   01254686
*         UCARD IS CALLED TO UNPACK THE NEWLY CREATED                   01254687
*         SQUEEZED LINE INTO CARD SO THAT CARD WILL CON-                01254688
*         TAIN THE EXPANDED ABBREVIATION.                               01254689
*                                                                       01254690
*         CALLS  PUTNEXC, GETNEXC, UCARD                                01254691
          SPACE  2
SQUEEZE   PS
          SA1    SQLGN
          NZ     X1,PROCABB        LINE ALREADY SQUASHED
          SA1    CARD 
          NG     X1,SQUEEZE1       MAY BE -ZERO 
          NZ     X1,SQUEEZE1       SQUEEZE FROM 6-BIT IMAGE 
          SA1    CARD8
          ENV    ACT,(2,3),VER2 
          NZ     X1,SQUEEZEA
          SA2    WCW               W CTL WORD 
          SB6    X2 
          NE     B6,B0,SQUEEZE1    MUST BE COLONS 
 SQUEEZEA BSS 
 VER2     ELSE
          ZR     X1,SQUEEZE        NO CARD TO SQUEEZE 
 VER2     ENDIF 
          RJ     SQUEEZ8
          RJ     CONV8TO6 
          EQ     PROCABB
* 
 SQUEEZE1 SA1    CARD-1            SETUP
          SB6    B0 
          MX6    0
          SB5    10 
          SX3    1R 
          SA6    SQLGN
          SB7    CARDSIZE 
          MX0    54 
          SB2    B0 
  
 SQLOOP1  RJ     GETNEXC           GET A CHARACTER
          NG     B7,SQUEEZN        DONE WITH CARD 
          ZR     X4,SQBLANK 
 SQLOOP1A NZ     X2,SQLOOP2 
          RJ     PUTNEXC           COLON  00-01 
          SX2    B1 
 SQLOOP2  RJ     PUTNEXC
          EQ     SQLOOP1
  
 SQBLANK  SB4    1                 STARTING BLANK COUNT 
 SQBLANK1 RJ     GETNEXC           COLLECT BLANKS 
          NG     B7,SQUEEZM        FORGET TRAILING BLANKS 
          NZ     X4,SQBLANK2
          SB4    B4+B1
          EQ     SQBLANK1 
  
 SQBLANK2 SB4    B4-100B           HOW MANY BLANKS
          NG     B4,SQBLANK3       LESS THAN 100B 
          SX2    B0 
          RJ     PUTNEXC
          SX2    77B               MAX COUNT
          RJ     PUTNEXC
          EQ     SQBLANK2 
  
 SQBLANK3 SB4    B4+77B            REMAINING BLANK COUNT
          GT     B4,B1,SQBLANK4    MORE THAN 2
          NG     B4,SQBLANKA       NONE 
          BX2    X3 
          RJ     PUTNEXC
          ZR     B4,SQBLANKA       ONE
          RJ     PUTNEXC           TWO
 SQBLANKA IX2    X4+X3             RESTORE CHARACTER TO X2
          EQ     SQLOOP1A 
  
 SQBLANK4 SX2    B0                3 TO 63 BLANKS 
          RJ     PUTNEXC
          SX2    B4 
          RJ     PUTNEXC
          IX2    X4+X3
          EQ     SQLOOP1A 
  
 SQUEEZM  SB4    A6-SQLGN 
          NZ     B4,SQUEEZN        NOT FIRST WORD 
          SB4    B5-10
          NZ     B4,SQUEEZN        NOT EMPTY
          BX2    X3 
          RJ PUTNEXC               INSURE 1 BLANK 
 SQUEEZN  ZR     B5,SQUEEZX 
          SX2    B0                FILL OUT WITH ZERO 
 SQUEEZN1 RJ     PUTNEXC
 SQUEEZX  NZ     B5,SQUEEZN1
          SA6    A6+B1             STORE LAST WORD
          SX7    A6-SQLGN          LENGTH IN WORDS
          MX6    0
          SA6    A6+B1             ZERO WORD FOLLOWING FOR ABBREV FILL
          SA7    SQLGN
  
          EQ     PROCABB           EXPAND ABBREVIATIONS 
          EJECT  4                                                      01257471
**        PROCABB  EXPAND ABBREVIATIONS                                 01254693
*                                                                       01254694
*         THIS SUBROUTINE IS CALLED FROM SQUEEZE TO SEARCH              01254695
*         FOR AND EXPAND ABBREVIATIONS.  PROCABB EXPECTS                01254696
*         REGISTER TO HAVE BEEN SET UP AS IN THE SQUEEZE                01254697
*         INITIALIZATION.  GETNEXC AND PUTNEXC ARE CALLED               01254698
*         TO FETCH AND STORE EACH CHARACTER BEING PROCESSED.            01254699
*         WHEN A POTENTIAL ABBREVIATION IS FOUND, THE AP-               01254700
*         PROPRIATE ABBREVIATION TABLE IS SEARCHED (TAB1                01254701
*         OR TAB2) AND IF A MATCH IS FOUND THE EXPANDED                 01254702
*         WORD IS WRITTEN INTO SQIMAGE.  IF A MATCH IS                  01254703
*         NOT FOUND, PROCABB RETURNS TO SQUEEZE.  THE AB-               01254704
*         BREVIATION TABLES ARE SEARCHED ONLY WHEN A CARD               01254705
*         IS FOUND WHICH BEGINS WITH ONE OF THE FOLLOWING               01254706
*         COMBINATIONS OF CHARACTERS:  AXN OR AXXN, WHERE               01254707
*         A = CONTROL CHARACTER, X = ANY CHARACTER WITH                 01254708
*         DISPLAY CODE VALUE LESS THAN 55B, AND N = ANY                 01254709
*         CHARACTER WITH DISPLAY CODE VALUE OF 55B OR                   01254710
*         GREATER.                                                      01254711
*                                                                       01254712
*         CALLS  GETNEXC, PUTNEYC                                       01254713
          SPACE  2
 PROCABB  SA1    ABBFLAG
          ZR     X1,SQUEEZE        NO ABBREVIATIONS ALLOWED 
          SA1    SQIMAGE
          SA4    FLGCHAR           GET CONTROL CHARACTER
          MX0    -6 
          LX1    6
          BX2    -X0*X1 
          IX2    X4-X2
          LX1    6
          NZ     X2,SQUEEZE        FIRST CHARACTER NOT CONTROL
          BX2    -X0*X1            POSSIBLE 1 CHAR ABBREV 
          LX1    6
          BX3    -X0*X1            CHECK TERMINATOR 
          SB2    B1+B1
          SX3    X3-1              A-= MAPS TO 00-53
          BX3    -X0*X3 
          MX7    48 
          SX3    X3-54B 
          SA5    TXTFLAG
          NG     X3,PROCAB2        CANT BE ONE CHARACTER
          NZ     X5,PROCAB2        LOOKING FOR *ET ONLY 
  
          SB4    -6 
          SA3    TAB1 
          SB3    LTAB1
 ABBLOOP1 IX3    X3-X2
          ZR     X3,ABBFOUND       MATCH
          SA3    A3+B2
          SB3    B3-B1
          NZ     B3,ABBLOOP1
          EQ     SQUEEZE           NO MATCH 
  
 PROCAB2  BX2    -X7*X1            TWO CHARACTERS 
          LX1    6
          BX3    -X0*X1            TERMINATOR 
          SX3    X3-1 
          BX3    -X0*X3 
          SX3    X3-54B 
          NG     X3,SQUEEZE        CANT BE TWO CHARACTERS 
  
          SB4    -12
          SA3    TAB2 
          SB3    LTAB2
 ABBLOOP2 IX3    X3-X2
          ZR     X3,ABBFOUND       MATCH
          NZ     X5,SQUEEZE        NOT *ET WHEN TXTFLAG NON ZERO
          SA3    A3+B2
          SB3    B3-B1
          NZ     B3,ABBLOOP2
          EQ     SQUEEZE           NO MATCH 
  
 ABBFOUND SA3    A3+B1             EXPAND ABBREVIATION
          SA7    DEFAULT           SET NON-ZERO FOR FLAG
          BX5    -X0*X3            NUMBER OF CHARACTERS (EXPANDED)
          BX3    X0*X3
          IX3    X3+X4
          LX3    54                FIRST PART OF EXPANSION
          LX5    1                 *2 
          LX4    X5,B1             *4 
          IX5    X4+X5             *6 = BITS IN *KEY... 
          LX1    54-6 
          SB5    X5 
          MX0    6
          AX0    B5                K+1 CHARACTER MASK 
          AX1    B5 
          BX1    -X0*X1 
          IX6    X3+X1             FIRST EXPANDED WORD
  
          SB5    B4+B5             EXCESS CHARACTERS (BITS) 
          SB5    -B5
          SB5    B5+60-1
          MX0    1
          AX0    B5 
          SB5    B5+B1
          LX0    B5 
          SA2    SQIMAGE           EXPAND LOOP
          LX1    X2,B5
          SA6    A2 
 ABBXP    SA2    A2+B1
          LX2    B5 
          BX6    -X0*X1 
          BX5    X0*X2
          BX6    X6+X5
          LX1    X2 
          SA6    A2 
          NZ     X2,ABBXP 
          ZR     X6,ABBXS          NO NEED FOR EXTRA ZERO WORD
          MX6    0
          SA6    A2+B1             FINAL STORE
 ABBXS    SX7    A6-SQIMAGE 
          SA6    CARD              FLAG TO REEXPAND CARD IMAGE
          SA7    SQLGN             NEW LENGTH 
  
          EQ     SQUEEZE           DONE 
          EJECT                                                         01256964
**        CREATION RUN PROCESSING                                       01256965
*                                                                       01256966
*         WHEN THE FIRST CARD (EXCEPT THE CARDS PROCESSED BY READCD)    01256967
*         READ FROM THE INPUT FILE IS A DECK OR COMDECK CARD, UPDATE    01256968
*         ASSUMES A CREATION RUN AND ENTERS CREATION RUN CODE AT NEW.   01256969
*         A NEWPL IS ALWAYS PRODUCED ON A CREATION RUN SO THE NAME      01256970
*         NEWPL IS PUT INTO THE NEWPL FET IF NO SUBSTITUTE NAME HAS     01256971
*         BEEN SPECIFIED.  LIST OPTIONS 3 AND 4 ARE SET OFF UNLESS      01256972
*         THESE OPTIONS HAVE BEEN EXPLICITLY SELECTED.  THE NEWPL       01256973
*         IS OPENED TO DETERMINE WHETHER OR NOT NEWPL WILL BE A RANDOM  01256974
*         FILE.  IF NEWPL IS TO BE RANDOM IT CAN BE PRODUCED DIRECTLY   01256975
*         IN A ONE PASS OPERATION AND A JUMP IS TAKEN TO ONEPASS.       01256976
*         IF NEWPL IS TO BE SEQUENTIAL, HOWEVER, UPDATE MUST BE A TWO-  01256977
*         PASS PROCESS BECAUSE THE LISTS OF DECK AND IDENT NAMES WHICH  01256978
*         APPEAR AT THE HEAD OF A SEQUENTIAL PL WILL NOT BE KNOWN       01256979
*         UNTIL THE INPUT STREAM HAS BEEN READ.  SINCE THIS INPUT       01256980
*         STREAM WOULD CONSIST OF RECORDS FROM SEVERAL FILES,           01256981
*         POSITIONING COULD BECOME A PROBLEM IN PASS 2 IF THE INPUT     01256982
*         STREAM WAS NOT CONSOLIDATED AS IT WAS READ IN PASS 1.  FOR    01256983
*         THIS REASON PASS 1 PROCESSES THE INPUT STREAM AND CREATES A   01256984
*         TEMPORARY SEQUENTIAL NEWPL ON A FILE NAMED UPDTTPL.  PASS 2   01256985
*         SIMPLY COPIES THIS TEMPORARY FILE TO NEWPL AFTER THE DECK AND 01256986
*         IDENT LISTS HAVE BEEN WRITTEN.                                01256987
*         THE FLAG RANDNPL IS SET NEGATIVE WHILE THIS TEMPORARY NEWPL   01256988
*         IS BEING WRITTEN.  EVERY TIME A NEW DECK OR COMDECK CARD IS   01256989
*         ENCOUNTERED, THE CURRENT RECORD IS ENDED AND THE INDEX ADDED  01256990
*         TO THE TABLE NEWDKS IF A RANDOM NEWPL IS BEING WRITTEN.  IN   01256991
*         ANY CASE THE NEW DECK NAME IS ADDED TO NEWDKS.  UNLESS THE NEW01256992
*         NAME IS A DUPLICATE OF A NAME ALREADY IN THE DECK LIST.  THE  01256993
*         TABLES DECKS AND NEWDKS ARE ALSO UPDATED AT THIS TIME.  A NEW 01256994
*         PRIMARY CHB IS BUILD AND THE SEQUENCE NUMBER IS RESET TO 1.   01256995
*         AS EACH CARD IS READ, WRNPL WRITES IT TO THE NEWPL.  THE CON- 01256996
*         SOLE B DISPLAY MESSAGE "UPDATING FNAME" IS UPDATED TO DISPLAY 01256997
*         THE NEW DECK NAME.  IF A COMPILE OR SOURCE FILE IS TO BE      01256998
*         WRITTEN THE SUBROUTINES WRCOM AND/OR WRSOU ARE CALLED TO WRITE01256999
*         THESE FILES.  WHEN THE INPUT STREAM HAS BEEN READ, A JUMP IS  01257000
*         TAKEN TO THE SECTION OF UPDATE WHICH FINISHES PROCESSING THE  01257001
*         RANDOM NEWPL IF ONE IS BEING PRODUCED.  IF A SEQUENTIAL NEWPL 01257002
*         IS TO BE PRODUCED THE TEMPORARY FILE UPDTTPL IS NOW COPIED    01257003
*         TO NEWPL.  WHEN THE FILE HAS BEEN COPIED A JUMP IS MADE TO THE01257004
*         FINAL PROCESSING SECTION.                                     01257005
*                                                                       01257006
          SPACE  1
NEW       MOVE   2,CRELAB,TITLE 
          SA1    NEWPL
          MX6    60 
          SA6    CHARKEY           SET 64 CHARACTER KEY 
          SA2    MODEN             DECLARED NEWPL MODE
 CSET     IFNE   IP.CSET,IP.C63 
          SX6    1R4-1R5           HEADER FOR 64 CSET 6-BIT NEWPL 
 CSET     ELSE
          SX6    1R3-1R5           HEADER FOR 63 CSET 6-BIT NEWPL 
 CSET     ENDIF 
          NG     X2,NEW.3          6-BIT (FORCED) 
  
          SA2    MODEI             USE INPUT MODE 
          NG     X2,NEW.3          6-BIT INPUT
 CSET     IFNE   IP.CSET,IP.C63 
          SX6    1R8-1R5           HEADER FOR 64 CSET 8-BIT NEWPL 
 CSET     ELSE
          SX6    1R7-1R5           HEADER FOR 63 CSET 8-BIT NEWPL 
 CSET     ENDIF 
 NEW.3    SA6    MODENF 
          NZ     X1,NEWOK 
          SA2    TEMPNPL
          BX6    X2 
          SA6    A1 
*                                  READCD SET DNAME FOR THE *DECK/*DK CD
 NEWOK    SA1    AFLIST            IF LIST OF INPUT WANTED, SKIP
          NZ     X1,NEWSETOK
          MX6    0
          SX7    B0 
          SA6    LISTHREE 
          SA7    LISTFOUR 
          SA6    LISTFORA 
 NEWSETOK MESSAGE (=C+UPDATE CREATION RUN+) 
          MX7    0
          SA7    SCNUM
          SA7    AUDIT             NO AUDIT FOR CREATION RUN
          SX6    B1 
          SA6    CREFLG            SET CREATION RUN FLAG
          MX7    60 
          MX6    1
          SA6    FMODE
          SA7    DECKFLAG 
          SA6    EDITFLAG          FORCE SEQUENTIAL PL TO TEMPORARY 
          SA6    CARDSTAT 
          RJ     OPENNPL           OPEN,REWIDN(IF OK) THE NEWPL .       0658  74
          MX7    36                CREATE MASK                          0883   5
          SA1    NEWPL+12                                               0883   6
          BX7    -X7*X1            CLEAR FIELD                          0883   7
          SA7    A1                                                     0883   8
          MX7    0                                                      0695   8
          SA7    FASTFLG           IGNORE Q MODE                        0695   9
          SA6    RANDNPL           SAVE PL MODE 
          PL     X6,ONEPASS        IF NEWPL TO BE RANDOM.               0658  76
          MESSAGE (=C+COPYING INPUT TO TEMPORARY NEWPL+)
  
          CLEAR  NEWPL,WRITE
OUTRLOOP  SA1    RANDNPL
          NG     X1,OUTRLP1 
          WRITER NEWPL,RECALL 
          CLEAR  NEWPL,WRITE
          SX6    RANDTEMP          RESET FOR RANDOM WRITE AND GET 
          SA6    NEWPL+6           CURRENT INDEX VALUE TO ADD TO
          SA1    X6                DECK LIST. 
 OUTRLP1  ADDWRD NEWDKS,X1
          RJ     SCITEM            GET NAME AND CHEK FOR
          ZR     X7,NEWBLNK  IF BLANK DECKNAME
          RJ     TLUDIR            DUPLICATES. IF NAME IS UNIQUE
          SA7    IDFLG             ADD IT TO DIRECTORY AND DECK LIST. 
          NZ     X2,NEWDUPE 
          SA2    DECKFLG           SET DECK BIT 
          BX7    X7+X2
 DUPNDK   SA7    TCRBIN4
          ADDWRD NEWDKS,X7
          ALLOC  DECKS,2
          SA1    TCRBIN4
          IX4    X2+X3
          BX7    X1 
          SA7    X4-1 
          SA2    DECKFLG           CLEAR BIT FROM WORD SO THAT IT        CP190
          BX1    -X2*X1            WONT BE PUT INTO DIRECT.              CP190
          MX6    0                 CLEAR                                 CP190
          SA6    A2                      DECKFLG.                        CP190
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          SX6    B1 
          SX7    X3+177777B        SET UP PRIMARY CHB AND SEQUENCE
          SA6    SEQNUM            NUMBER.
          SA7    CHBTAB 
          SA6    LCHBTAB
          MESSAGE WRCMS,1 
INERLOOP  RJ     WRNPL
          SA1    CURCARD
          ZR     X1,INERLP1        NOT A CONTROL CARD 
          SA1    LISTTWO
          ZR     X1,NOPRLOOP
          EQ     INERLP2
          SPACE  1
INERLP1   BSS    0
          SA1    LISTFOUR          L=4 GIVES LIST OF
          ZR     X1,NOPRLOOP       INPUT STREAM ON A CREATION RUN.
INERLP2   BSS    0
          RJ     ADDID
          PRNTCARD
          SA1    CURCARD
          ZR     X1,NOPRLOOP
          SA1    =1H
          BX6    X1 
          SA6    DNAME
NOPRLOOP  SA1    SOURCE 
          ZR     X1,NONSOURC
          RJ     WRSOU
NONSOURC  SA1    COMP 
          ZR     X1,NONCOMP 
          CLASIFY 
          CCJUMP TEXT,NONCOMP 
          CCJUMP ENDTEXT,NONCOMP
          RJ     WRCOM
NONCOMP   RJ     READCD 
          NZ     X1,NEWEND
          CLASIFY 
          ZR     X1,GOODCARD
*                                  READCD SET DNAME FOR DIRECTIVES
          CCJUMP DECK,STDKBIT1                                           CP190
          CCJUMP COMDECK,OUTRLOOP 
          CCJUMP END,NOPRLOOP 
          CCJUMP CALL,GOODCARD
          CCJUMP WEOR,GOODCARD
          CCJUMP CWEOR,GOODCARD 
          CCJUMP TEXT,GOODCARD
          CCJUMP ENDTEXT,GOODCARD 
          CCJUMP IF,GOODCARD
          CCJUMP ENDIF,GOODCARD 
          CCJUMP WIDTH,GOODCARD 
          SA1    LISTONE
          ZR     X1,CRERROR1
          RJ     PRINTERR 
          PRINT  CREAILL,6
CRERROR1  BSS    0
          SA1    ERRORS 
          SX6    X1+B1       BUMP ERROR COUNT 
          SA6    A1 
          EQ     NONCOMP
  
GOODCARD  SA1    SEQNUM 
          SX6    X1+B1
          NG     X6,SEQERR         JUMP IF SEQUENCE NUMBER IS TOO BIG 
          SA6    A1 
          EQ     INERLOOP 
          SPACE  1
NEWEND    SA1    RANDNPL
          NG     X1,NEWEND3        JUMP IF SEQ NEWPL
          SA1    ERRORS 
          ZR     X1,DONEALM        JUMP IF NO ERRORS
          MX6    0
          SA6    L.DECKS           SET LENGTH OF DECKS TO ZERO
          EQ     DONEALM
          SPACE  1
 NEWEND3  BSS    0                 SEQUENTIAL PL CLOSE
          RJ     COPYEND
          SA1    RANDTEMP 
          ADDWRD NEWDKS,X1
          MESSAGE (=C+CREATING NEW PROGRAM LIBRARY+)
  
          SA1    ERRORS 
          ZR     X1,FCOR1          JUMP IF NO ERRORS
          MX6    0
          SA6    L.DECKS           SET L.DECKS TO ZERO
          EQ     FCOR1
          SPACE  1
ONEPASS   BSS    0                 NEWPL TO BE RANDOM.                  0658  78
          SA6    RANDNPL
          SX6    RANDTEMP 
          SA6    NEWPL+6
          MX6    0
          SA6    OLDPL
  
          MESSAGE (=C+CREATING NEW PROGRAM LIBRARY+)
  
          EQ     OUTRLOOP 
  
NEWBLNK   SA1    LISTONE
          ZR     X1,NEWDUPE1  IF L=1 NOT SPECIFIED
          RJ     PRINTERR 
          PRINT  P1ADDER6,4 
          EQ     NEWDUPE1 
  
NEWDUPE   SA1    LISTONE
          ZR     X1,NEWDUPE1
          RJ     PRINTERR 
          PRINT  CREADUP,5
NEWDUPE1  SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          SA1    =7H.ERROR.        PUT DUMMY NAME IN DECK LIST
          BX7    X1 
          EQ     DUPNDK 
          SPACE  1
**        PRINTERR  PRINTS CARD IN ERROR                                01255218
*                                                                       01255219
*         THIS SUBROUTINE IS CALLED BY PASS 1 ROUTINES                  01255220
*         TO PRINT A CARD WHICH IS IN ERROR.  THE WORD                  01255221
*         *ERROR* IS PRINTED AT BOTH ENDS OF THE PRINTED                01255222
*         LINE.                                                         01255223
*                                                                       01255224
*         CALLS  PRINT                                                  01255225
          SPACE  1
PRINTERR  PS
          PRINT  =8L,1
          SA1    =10H *ERROR* 
          BX6    X1 
          SA6    DNAME
          SA6    CARD4
          PRNTCARD
          SA1    =1H
          BX6    X1 
          SA6    DNAME
          SA6    CARD4
          EQ     PRINTERR 
          SPACE  1
**        ATTACH  ATTACH FILE TO READFIL                                01254715
*                                                                       01254716
*         THIS SUBROUTINE IS CALLED TO SET UP THE READFIL               01254717
*         FET TO PROCESS FILES AS A RESULT OF A READ, RE-               01254718
*         WIND, SKIP, OR ADDFILE (ON A FILE OTHER THAN                  01254719
*         THE MAIN INPUT FILE) CARD.  ANY CURRENT OPERATION             01254720
*         ON A FILE USING THIS FET IS COMPLETED, THE NEW                01254721
*         FILE NAME IS READ FROM THE CARD, THE FILE NAME                01254722
*         IS VALIDATED.                                                 01254723
*                                                                       01254724
*         CALLS  CPCLEAR, SCITEM, CHKFILE, CALLIO, PRINTERR, PRINT      01254725
          SPACE  1
ATTACH    PS
          CLEAR  READFIL
          ENV    ACT,(11),X 
          SA1    READFIL
          ZR     X1,ATTACH2 
          CLOSE  READFIL,R
 X        ENDIF 
ATTACH2   RJ     SCITEM 
          MX0    42 
          BX5    -X0*X7 
          NZ     X5,BADFNAME
          SX1    B1 
          BX7    X7+X1             ADD BUSY BIT 
          SA7    READFIL           STORE FILE NAME IN FET 
          LX6    54 
          SA6    TCRBIN1
          SA1    A7 
          RJ     CHKFILE           CHECK FOR DUPLICATE
          OPEN   READFIL,ALTERNR
          CLEAR  READFIL,READ 
  
          ENV    ACT,(2,3),RT 
          RJ     CHKFMT            CHECK *READ FILE FORMAT. 
RT        ENDIF 
  
          MX6    0
          EQ     ATTACH 
          SPACE  1
BADFNAME  SA1    LISTONE
          ZR     X1,BADFNAM1
          RJ     PRINTERR 
          PRINT  CREBFN,7 
BADFNAM1  SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          EQ     ATTACH 
          SPACE  2
          SPACE  1
          ENV    ACT,(2,3),BFMT 
BADFMT    DATA   C+0***MAIN OR ALTERNATE INPUT FILE IS IN AN UNSUPPORTED
, FORMAT ***+ 
BFMT      ENDIF 
  
 CREBFN   DATA   C+0*** FILE NAME ON THE ABOVE DIRECTIVE GREATER THAN SE
,VEN CHARACTERS ***+
CREADUP   DATA   C+0*** DUPLICATE DECK NAME ON CREATION RUN ***+
 CREAILL  DATA   C+0*** THE ABOVE DIRECTIVE IS ILLEGAL DURING A CREATION
,RUN ***+ 
 BDREAD   DATA   C+0*** THE ABOVE DIRECTIVE IS ILLEGAL IN AN ALTERNATE F
,ILE. IGNORED. ***+ 
CRELAB    DIS    2,1CREATION RUN
          SPACE  1
EPASSN    BSS    0
          SPACE  1
          HERE
          SPACE  1
KEY       SET    0
PASS      SET    1
          SPACE  1
          SPACE  1
*    THE PREVIOUS UPDATE CODE MUST BE POSITIONED WITHIN THE SPACE      *
*    ALLOCATED FOR THE UPDTSCR BUFFER -BUFM-.                          *
          SPACE  1
          SPACE  1
ECREATE   BSS    0
          EJECT  4                                                      01257473
**        OPTIONS TABLE                                                 01254375
*                                                                       01254376
*         OPTS DEFINES BEGINNING OF TABLE.  TABLE CONSISTS OF ENTRIES   01254377
*         CREATED BY OPTS MACRO.  ALL OPTIONS WHICH DEFINE FILE NAMES   01254378
*         MUST APPEAR BEFORE ANY OTHER OPTIONS.  LFILES DEFINES NUMBER  01254379
*         OF OPTIONS WHICH DEFINE FILE NAMES.  LOPTS DEFINES TOTAL      01254380
*         LENGTH OF TABLE.  THE OPTS TABLE IS USED AS SCRATCH AREA IN   01254381
*         PASS 1 AFTER ALL OPTIONS HAVE BEEN PROCESSED.  AT THIS TIME,  01254382
*         THE START OF THE TABLE IS DEFINED AS QCOL.                    01254383
          SPACE  1
OPTS      OPTS   P,OLDPL,OLDPL,7
          OPTS   N,NEWPL,NEWPL,7
          OPTS   I,INPUT,INPUT,7
          OPTS   O,OUTPUT,OUTPUT,7
          OPTS   C,COMPILE,COMP,7 
          OPTS   M,MERGE,MERGE,7
          OPTS   S,SOURCE,SOURCE,7
          OPTS   T,SOURCE,NOCOMMON,7
          OPTS   K,COMPILE,ORDERFLG,7 
          IF     DEF,PMODKEY,1
          OPTS   G,SOURCE,GFILE,7 
 FILEOPTS EQU    *                 MUST FOLLOW ALL FILENAME OPTIONS 
          SPACE  1
          OPTS   H,0,HEADER,1 
          OPTS   Q,X,FASTFLG,0
          OPTS   R,X,NOREWFLG,4 
          OPTS   W,X,NORANDOM,0 
          OPTS   L,A1234,AUDIT,10 
          OPTS   F,X,FMODE,0
          OPTS   D,X,FULLCOL,0
          OPTS   /,/,COMCHAR,1
          OPTS   *,*,FLGCHAR,1
          OPTS   8,X,EIGHTY,0 
          SPACE  1
          IF     DEF,EDITKEY,1
          OPTS   E,X,EDITFLAG,0 
          OPTS   A,X,CPYTOLIB,0 
          OPTS   B,X,CPYFMLIB,0 
          OPTS   Z,X,ZIP,0
          OPTS   U,X,ERRMODE,0
          OPTS   X,X,XMODE,0
LOPTS     EQU    *-OPTS 
          SPACE  4
QCOL      EQU    OPTS              SPACE USED TO RECONSTRUCT LINE DURING
QSQIMAGE  EQU    QCOL+1            EDITING OPERATION. 
          SPACE  2
          TITLE  CONTROL CARD CRACKER 
          EJECT 
*  *  *  *  *  *  *  *  *  SYSTEM ENTRY POINT  *  *  *  *  *  *  *  *  *
**        PASS ONE PROCESSING                                           01257023
*                                                                       01257024
*         UPDATE FIRST DETERMINES WHETHER OR NOT IT HAS SUFFICIENT FIELD01257025
*         LENGTH IN WHICH TO OPERATE.  IF IT DOES NOT, IT WILL ASK FOR  01257026
*         ADDITIONAL FIELD LENGTH IF DYNAMFL HAS BEEN SPECIFIED AT      01257027
*         ASSEMBLY TIME, OTHERWISE IT WILL ABORT.  PARAMETERS ARE THEN  01257028
*         READ FROM THE CONTROL CARD PROCESSED BY UPDATE.  WHEN ALL     01257029
*         PARAMETERS HAVE BEEN PROCESSED, SOME GENERAL INITIALIZATION IS01257030
*         PERFORMED TO SET UP FILES, FLAGS AND CALLS ACCORDING TO THE   01257031
*         SPECIFIED PARAMETERS.                                         01257032
          SPACE  2
UPDATE    SB1    1                 B1 WILL REMAIN EQUAL TO 1 THROUGHOUT 
*IF DEF,UPDEBUG 
 STARTUP  BREAK                    START IDP
*ENDIF
          ENV    ACT,(2,3),VER3 
          MEMORY  SCM,MAXMEM
VER3      ELSE
          MEMORY CM,MAXMEM,R
VER3      ENDIF 
          SA4    MAXMEM            FETCH MAXIMUM MEMORY ALLOWED.
          AX4    30                PUT MAX FL IN LOWER 30 BITS. 
          BX6    X4 
          SA6    A4                STORE MAX FL INTO MAXMEM.
          SX6    A0                CURRENT (LOAD) FL
          SA6    ORIGSIZE 
          SX7    A0-8              SLOP SPACE FOR MOVE ROUTINES 
          SA6    CORESIZE 
          SA7    F.TEND 
          SB5    A0-BUCKET-1000B   CHECK FOR ENOUGH SPACE TO RUN
          SB6    UPDATE00 
          NG     B5,ALTERFL        GET SPACE
 UPDATE00 SA1    F.TEND            CLEAR TABLE SPACE
          SB3    BUCKET 
          MX6    0
          SA6    X1 
LCLOOP    SA6    A6-B1
          SB4    A6 
          LT     B3,B4,LCLOOP 
  
          ENV    ACT,(2,3),VER2 
          DATE   DATE 
          CLOCK  TIME 
VER2      ELSE
          DATE   DATE 
          CLOCK  TIME 
VER2      ENDIF 
  
  
  
          MX0    54 
          MX6    0
          PX6    X6,B0
          SA6    MSGPTR 
BLANKS    RJ   CCARD               SEARCH FOR NON-BLANK                 774A   5
          ZR   B2,BLANKS                                                774A   6
UPDATE0   RJ     CCARD
          ZR     B6,UPDATEX        TERMINATOR 
          ZR     B4,UPDATE1        COMMA
          ZR     B2,UPDATE1        FIRST BLANK
          SX2    X6-1R( 
          ZR     X2,UPDATE1  OPEN PAREN 
          SX2    X6-1R= 
          NZ     X2,UPDATE0  IF NOT SEPARATOR 
UPDATE1   RJ     CCARD
          ZR     B2,UPDATE1 
          ZR     B4,UPDATE1 
          ZR     B6,UPDATEX 
          SA5    =1H               X5 = BLANKS FOR NOW
          RJ     BLDPAR            ADD A CHARACTER TO X5
          SB5    LOPTS-1
          LX6    54 
          MX3    6
          SA2    OPTS 
UPDATE2   BX1    X3*X2
          IX7    X1-X6
          ZR     X7,UPDATE3        FOUND MATCH
          SB5    B5-B1
          SA2    A2+B1
          PL     B5,UPDATE2        TRY NEXT PARAM 
          EQ     CARDERR
          SPACE  1
UPDATE3   SA0    X2                ADDRESS TO PUT PARAM 
          SA7    POPT              SET TO ZERO.                          CP190
          AX2    18 
          SB5    X2                MAX PARAM LGTH 
          AX2    18 
          LX6    6                                                       CP190
          SX7    X6-1RP            CHECK FOR P OPTION.                   CP190
          NZ     X7,UPDATE3A       IF NOT P OPTION.                      CP190
          SX7    7                                                       CP190
          SA7    POPT              SET POPT TO SEVEN.                    CP190
UPDATE3A  SA3    X2                LOAD DEFAULT                          CP190
          SA4    A0 
          MX6    54 
          BX6    -X6*X4            SAVE POSSIBLE FILE MODE
          BX6    X3+X6
          SA6    A0 
          MX6    0
          SA6    A2                DONT ALLOW DUPLICATES
UPDATE4   MX7    0
          RJ     CCARD
          ZR     B2,UPDATE4 
          ZR     B4,UPDATE1 
          ZR     B6,UPDATEX 
          RJ     BLDPAR            ADD A CHARACTER TO X5
          ZR     B5,CARDERR        NO = ALLOWED 
          SX2    X6-1R= 
          ZR     X2,UPDATE6 
          SB2    A2-FILEOPTS        POSSIBLE -6, -8 FILE
          PL     B2,CARDERR         NOT A FILE DESIGNATOR 
          SX6    X6-1R7             6-->-1, 8-->+1
          ZR     X6,CARDERR         BUT 7 IS ILLEGAL
          AX2    X6,B1
          NZ     X2,CARDERR 
          SA6    A2+MODEOPT-OPTS   SAVE MODE FLAG FOR FILE
          RJ     CCARD             CONTINUE, LOOK FOR = OR END
          ZR     B2,UPDATE4 
          ZR     B4,UPDATE1 
          ZR     B6,UPDATEX 
          RJ     BLDPAR            ADD CHARACTER TO X5
          SX2    X6-1R= 
          NZ     X2,CARDERR 
UPDATE6   RJ     CCARD
          ZR     B2,UPDATE6 
          ZR     B3,UPDATE9        IF SLASH                              CP190
          ZR     B6,UPDATEX 
          ZR     B4,UPDATE1 
AST       RJ     BLDPAR                                                  CP190
          LX7    6
          BX7    X6+X7             BUILD PARAM
          SB2    6
          SB5    B5-B2
          NG     B5,CARDERR        TOO LONG 
          BX6     X7
           MX4    6 
UPDATE8   LX6    6
          BX3    X4*X6
          ZR     X3,UPDATE8 
          SA4    =1L0 
          SA3    A0 
          MX1    58 
          IX4    X4-X6             TEST FOR PARAM=0 
          BX3    -X1*X3            SAVE POSSIBLE FILE MODE
          BX6    X3+X6
          NZ     X4,UPDATE8A
          MX6    0                 PARAM=0
 UPDATE8A SA6    A0 
          EQ     UPDATE6
          SPACE  1
UPDATE9   SA2    POPT                                                    CP190
          ZR     X2,AST            NOT P OPTION, MUST BE * OPTION.       CP190
          SA0    SCNDPL-1                                                CP190
UPDATE9A  MX7    0                                                       CP190
          SA0    A0+B1             POINT TO 2NDARY PL TABLE.             CP190
          SA2    POPT              FETCH NO. OF 2ND PL ALLOWED.          CP190
          SX6    X2-1              DECREMENT COUNT.                      CP190
          NG     X6,TOMANY         TOO MANY SECONDARY PLS SPECIFIED.     CP190
          SA6    A2                STORE NEW VALUE.                      CP190
UPDATE10  RJ     CCARD             GO FETCH A CHARACTER.                 CP190
          ZR     B2,UPDATE10       IF BLANK.                             CP190
          ZR     B3,UPDATE12       IF SLASH.                             CP190
          ZR     B4,UPDATE12       IF COMMA.                             CP190
          ZR     B6,UPDATE12       IF TERMINATOR.                        CP190
          LX7    6                                                       CP190
          BX7    X6+X7             ADD NEW CHAR TO X7.                   CP190
          LX6    X7                                                      CP190
          MX4    6                                                       CP190
UPDATE11  LX6    6                 LEFT JUSTIFY LFN.                     CP190
          BX3    X4*X6                                                   CP190
          ZR     X3,UPDATE11       IF NOT LEFT JUST YET.                 CP190
          SA6    A0                STORE NAME INTO TABLE.                CP190
          BX1    X6                                                      CP190
          RJ     LFNCK             CHECK FOR BAD FILE NAME.              CP190
          NG     X6,BAD            IF FILE NAME BAD.                     CP190
          EQ     UPDATE10          LOOP FOR ANOTHER CHAR.                CP190
                                                                         CP190
UPDATE12  SA3    SCNUM                                                   CP190
          ZR     X3,UPDATE15       IF 1ST ENTRY, NO COMPARE NECESSARY.   CP190
          SB7    X3                                                      CP190
          SA4    A0                RETRIEVE PARAM JUST STORED.           CP190
UPDATE13  SA1    A0-B7                                                   CP190
          BX7    X1-X4             COMPARE PL NAMES.                     CP190
          ZR     X7,UPDATE14       IF MATCH.                             CP190
          SB7    B7-B1             DECREMENT INDEX.                      CP190
          ZR     B7,UPDATE15       IF END OF TABLE.                      CP190
          EQ     UPDATE13          LOOP FOR NEXT TABLE ENTRY.            CP190
                                                                         CP190
UPDATE14  SA7    A0                CLEAR OUT DUP ENTRY.                  CP190
          SA0    A0-B1             BACK UP POINTER TO REDO TABLE ENTRY   CP190
          ENV    ACT,(2,3),VER3                                          CP190
          MESSAGE MESG5A                                                 CP190
          MESSAGE MESG5B                                                 CP190
VER3      ELSE                                                           CP190
          MESSAGE MESG5                                                  CP190
VER3      ENDIF                                                          CP190
          EQ     UPDATE16                                                CP190
                                                                         CP190
UPDATE15  SX7    X3+B1             BUMP-                                 CP190
          SA7    SCNUM             COUNTER.                              CP190
UPDATE16  ZR     B3,UPDATE9A       IF SLASH.                             CP190
          ZR     B4,UPDATE1        IF COMMA.                             CP190
          ZR     B6,UPDATEX        IF TERMINATOR.                        CP190
                                                                         CP190
TOMANY    BSS    0                                                       CP190
          ENV    ACT,(2,3),VER2                                          CP190
          MESSAGE MESG4A                                                 CP190
          MESSAGE MESG4B                                                 CP190
VER2      ELSE                                                           CP190
          MESSAGE  MESG4
VER2      ENDIF                                                          CP190
          SA5    ERRMODE                                                 CP190
          NZ     X5,GOON           IF U SPECIFIED, GO ON.                CP190
          MESSAGE ABMSG                                                  CP190
          EQ     BRF                                                     CP190
                                                                         CP190
BAD       BSS    0                                                       CP190
          MESSAGE MESG6                                                  CP190
          SA5    ERRMODE                                                 CP190
          NZ     X5,GOON           IF U SPECIFIED, GO ON.                CP190
          MESSAGE ABMSG                                                  CP190
          EQ     BRF                                                     CP190
                                                                         CP190
GOON      RJ     CCARD                                                   CP190
          ZR     B4,UPDATE1        IF COMMA.                             CP190
          ZR     B6,UPDATEX        IF TERMINATOR.                        CP190
          EQ     GOON              READ UNTIL COMMA OR TERMINATOR.       CP190
                                                                         CP190
CARDERR   SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          SB5    X1                B5=ERROR COUNT (B5 NOT DESTROYED)
UPDATE7   RJ     CCARD
          BX7    X5 
          SA7    B5+P1BADLIN       STORE ERROR
          ZR     B2,UPDATE7 
          ZR     B6,UPDATEX 
          ZR     B4,UPDATE1 
          RJ     BLDPAR            ADD A CHARACTER TO X5
          EQ     UPDATE7
  
**        BLDPAR
* 
*         THIS ROUTINE BUILDS A PARAMETER IN X5 FOR POSSIBLE
*         LATER USE IF THE PARAMETER IS FOUND TO BE IN ERROR. 
*         UP TO NINE CHARACTERS WILL BE PUT INTO X5, BEGINNING IN 
*         BITS 00-05 AND MOVING LEFTWARD. 
* 
BLDPAR    BSS    1
          MX3    12 
          BX2    X3*X5
          LX2    12 
          SX2    X2-2R
          NZ     X2,BLDPAR         IF X5 FILLED WITH CHARACTERS, RETURN 
          MX3    6
          BX5    -X3*X5            ZERO OUT LEFT BLANK CHARACTER OF X5
          LX5    6
          BX5    X5+X6             ADD THE CHARACTER
          EQ     BLDPAR            RETURN 
          SPACE  1
MSGPTR    BSSZ   1
          SPACE  1
CCARD     DATA   0
          RJ     CCHAR
          SPACE  1
          ENV    NOT,(10,11),TRUMP
          SPACE  1
          SB2    X6-1R$                                                 1377  12
          SA1    DOLLARS
          NZ     X1,CCARD1         IN $ MODE
          NZ     B2,CCARD2         NORMAL 
          SX6    B1 
          SA6    A1                SET $ FLAG 
          EQ     CCARD+1
          SPACE  1
CCARD1    NZ     B2,CCARD3
          RJ     CCHAR
          SB2    X6-1R$ 
          ZR     B2,CCARD3         REAL $ 
          SX6    B0 
          SA6    DOLLARS
          SX6    B2+1R$                                                 1377  14
          EQ     CCARD2                                                 1377  15
          SPACE  1
CCARD3    SB2    B1 
          SB4    B1 
          SB6    B1 
          EQ     CCARD
          SPACE  1
DOLLARS   BSSZ   1
          SPACE  1
CCARD2    BSS    0
          SPACE  1
TRUMP     ENDIF 
          SPACE  1
          SB2    X6-1R
          SB3    X6-1R/            COMPARE FOR SLASH.                    CP190
          SB4    X6-1R, 
          SB6    X6-1R. 
          ZR     B4,CCARD    IF COMMA 
          SB4    X6-1R( 
          ZR     B6,CCARD 
          SB6    X6-1R) 
          EQ     CCARD
          SPACE  1
CCHAR     DATA   0
          SA4    MSGPTR 
          UX4    X4,B3
          SB7    60 
          NE     B7,B3,CCHAR1 
          SB3    B0 
          SX4    X4+B1
          SX6    X4-8 
          NG     X6,CCHAR1
CCHAR2    SA1    ERRORS 
          NZ     X1,UPDATEX 
          SX6    10B
          SA6    TEMP1
  
          CONTRLC  TEMP1
  
          SA1    TEMP1
          LX1    59-4 
          NG     X1,UPDATEX 
          MX4    0
          SB3    B0 
CCHAR1    SB3    B3+6 
          SA1    X4+70B 
          PX6    X4,B3
          SA6    A4 
          LX1    X1,B3
          BX6    -X0*X1 
          ZR     X6,CCHAR2
          EQ     CCHAR
          EJECT  4                                                      01257475
          TITLE  FILE INITIALIZATION SECTION
*     INITIALIZE ALL FILES
          SPACE  1
 ERMODE   SA6    A4 
          SA1    ERRORS 
          SA6    A5 
          SX7    X1+B1
          SA7    A1 
  
UPDATEX   SA1    ERRORS 
          ZR     X1,UPDATEXA
          MESSAGE  P1BADPAR                                             0007   5
          MESSAGE  P1BADLIN 
  
          SA1    ERRMODE
          NZ     X1,UPDATEXA
  
BRF       ABORT 
  
SCHTOP    EQ     *
GFABORT   MESSAGE  P1BADGFL 
          MESSAGE P1BDPAR2
          EQ     BRF
          SPACE  1
UPDATEXA  SA1    GFILE
          ZR     X1,UPDATEXB       NO G OPTION
          SA2    OUTPUT 
          MX0    42 
          BX6    X1-X2
          BX6    X0*X6
          ZR     X6,GFABORT  IF G PARAM SAME FNAME AS O PARAM, ABORT
 UPDATEXB BSS    0
          SA1    NOREWFLG 
          MX7    0
          ZR     X1,NOREWON 
          MX0    54 
          BX1    X0*X1
NOREWLP   LX1    6
          SX5    B1 
          BX6    -X0*X1 
          ZR     X6,NOREWFI 
          SB7    X6-1RX 
          ZR     B7,NOREWFI 
          SB7    X6-1RP 
          ZR     B7,NOREWP
          SB7    X6-1RN 
          ZR     B7,NOREWN                                              0443   8
          SB7    X6-1RC 
          ZR     B7,NOREWC
          SB7    X6-1RS 
          NZ     B7,NOREWLP 
          BX7    X7+X5
          EQ     NOREWLP
          SPACE  1
NOREWC    LX5    1
          BX7    X7+X5
          EQ     NOREWLP
          SPACE  1
NOREWN    LX5    2
          BX7    X7+X5
          EQ     NOREWLP
          SPACE  1
NOREWP    LX5    3
          BX7    X7+X5
          EQ     NOREWLP
          SPACE  1
NOREWON   SX7    17B
NOREWFI   SA7    A1 
          SA4    MODES             CHECK CHARACTER SET MODE 
          SA5    MODET
          IX6    X4*X5
          SX6    X6                MERGE + AND - ZERO 
          NG     X6,ERMODE         6/8 CONFLICT 
          BX6    X4+X5
          SX6    X6-1 
          SA6    A4                SOURCE MODE
          SA2    NOCOMMON 
          BX4    X2 
          ZR     X2,NOTOPT
          SA3    SOURCE 
          ZR     X3,USESOURC
          SA5    =6LSOURCE
          BX6    X5-X2
          NZ     X6,USESOURC
          BX4    X3 
USESOURC  BX6    X4 
          SA6    A3 
 NOTOPT   SA4    MODEC             CHECK CHARACTER SET MODE 
          SA5    MODEK
          IX6    X4*X5
          SX6    X6 
          NG     X6,ERMODE         6/8 CONFILCT 
          BX6    X4+X5
          SX6    X6-1 
          SA6    A4 
          SA2    ORDERFLG 
          ZR     X2,NOKOPT
          SA3    =7LCOMPILE 
          BX6    X3-X2
          LX7    X2 
          ZR     X6,NOKOPT
          SA7    COMP 
 NOKOPT   CLEAR  SOURCE,WRITE 
          CLEAR  COMP,WRITE 
          CLEAR  OLDPL,READ 
          CLEAR  NEWPL,WRITE
NEWPLNO   MX0    54 
          SA2    FLGCHAR           MAKE CERTAIN ONLY A SINGLE 
          LX2    6                 CHARACTER IS SPECIFIED 
          BX6    -X0*X2            FOR CONTROL CHARACTER
          SA3    COMCHAR           AND COMMENT CHARACTER. 
          SA6    A2 
          LX3    6
          BX7    -X0*X3 
          SA7    A3 
  
          ENV    ACT,(2,3),S2LCM
          MEMORY LCM,FLL           HOW MUCH LCM DO WE HAVE
          SA1    FLL
          MX0    30 
          BX2    X0*X1             UPPER 30 BITS OF X2 IS LCM FL WE HAVE
          SX6    LCML 
          SA6    F.DIRECT          SET ORIGIN OF LCM BUFFERS
          SX6    X6+1000B          REQUEST 1000B WORDS FOR DIRECT 
          SA6    SIZECORL 
          LX6    30 
          IX2    X2-X6             COMPARE NEEDED AND WHAT WE HAVE
          PL     X2,LCMOK          IF WE HAVE ENOUGH LCM FL 
          SA6    TEMP              AMOUNT WE NEED 
          MEMORY LCM,TEMP          REQUEST IT 
LCMOK     BSS    0
S2LCM     ENDIF 
  
  
          ENV    ACT,(2,3),VER2 
          OPEN   OUTPUT,WRITENR 
VER2      ENDIF 
  
          SA0    OUTPUT      OUTPUT FILE FET ADDRESS
          RJ     SPP         SET PRINT PAGE PARAMETERS
  
          SA3    EDITFLAG 
          MX7    1
          NZ     X3,UPDATEE 
          MX7    60 
UPDATEE   SA1    FASTFLG           BE SURE FASTFLG IS 
          ZR     X1,UPDATEF        NOT NEGATIVE 
          SX6    B1 
          SA6    A1 
UPDATEF   SA7    A3 
          SX6    B1 
          SA1    COMP 
          SA2    =5LPUNCH          IF THE COMPILE FILE IS PUNCH 
          BX0    X2-X1             THEN TURN ON BOTH THE 80 COLUMN
          AX0    18 
          NZ     X0,NOTPUNCH       FLAG AND THE DATA FLAG.
          SA6    EIGHTY 
          SA6    FULLCOL
 NOTPUNCH BSS    0
          SA1    HEADER 
          MX0    6
          LX1    6
          ZR     X1,UPDATEX2 IF OMITTED 
          SB7    X1-1R3 
          ZR     B7,UPDATEX2
          EQ     B7,B1,UPDATEX2 
          SX6    X1-1R0 
          NZ     X6,LMESERR  IF NOT H=0 
          SA6    A1 
UPDATEX2  SA2    CPYTOLIB 
          SA3    CPYFMLIB                                               0131  10
          NZ     X2,UPDATEA                                             0131  11
          NZ     X3,UPDATEB2                                            0131  12
          IF     DEF,EDITKEY,5
          SA4    MERGE             FETCH MERGE FLAG. IF IT IS NON-ZERO
          ZR     X4,NOMERGE        SET THE EDIT FLAG NEGATIVE.
          MX7    2
          SA7    EDITFLAG 
NOMERGE   BSS    0
          SPACE  1
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
          OPEN   UPDTCDK,WRITE
VER2      ELSE
          ENV    ACT,(11),X 
          OPEN   UPDTCDK,ALTER
X         ENDIF 
          EVICT  UPDTCDK
VER2      ENDIF 
          CLEAR  UPDTCDK,WRITE
          SPACE 
          SA1    COMP 
          ZR     X1,SKIP1 
          RJ     CHKFILE
          SPACE  1
  
          ENV    ACT,(11),VER2
          OPEN   COMP,WRITENR 
VER2      ENDIF 
  
          SA1    NOREWFLG 
          LX1    59-1 
  
          ENV    ACT,(2,3),VER2 
          PL     X1,SKIP001 
          OPEN   COMP,WRITE 
          EQ     SKIP001A 
 SKIP001  OPEN   COMP,WRITENR 
 SKIP001A BSS 
VER2      ELSE
          PL     X1,SKIP0 
          REWIND COMP 
VER2      ENDIF 
  
 SKIP0    CLEAR  COMP,WRITER       TO FORCE 77 HEADER 
  
          ENV    ACT,(2,3),VER2 
          SX3    12 
          SA1    XMODE
          ZR     X1,SKIP001B       IF NOT COMPRESSED COMPILE
          SA2    COMP 
          SX6    FETMODE
          BX6    X6+X2
          SA6    A2                SET FET STATUS TO BINARY 
          SX3    RL7000 
 SKIP001B BSS 
          STORE  COMP76,RLW=X3
VER2      ENDIF 
  
SKIP1     SA1    SOURCE 
          ZR     X1,SKIP2 
          RJ     CHKFILE
          SPACE  1
  
          ENV    ACT,(11),VER2
          OPEN   SOURCE,WRITENR 
VER2      ENDIF 
  
          SA1    NOREWFLG 
          LX1    59-0 
  
          ENV    ACT,(2,3),VER2 
          PL     X1,SKIP002  IF SOURCE FILE NOT TO BE REWOUND 
          OPEN   SOURCE,WRITE 
          EQ     SKIP002A 
SKIP002   OPEN   SOURCE,WRITENR 
SKIP002A  BSS 
VER2      ELSE
          PL     X1,SKIP1A         IF SOURCE FILE NOT TO BE REWOUND 
          REWIND SOURCE 
VER2      ENDIF 
 SKIP1A   CLEAR  SOURCE,WRITE 
SKIP2     BSS    0
          SA1    =7LYANK$$$ 
          ADDWRD DECKS,X1 
          ADDWRD NEWDKS,X1
          SX0    B1 
          BX1    X1+X0
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          MOVE   3,FTITL,TITLE+3
          SA1    FULLCOL
          SA2    EIGHTY 
          ZR     X2,SETFCOL1
          SX6    72                8
          SX7    8
          ZR     X1,SETFCOL2
          SX6    80                D,8
          SX7    0
          EQ     SETFCOL2 
 SETFCOL1 ZR     X1,SETFCOL3
          SX6    80                D
          SX7    10 
 SETFCOL2 SA7    WII               SET WIDTHS FOR IDENT 
          SA6    WIC
          SA7    WIW
          MX6    0
          SA6    WIS
 SETFCOL3 BSS    0
          SA1    OUTPUT 
          ZR     X1,SETLIST0       NO OUTPUT FILE 
          SA1    AUDIT
          ZR     X1,SETLIST0
          MX0    54 
          BX6    X0*X1             GET LIST OPTION CHARACTERS 
          BX0    -X0*X1            GET FLAG (NON ZERO IF DEFAULT) 
          ZR     X0,AUDITOK        EXPLICIT LIST OPTIONS
          BX1    X6 
          MX6    0                 TURN OFF ADDFILE LIST
          SA2    TTY
          NZ     X2,AUDITOK  IF NOT CONNECTED FILE
          SA1    AUDITCF     GET CONNECTED FILE DEFAULT LIST OPTION 
AUDITOK   SA6    AFLIST 
          MX0    54                SET UP LIST
          SX7    B1                FLAGS ACCORDING
          SB4    10 
TRYNENT   LX1    6                 TO L PARAMETERS
          SB4    B4-B1
          NG     B4,SETLIST1
          BX5    -X0*X1 
          ZR     X5,SETLIST1
          SB7    X5-1 
          ZR     B7,SETLISTA       JUMP IF LIST OPTION A SPECIFIED
          SB7    X5-6 
          ZR     B7,SETLISTF       JUMP IF LIST OPTION F
          SB7    X5-33B 
          NG     B7,LMESERR        BAD L PARAMETER
          SB6    B7-10
          PL     B6,LMESERR        BAD L PARAMETER
          SB7    B7+B1
          MX6    0
          JP     *+B7 
+         EQ     SETLIST0 
+         SA7    LISTONE
          EQ     TRYNENT
+         SA7    LISTTWO
          EQ     TRYNENT
+         SA7    LISTHREE 
          EQ     TRYNENT
+         SA7    LISTFOUR 
          EQ     TRYNENT
+         SA7    LISTFIVE 
          EQ     TRYNENT
+         SA7    LISTSIX
          EQ     TRYNENT
+         SA7    LISTSEVN 
          EQ     TRYNENT
+         SA7    LISTEIGT 
          EQ     TRYNENT
+         SA7    LISTNINE 
          EQ     TRYNENT
SETLISTA  SA7    LISTA
          EQ     TRYNENT
          SPACE  1
LMESERR   BSS    0
          MESSAGE P1BDPAR2
          SA1    ERRMODE
          ZR     X1,ABORT          ABORT IF NOT U MODE
          SA2    ERRORS 
          SX6    X2+B1             INCREASE ERROR COUNT 
          SA6    A2 
          MX7    0
          SA7    AUDIT             ZERO AUDIT FLAG
          SA1    =0LA1234          SET UP FOR DEFAULT LISTING 
          EQ     AUDITOK           TRY TO CONTINUE
          SPACE  1
 SETLIST0 MX7    0
          SA7    AFLIST 
          SA7    OUTPUT 
  
SETLISTF  SA7    LISTA
          BX6    X7 
          SA7    A7+B1
          SA6    A7+B1
          SA7    A6+B1
          SA6    A7+B1
          SA7    A6+B1
          SA6    A7+B1
          SA7    A6+B1
          SA6    A7+B1
          SA7    A6+B1
          SPACE  1
SETLIST1  SA1    LISTFIVE 
          SA2    A1+B1             DETERMINE WHAT (IF ANY) AUDIT
          SA3    A2+B1             INFORMATION IS DESIRED. AT THIS
          SA4    A3+B1             TIME ALL WE ACTUALLY NEED TO 
          IX1    X1+X2             KNOW IS THAT SOMETHING IS INDEED 
          BX3    X3+X4             WANTED.  IF ANY OF THE LIST OPTIONS
          IX6    X3+X1             5-8 IS DESIRED INITIATE AUDIT
          SA6    AUDIT             PROCESSING BY SETTING AUDIT NON-ZERO.
  
          SA1    LISTFOUR 
          BX6    X1 
          SA6    LISTFORA          SAVE FOR *LIST USE 
          TITLE  PASS 1 INITIALIZATION AND SUBROUTINES                  01257512
          SPACE  4
**                                                                      01257043
*         UPDATE THEN READS THE FIRST INPUT CARD.  IF THERE IS NO INPUT,01257044
*         UPDATE ASSUMES CORRECTION MODE, BUT THE Q OPTION IS INVALID   01257045
*         SINCE IN Q MODE, UPDATE DEPENDS ON COMPILE CARDS TO KNOW      01257046
*         WHICH DECKS TO PROCESS.  IF THE CARD JUST READ WAS A DECK OR  01257047
*         COMDECK CARD, UPDATE ASSUMES CREATION MODE AND THE OLDPL FILE 01257048
*         WILL NEVER BE REFERENCED.  A AND B MODES SUPERCEDE ALL OTHER  01257049
*         OPTIONS AND SIMPLY ACT AS COPY ROUTINES FROM OLDPL TO NEWPL.  01257050
*         IN A AND B MODE, THE INPUT FILE IS NOT REFERENCED.            01257051
*                                                                       01257052
          SPACE  1
          SA1    INPUT
          ZR     X1,UPD1           I = 0, SO DONT READ
          RJ     READCDI           READ INITIAL CARD
          ZR     X1,UPD2           GOT A CARD 
 UPD1     MX6    0
          SA6    SQLGN
          SA1    FASTFLG
          ZR     X1,UPD3
          MESSAGE P1BADINP
          EQ     ABORT
          SPACE  4
*    A CARD HAS BEEN READ,  IF IT IS A DECK OR A COMDECK CARD JUMP TO  *
*    CREATION RUN CODE.                                                *
          SPACE  2
 UPD2     MESSAGE  P1READM,1
  
          CLASIFY 
          ZR     X1,UPD3
          CCJUMP DECK,STDKBIT2                                           CP190
          CCJUMP COMDECK,NEW
          SPACE  4
**        IF UPDATE DECIDES THAT THE CURRENT RUN IS A CREATION RUN, IT  01257055
*         SIMPLY READS CARDS FROM THE INPUT FILE AND CREATES NEWPL,     01257056
*         COMPILE, AND SOURCE AS SPECIFIED BY CONTROL CARD PARAMETERS.  01257057
*         IF , HOWEVER, UPDATE DECIDES ON A CORRECTION RUN, IT NEXT     01257058
*         DOES SOME FURTHER INITIALIZATION TO SET UP PARAMETERS AND     01257059
*         FILES WHICH WOULD NOT BEEN USED BY CREATION RUN PROCESSING.   01257060
*         THE OLDPL IS OPENED AND IS DETERMINED WHETHER OR NOT IT IS A  01257061
*         RANDOM FILE.  THE DECK LIST AND DIRECTORY ARE READ IN AND SET 01257062
*         UP AS TABLES.                                                 01257063
*                                                                       01257064
          SPACE  1
 UPD3     BSS    0
          SA1    OLDPL
          ZR     X1,CORR2Q         IF NO OLDPL
          MX6    0
          SA1    OLDPL+2
  
          ENV    NOT,(2,3)
          SA6    X1 
          ELSE
          WX6    X1                (IN)=0 
          ENDIF 
  
UPD3A     BSS    0
          SPACE  1
  
          ENV    ACT,(11),VER2
          OPEN   UPDTEXT,ALTER
VER2      ENDIF 
  
  
          ENV    NOT,(2,3),VER2 
          EVICT  UPDTEXT
VER2      ENDIF 
          CLEAR  UPDTEXT,WRITE
  
 UPDATEB1 SA1    OUTPUT 
          ZR     X1,CORR0          L=0
          CHKFILE OUTPUT
          SPACE  1
  
          ENV    ACT,(11),VER2
          OPEN   OUTPUT,WRITENR 
VER2      ENDIF 
  
 CORR0    BSS    0
          SX6    RANIDX            USE RANIDX AS INDEX AREA TO READ IN
          SX1    LRANIDX           INDEX FROM POSSIBLE RANDOM OLDPL 
          LX1    18 
          BX6    X6+X1
          SA6    OLDPL+7
          MX7    0
          SA7    X6 
          SPACE  1
          IF     DEF,EDITKEY,1
SECONDPL  BSS    0
          CHKFILE OLDPL 
          SA1    OLDPL+1           FETCH FET + 1
          MX6    1
          LX6    45 
          BX6    X6+X1
          SA6    A1                SET ERROR PROC BIT 
          SA1    NOREWFLG 
          LX1    59-3 
          PL     X1,CORR1A
          OPEN   OLDPL,READ,RECALL
          SPACE  1
  
          ENV    ACT,(11),VER2
          REWIND OLDPL
VER2      ENDIF 
  
          EQ     CORR1AA
          SPACE  1
 CORR1A   OPEN   OLDPL,READNR,RECALL
 CORR1AA  BSS 
          SA1    OLDPL            FETCH FET + 0 
          SA4    OLDPL+1
          MX6    55 
          LX6    9
          BX2    -X6*X1            EXTRACT AT FIELD 
          MX7    1
          LX7    45 
          BX6    X6*X1             CLEAR AT FIELD 
          BX7    -X7*X4            CLEAR EP BIT 
          SA6    A1 
          SA7    A4 
          ZR     X2,ATOK           NO ERROR FROM OPEN 
          AX2    9
          SX3    X2-23B            CHECK FOR LONG BLOCK ERROR 
          ZR     X3,ATOK
          EQ     SECONDPL          TRY AGAIN WITHOUT EP BIT 
 ATOK     CLEAR  OLDPL,READ 
  
          ENV    ACT,(11),VER2
          SA2    OLDPL+2
          SA1    X2                FETCH LABEL FROM BUFFER
          SA2    A1+B1
          MX0    36 
          LX1    24 
          BX1    X0*X1             CLEAR FIRST FOUR CHARACTERS
          LX2    24 
          BX3    -X0*X2 
          IX1    X1+X3             ADD FOUR CHARACTERS FROM SECOND WORD 
          BX2    X0*X2
          BX6    X1 
          SA6    OLDPL+9
          BX6    X2 
          SA6    A6+B1             STORE LABEL IN FET 
VER2      ENDIF 
  
          ENV    NOT,(2,3),VER2 
          RJ     RDR         READ DIRECTORY 
VER2      ENDIF 
  
          SA1    OLDPL+1
          LX1    12 
          NG   X1,RANOPL           PROCESS RANDOM OLDPL 
          SA1    CPYFMLIB 
          NZ     X1,BMODERR 
          READWC OLDPL,TEMP,1 
          NZ     X1,CORR2Q
          SA2    TEMP              CHECK THE FIRST WORD 
          SA5    HEADER 
          ZR     X5,RCK2     IF OLDPL HEADER IS OK
          RJ     CHGHDER
          SA6    TEMP 
RCK2      MX0    30 
          SA3    =5LCHECK          CONTAINS THE WORD CHECK
          BX6    X0*X2             IN THE LEFT 30 BITS THIS 
          BX5    X6-X3             IS AN OLDPL WITH CHECKSUM
          NZ     X5,SETUPOLD       INFORMATION. IF NOT RESET
          RJ     CHECHAR
          READWC OLDPL,TEMP,1 
RCHK1     BSS    0
          SA2    TEMP              FETCH SIZE OF DIRECTORY
          AX2    18 
          MX7    45 
          BX7    X7*X2
          NZ     X7,CORR2T         IF X7 IS NOT ZERO THERE IS GARBAGE 
          SPACE  1
          IF     DEF,EDITKEY,2
          SA1    QFLAG             IN THE CONTROL WORD - GO NO FURTHER. 
          NZ     X1,DETOUR         GO TO DETOUR IF WORKING ON SECOND PL 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ALLOC  DIRECT,X2         ALLOCATE ROOM FOR DIRECTORY
          READWC OLDPL,X2+B1,X3-1 
S2LCM     ELSE
          BX1    X2 
          RJ     MANAGL 
          RBINCL OLDPL,X2+B1,X3-1,READ1 
S2LCM     ENDIF 
          SPACE  1
          IF     DEF,EDITKEY,1
DETOURA   BSS    0
          SA1    TEMP              ALLOCATE SPACE FOR AND READ IN 
          SX1    X1                DECK LIST IN COMPRESSED FORMAT 
          ALLOC  DECKS,X1 
          READWC OLDPL,X2+B1,X3-1 
          SA1    L.DECKS           THE COMPRESSED DECK LIST MUST NOW
          ALLOC  DECKS,X1          BE EXPANDED TO THE TWO WORD/ENTRY
          SB3    X3 
          AX4    X3,B1
          SB2    B1+B1
          SB6    X4 
CLELOOP   ZR     B6,CLELOOPE       JUMP TO CLELOOPE WHEN DONE 
          SB6    B6-B1             DECREMENT THE INDEX
          SA1    X2+B6             FETCH THE NEXT ENTRY TO BE 
          BX6    X1                PROCESSED
          SB3    B3-B2
          SA6    X2+B3
          EQ     CLELOOP
          SPACE  1
CLELOOPE  BSS    0
          SPACE  1
D         IF     DEF,OLDPLKEY 
          SA3    EDITFLAG 
          NG     X3,CORR2A         JUMP IF NEW STYLE LIBRARY
          SPACE  1
          IF     DEF,EDITKEY,1
          SA3    QFLAG
          SA1    F.DIRECT 
          SA2    L.DIRECT 
          SPACE  1
          IF     DEF,EDITKEY,4
          ZR     X3,CLELOOPF       JUMP IF NOT SECOND LIBRARY OF MERGE
          SA1    F.COUNT
          SA2    L.COUNT
CLELOOPF  BSS    0
          MX0    42 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X1                FETCH FIRST IDENT NAME 
S2LCM     ELSE
          SB5    X1                PUT ADDRESS IN B5. 
S2LCM     ENDIF 
          SPACE  1
          SB7    X2                B7 HOLDS LENGTH
          SA4    =7L. . . .        LIBRARY. THIS CODE IS USED 
          SX7    20B               FOR THESE LIBRARIES IN 
BITLOOP   ZR     B7,CORR2A         WHICH WE FIRST CHANGE ALL THE
          SPACE  1
          ENV    ACT,(2,3),S2LCM
          SX1    B5                RETRIEVE ADDRESS.
          RX1    X1                READ LCM FROM X1 INTO X1.
S2LCM     ENDIF 
          SPACE  1
          LX5    X1                PURGED ENTRIES (. . . . OR BIT 
          BX6    X1-X4             16 SET ON) TO THE NEW FORM 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    A1+B1             (BIT 4 ON) SO THAT FURTHER EDIT
S2LCM     ELSE
          SB5    B5+B1             BUMP ADDRESS.
S2LCM     ENDIF 
          SPACE  1
          LX5    59-16             PROCESSING CAN FOLLOW A COMMON 
          SB7    B7-B1             PATH FOR ALL TYPES OF LIBRARIES. 
          AX6    18 
          ZR     X6,BITLOOP1
          PL     X5,BITLOOP 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
BITLOOP1  SA7    A1-B1
S2LCM     ELSE
BITLOOP1  SX1    B5-B1             BACK UP ADDRESS BY ONE.
          WX7    X1                WRITE LCM, X7 INTO LOC X1. 
S2LCM     ENDIF 
          SPACE  1
          EQ     BITLOOP
D         ENDIF 
          SPACE  1
CORR2A    MX7    0                                                      0214  26
          SA7    WHATZIT           CLEAR FLAGS                          0214  27
          SA7    SIXTY3                                                 0214  28
ZZ        IFNE   IP.CSET,IP.C63 
          SX6    1R4               SET TO NEW FLAG                      0214  30
ZZ        ELSE                                                          0214  31
          SX6    1R3                                                    0214  32
ZZ        ENDIF                                                         0214  33
          SX2    1R4                                                    0214  34
          SA1    CHG63                                                  0214  35
          NZ     X1,MOOT
          SX1    1R3               DEFAULT 63 
 MOOT     SX7    X1-1R7            CHECK FOR 8-BIT PL (HDR=7 OR 8)
          SA7    MODEP             SAVE TYPE
          NG     X7,MOOT1          NOT 8-BIT
          SX1    X1-4              MOVE UNDERLYING CODE (3 OR 4)
 MOOT1    IX0    X1-X6
          ZR   X0,MLUMP            PL AND CSET AGREE                    0214  40
          SX7    63B                                                    0214  41
          SA7    SIXTY3            SET 63 CONVERT FLAG                  0214  42
XX        IFEQ   IP.CSET,IP.C63                                         0214  43
          SA7    WHATZIT           63 READING 64 PL, CHANGE 00 TO 63    0214  44
          SX7    1R                AND 63 TO BLANK                      0214  45
XX        ELSE                                                          0214  46
          MX7    0                 64 READING 63 PL, CHANGE 63 TO 00    0214  47
XX        ENDIF                                                         0214  48
          SA7    CHG63                                                  0214  49
 MLUMP    SA1    MODEN             DECLARED NEWPL MODE
          NG     X1,MLUMP3         FORCE 6-BIT SPECIFIED ON CONTROL CARD
          SA2    MODEP
          PL     X2,MLUMP2         8-BIT
          SA2    MODENF            POSSIBLY SET BY OTHER PLS
          PL     X2,MLUMP2         8-BIT
          SA2    MODEI
          ZR     X2,MLUMP3         6-BIT IF FILE NOT IN USE 
          NG     X2,MLUMP3         6-BIT
 MLUMP2   SX6    X6+4              8-BIT MODE 
 MLUMP3   SX6    X6-1R5            SET UP AS FLAG FOR WRNPL 
          SA6    MODENF 
  
          SA1    OLDPL+9
          NZ     X1,LAB1           JUMP IF LABELED TAPE 
          MOVE   2,UNLAB,TITLE
          EQ     LAB2 
LAB1      SA2    A1+B1             GET SECOND WORD OF LABEL 
          MX0    42 
          LX1    54                SHIFT FIRST WORD 
          BX2    X0*X2
          MX0    6
          BX3    X0*X1             ISOLATE CHARACTER TO BE SHIFTED
          LX2    54                SHIFT SECOND WORD
          BX7    X2+X3             PUT CHARACTER INTO SECOND WORD 
          SX6    1R1
          SX3    2R 
          BX1    -X0*X1 
          IX7    X7+X3             FILL OUT SECOND WORD WITH BLANKS 
          LX6    54 
          BX6    X6+X1             PUT CHARACTER 1 IN FIRST COLUMN
          SA6    TITLE             STORE LABEL IN TITLE 
          SA7    A6+B1
LAB2      SA1    L.DECKS
          SA2    F.DECKS
          MX0    54 
          SX4    10B               SET BIT 3 INTO MASK SO THAT THE DECK  CP190
          BX0    X0+X4             BIT WONT BE MASKED OUT OF DECKS.      CP190
          SB2    B1+B1
          SB3    X1                CLEAR OUT JUNK FROM DECK LIST
CORR2AA   SB3    B3-B2
          SA3    X2+B3
          BX6    X0*X3
          SA6    A3 
          NZ     B3,CORR2AA 
          SPACE  1
          IF     DEF,EDITKEY,2
          SA1    QFLAG             JUMP IF PROCESSING SECOND OF TWO 
          NZ     X1,DETOUR1        LIBRARIES. 
          SA2    L.DIRECT 
          SA1    F.DIRECT          OTHERWISE CHANGE ALL OF THE PURGED 
          SB7    X2                ENTRIES (BIT 4 ON) TO ZERO BYT LEAVE 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X1                THE PURGE BIT ON. THIS MAKES THESE 
S2LCM     ELSE
          SB5    X1 
S2LCM     ENDIF 
          SPACE  1
          SX0    56B               PURGED ENTRIES UNIQUE SO THAT THE
          SX7    20B               SAME IDENT CAN BE USED AGAIN.
          SPACE  1
          ENV    NOT,(2,3),S2LCM
LOOPNO1   BX6    -X0*X1            CLEAR EVERYTHING BUT NAME AND PURGE
S2LCM     ELSE
LOOPNO1   SX1    B5 
          RX1    X1 
          BX6    -X0*X1 
S2LCM     ENDIF 
          SPACE  1
          LX1    55                BIT, SHIFT PURGE BIT TO POSITION 59, 
          SB7    B7-B1             DECREMENT THE INDEX. 
          PL     X1,LOOPNO2        JUMP IF THIS ENTRY NOT PURGED, ELSE
          BX6    X7                SUBSTITUTE 20B (THE PURGE BIT) 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
LOOPNO2   SA6    A1                STORE THE CLEARED OR EDITED ENTRY
          SA1    A1+B1             FETCH THE NEXT ENTRY 
S2LCM     ELSE
LOOPNO2   SX1    B5                FETCH ADDRESS. 
          WX6    X1                WRITE LCM, X6 INTO LOC X1
          SB5    B5+B1             BUMP ADDRESS.
S2LCM     ENDIF 
          SPACE  1
          GT     B7,LOOPNO1        LOOP IF MORE TO GO 
          SA1    CPYTOLIB 
          NZ     X1,UPDATEA2
          SA1    CPYFMLIB 
          NZ     X1,UPDATEB3
          SPACE  1
**                                                                      01257076
*         IF EDIT OR MERGE HAS BEEN SPECIFIED, UPDATE GOES THROUGH      01257077
*         AN ADDITIONAL PASS DURING WHICH THE OLDPL IS COPIED TO A      01257078
*         TEMPORARY RANDOM FILE CALLED UPDTTPL.  IF MERGE HAS BEEN      01257079
*         SPECIFIED, THE MERGE FILE IS COMBINED WITH THE OLDPL ON       01257080
*         UPDTTPL.  AFTER THE EDIT PASS IS FINISHED, UPDTTPL WILL BE    01257081
*         USED AS THE OLDPL FOR FURTHER PROCESSING.  DURING THE EDIT    01257082
*         PASS, ALL PREVIOUSLY PURGED IDENTS ARE SQUEEZED OUT OF THE    01257083
*         DIRECTORY AND IDENTS WHICH HAVE NO CHB"S ON THE LIBRARY       01257084
*         ARE MARKED FOR PURGING.  WHEN UPDATE IS COMBINING THE MERGE   01257085
*         FILE WITH THE OLDPL IT CHECKS FOR DUPLICATE DECK OR IDENT     01257086
*         NAMES AND ALTERS ANY DUPLICATES TO BE UNIQUE.                 01257087
*                                                                       01257088
*         EDIT/MERGE PROCESSING AND EDIT/MERGE SUBROUTINES              01257089
*                                                                       01257090
*         IF MERGE HAS BEEN SPECIFIED ON THE UPDATE CONTROL CARD        01257091
*         (M OPTION), THE EDITFLAG IS TURNED ON SO THAT AN EDIT WILL    01257092
*         BE PERFORMED ON THE OLDPL BEFORE IT IS MERGED WITH THE MERGE  01257093
*         FILE.  THE EDIT PROCESSING IS AS FOLLOWS.  THE DIRECTORY      01257094
*         IS SEARCHED, PURGED IDENTS ARE SQUEEZED OUT AND A CROSS-      01257095
*         REFERENCE TABLE IS BUILT IN COMIND TO CONTAIN THE NEW         01257096
*         ORDINALS OF THE IDENTS.  THE OLDPL IS READ A CARD AT A TIME.  01257097
*         THE CHB STRING IS SEARCHED AND THE OLD ORDINALS ARE           01257098
*         REPLACED BY THE NEW ONES (FROM THE TABLE IN COMIND).  THE CARD01257099
*         IS THEN PUT ONTO A TEMPORARY NEWPL CALLED UPDTTPL.  IF A MERGE01257100
*         IS TO BE DONE, A CALL IS MADE TO SETMERGE TO RESET THE        01257101
*         APPROPRIATE CALLS IN PREPARATION OF READING THE MERGE FILE.   01257102
*         THE DIRECTORY OF THE MERGE FILE IS READ INTO A TEMPORARY TABLE01257103
*         (COUNT) AND SEARCHED.  IF AN ENTRY HAS BEEN PURGED, IT IS     01257104
*         SKIPPED; IF IT HAS A DUPLICATE NAME OF AN IDENT FROM THE      01257105
*         OLDPL, A CALL IS MADE TO IDCHANGE TO CHANGE IT AND AN         01257106
*         APPROPRIATE ENTRY IS MADE IN TDICT; IF IT IS A GOOD ENTRY, IT 01257107
*         IS TRANSFERRED TO DIRECT AND AN ENTRY IS ALSO MADE IN COMIND. 01257108
*         THE MERGE FILE IS READ A CARD AT A TIME.  IF THE CARD         01257109
*         CONTAINS AN IDENT OR DECK NAME THAT COULD HAVE BEEN CHANGED,  01257110
*         A CALL IS MADE TO CHANGNAM TO CHANGE ANY REFERENCES TO THESE  01257111
*         CHANGED NAMES.  THE CHB STRING IS SEARCHED AND THE ORDINALS   01257112
*         ARE CHANGED TO THEIR NEW ORDINALS (FROM THE COMIND TABLE)     01257113
*         AND THE CARD IS THEN ADDED TO THE TEMPORARY NEWPL, UPDTTPL.   01257114
*         UPDTTPL IS USED AS THE OLDPL FOR THE REMAINDER OF THE UPDATE  01257115
*         RUN.                                                          01257116
*                                                                       01257117
C         IF     DEF,EDITKEY
          SA2    EDITFLAG          JUMP PAST ALL EDIT CODE IF NO
          ZR     X2,NOEDIT         EDITING IS TO TAKE PLACE.
DETOUR3   MX6    60                SET CURDK TO -0 TO INDICATE THAT 
          SA6    CURDK             WE WILL BE PROCESSING THE YANK DECK. 
          SX6    EJECT
          SA6    LPCNT
          MOVE   3,EDITITLE,TITLE+3 
          SA1    L.DIRECT          ALLOCATE AND ZERO OUT SPACE FOR
          SA3    QFLAG             A SCRATCH TABLE IN -COMIND-
          ZR     X3,CLEAR2
          SA2    L.COUNT
          SX1    X2+B1
 CLEAR2   ALLOC  COMIND,X1
          MX6    0
          SA6    X2 
          SB7    X3-1 
CLEARER1  ZR     B7,CLEARED1
          SB7    B7-B1
          SA6    A6+B1
          EQ     CLEARER1 
          SPACE  1
CLEARED1  SA2    L.DIRECT          NOW SET UP TO SQUEEZE ALL PURGED 
          SA1    F.DIRECT          IDENTS OUT OF THE DIRECTORY. WE
          SA4    F.COMIND          WILL SET UP IN -COMIND- A TABLE
          SA3    QFLAG             PARALLEL TO -DIRECT-. TO FIND THE
          BX0    X3 
          ZR     X3,CLEARED2       NEW DIRECTORY ORDINAL FOR A GIVEN
          SA2    L.COUNT           IDENT LOOK IN -COMIND-. START AT 
          IX1    X1+X3             END OF FIRST DIRECTORY FOR SECOND PL.
          SX4    X4+B1             BUT OTHERWISE BOTH PL-S ARE PROCESSED
          SPACE  1
          ENV    NOT,(2,3),S2LCM
CLEARED2  SA5    X1-1              THE SAME. INITIALLY SET UP SO THAT 
S2LCM     ELSE
CLEARED2  SB5    X1                STORE ADDRESS. 
          SB6    X1                STORE ADDRESS. 
S2LCM     ENDIF 
          SPACE  1
          SA3    X4-1              A5 POINTS 1 WORD BELOW THE FIRST 
          BX6    X5                DIRECTORY ENTRY TO BE PROCESSED, A7
          LX7    X3                POINTS 1 WORD BELOW THE FIRST
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A5                USEABLE WORD IN -COMIND- , X7 HOLDS
S2LCM     ENDIF 
          SPACE  1
          SA7    A3                THE FIRST USEABLE DIRECTORY ORDINAL, 
          SB7    X2                B7 CONTAINS THE NUMBER OF ENTRIES
          BX7    X0                TO BE PROCESSED AND
          SX0    20B               X0 CONTAINS A MASK 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
EDITLOOP  SA5    A5+B1             TO CHECK FOR PURGED
S2LCM     ELSE
EDITLOOP  SX5    B5                FETCH ADDRESS. 
          RX5    X5                READ LCM FROM LOC X5.
          SB5    B5+B1             BUMP ADDRESS BY ONE. 
S2LCM     ENDIF 
          SPACE  1
          SB7    B7-B1             ENTRIES. SQUEEZE 
          BX6 -X0*X5               OUT ALL PURGE ENTRIES. 
          SA7    A7+B1
          ZR     X6,PURGED
          BX6    X5+X0
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A6+B1
S2LCM     ELSE
          SX5    B6                FETCH ADDRESS (LCM)
          WX6    X5                WRITE X6 TO LCM. LOC X5. 
          SB6    B6+B1             BUMP ADDRESS BY ONE. 
S2LCM     ENDIF 
          SPACE  1
          SX7    X7+B1
PURGED    NZ     B7,EDITLOOP
          SA7    TCRDEC            SAVE NEW DIRECTORY LENGTH
          SA1    A1 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X1 
          AX1    6
          LX1    6                 CLEAR PURGE BIT FROM YANK IDENT
          BX6    X1 
          SA6    A1 
S2LCM     ELSE
          RX6    X1                READ LCM INTO X6.
          AX6    6
          LX6    6                 CLEAR PURGE BIT FROM YANK IDENT. 
          WX6    X1                WRITE X6 INTO LCM. 
S2LCM     ENDIF 
          SPACE  1
          RJ     SETCOPY           SET UP FOR EDIT OF CARD IMAGES 
          SA2    DNAME
          BX6    X2 
          SA6    WRSOU
COPYLOOP  BSS    0
          READPL 1
          NZ     X1,COPYDONE       END OF RECORD
          SA2    F.COMIND 
          MX0    44                SEARCH THE CHB STRING, 
          SB2    -B1               CHANGING ALL ORDINALS
          SA1    LCHBTAB           AS NECESSARY 
          SA3    CHBTAB 
          SA4    F.DIRECT 
          SB4    X2 
          SB6    X4 
          SX5    20B
CONVLOOP  ZR     X1,CONVDONE       EXIT WHEN ALL ARE PROCESSED
          SX1    X1+B2             DECREMENT
          BX6    X0*X3             SAVE ACT/DEACT BIT 
          BX7    -X0*X3            ISOLATE ORDINAL
          SA4    X7+B4             FIND NEW ORDINAL 
          BX7    X6+X4             ADD ACT/DEACT BIT
          SA7    A3                STORE EDITED CHB 
          SA3    A3+B1             FETCH NEXT CHB 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA4    X4+B6             FETCH DIRECTORY ENTRY
          BX6    -X5*X4            AND CLEAR PURGE BIT
          SA6    A4 
S2LCM     ELSE
          SX7    B6                FETCH DIRECT ORIGIN. 
          IX7    X4+X7             COMPUTE DIRECT ENTRY ADDRESS.
          RX4    X7                FETCH DIRECTORY ENTRY
          BX6    -X5*X4            AND CLEAR PURGE BIT. 
          WX6    X7                PUT ENTRY BACK IN DIRECTORY. 
S2LCM     ENDIF 
          SPACE  1
          EQ     CONVLOOP 
          SPACE  1
CONVDONE  SB4    SPARLIST 
          RJ     CLASSIFY 
          CLASIFY 
          ZR     X1,NONDECK        JUMP IF NOT A CONTROL CARD 
          CCJUMP DECK,STDKBIT3                                           CP190
          CCJUMP COMDECK,CONVDECK 
          SPACE  1
NONDECK   SA1    CURDK             ENTER HERE FOR NON-DECK CARD. IF 
          PL     X1,NONDECK1       CURDK IS NEGATIVE WE HAVE NOT YET
          SB4    SPARLIST          FOUND THE FIRST DECK CARD AND THE
          RJ     CLASSIFY          ONLY LEGITIMATE CARDS ARE YANK AND 
          CLASIFY                  SELYANK CARDS. PURGE ALL OTHERS
          CCJUMP YANK,NONDECK1     WITH APPROPRIATE COMMENTS. 
          CCJUMP SELYANK,NONDECK1 
          CCJUMP YANKDECK,NONDECK1
          CCJUMP DEFINE,NONDECK1
          SA2    =10H 
          BX7    X2 
          SA7    DNAME
          MX7    1
          SA7    CURDK
          RJ     ADDID
          PRNTCARD
          EQ     COPYLOOP 
          SPACE  1
NONDECK1  SA1    QFLAG             IF QFLAG IS NONZERO INDICATING A 
          ZR     X1,NONDECK2       MERGE THEN RUN THROUGH DUPLICATE 
          CLASIFY                  NAME CHECK.
          ZR     X1,NONDECK2
          CCJUMP CALL,CHKCHG
          CCJUMP YANK,CHKCHG
          CCJUMP SELYANK,CHKCHG 
          CCJUMP YANKDECK,CHKCHG
          EQ     NONDECK2          EXIT IF NO POSSIBLE NAME CHANGE. 
          SPACE  1
CHKCHG    RJ     CHANGNAM 
          EQ     NONDECK2 
          SPACE  1
CONVDECK  SA1    CURDK             CURDK IS NON-ZERO IF FORIEGN CARDS 
          NG     X1,CVDONE1        WERE FOUND IN THE YANK DECK
CVDONE2   SA1    QFLAG             IF EDITING SECOND PL CHECK FOR 
          NZ     X1,DKCHANGE       CHANGED DECK NAME
CHRETURN  BSS    0
          RJ     SCITEM 
          SA7    CPMSG+1
GOODDECK  RJ     SETDECK
NONDECK2  RJ     WRNPL
          EQ     COPYLOOP 
          SPACE  1
CVDONE1   MX7    0                 SET FLAG SO THAT THIS ROUTE WILL NOT 
          SA2    WRSOU
          BX6    X2 
          SA6    DNAME
          SA7    A1                BE FOLLOWED AGAIN
          ZR     X1,CVDONE2 
          SA1    LISTONE
          ZR     X1,CVDONE2        NO LIST ERRORS 
          PRINT  P1PGDCDS,10
          EQ     CVDONE2
          SPACE  1
DKCHANGE  SA1    CARDSTAT 
          PL     X1,CHRETURN
          RJ     CHANGNAM 
          EQ     CHRETURN 
          SPACE  4
**        CHANGNAM  SUBSTITUTES CHANGED IDENT NAMES AFTER EDIT          01255338
*                                                                       01255339
*         THIS ROUTINE DOES ANY SUBSTITUTION OF DECK OR                 01255340
*         IDENT NAMES WHICH WERE CHANGED BY THE MERGE.                  01255341
*         IF ANY SUCH CHANGES HAVE OCCURED, THE TABLE                   01255342
*         TDICT CONTAINS TWO WORD ENTRIES MADE UP OF THE                01255343
*         OLD AND NEW NAMES.  IF THE LENGTH OF TDICT IS                 01255344
*         ZERO, THERE ARE NO CHANGES SO AN EXIT IS MADE.                01255345
*         WHEN THIS ROUTINE IS ENTERED, THERE IS A CONTROL              01255346
*         CARD IN SQIMAGE WHICH COULD CONTAIN A DECKNAME                01255347
*         OR IDENT NAME WHICH NEEDS TO BE CHANGED.  THE                 01255348
*         CARD IS SEARCHED UNTIL A BLANK IS FOUND AND THE               01255349
*         COLUMN POINTER IS SAVED IN QCOL.  SCITEM IS CALLED            01255350
*         TO GET THE NEXT PARAMETER WHICH COULD BE A NAME               01255351
*         THAT HAS BEEN CHANGED.  A SEARCH OF THE ODD-                  01255352
*         NUMBERED ENTRIES IN TDICT IS MADE, LOOKING FOR                01255353
*         A MATCHING NAME.  IF ONE IS FOUND, THE NEW NAME               01255354
*         AND THE COLUMN POINTER ARE SAVED.  REPEATED CALLS             01255355
*         TO GETCH AND PUTCH ARE MADE TO MOVE THE PORTION               01255356
*         OF THE CARD PRIOR TO THE CHANGED NAME INTO                    01255357
*         QSQIMAGE.  SCITEM IS CALLED TO MOVE THE POINTER               01255358
*         PAST THE CHANGED NAME IN SQIMAGE AND SUBITEM IS               01255359
*         CALLED TO WRITE THE NEW NAME INTO QSQIMAGE.                   01255360
*         THE REMAINDER OF THE CARD IN SQIMAGE IS MOVED                 01255361
*         INTO QSQIMAGE, THEN THE ENTIRE CARD IMAGE IN                  01255362
*         QSQIMAGE IS MOVED BACK INTO SQIMAGE.  THE COLUMN              01255363
*         POINTER IS RESET TO AFTER THE SUBSTITUTED PARAMETER           01255364
*         AND THE ENTIRE PROCESS IS REPEATED UNTIL THE                  01255365
*         ENTIRE CARD HAS BEEN PROCESSED.                               01255366
*                                                                       01255367
*         CALLS SCITEM, GETCH, PUTCH, SUBITEM, MOVEIT, CLASSIFY         01255368
          SPACE  1
CHANGNAM  PS
          SA1    L.TDICT           EXIT IF NO IDENTS WERE CHANGED.
          ZR     X1,CHANGNAM
CHANGNA1  SA1    CHAR 
          SB7    X1-1R
          ZR     B7,CHANGNA0       PREPARE TO EXIT ON BLANK 
          PL     B7,CHANGNA8       SKIP DELIMITER CHARACTERS. 
          SA1    COLUMN 
          BX6    X1                SAVE COLUMN POINTER
          SA6    QCOL 
          RJ     SCITEM            FETCH IDENTIFIER 
          SA1    L.TDICT
          SA2    F.TDICT           NOW SEARCH -TDICT- FOR A MATCH.
          SB6    B1 
          MX5    54 
          SB2    B1+B1
          SB5    X1 
CHANGNA2  LT     B5,B6,CHANGNA1    LOOP IF NOT FOUND IN TABLE.
          SA1    X2+B6
          BX6    X7-X1
          SB6    B6+B2
          BX6    X5*X6             MASK OFF 10TH CHAR 
          NZ     X6,CHANGNA2       MATCH NOT FOUND. 
          PX7    X6,B0             SET COLUMN POINTERS TO ZERO. 
          SA5    QCOL              SAVE IDENT STARTING POINT. 
          BX6    X5 
          SA7    A5 
          SA2    A1-B1             FETCH REPLACEMENT NAME 
          SA7    COLUMN 
          SA6    TCRBIN2           SAVE STARTING POINT
          BX6    X2 
          MX7    0
          SA6    TCWBIN            SAVE REPLACEMENT NAME
          SB7    SQLSIZE
          SA7    QSQIMAGE 
+         SB7    B7-B1
          SA7    A7+B1
          NZ     B7,*              CLEAR OUT QSQIMAGE.
CHANGNA3  RJ     GETCH
          SA1    COLUMN 
          SA2    TCRBIN2
          BX1    X1-X2
          ZR     X1,CHANGNA4       WE ARE AT THE CHANGED IDENT WHEN 
          RJ     PUTCH             VALUE AS WE SAVED. UNTIL THEN MOVE 
          EQ     CHANGNA3          ONE CHARACTER AT A TIME TO QSQIMAGE. 
          SPACE  1
CHANGNA4  RJ     SCITEM            SKIP THE OLD WORD. 
          SA5    TCWBIN 
          RJ     SUBITEM           MOVE THE NEW WORD INTO PLACE.
          SA7    TCRBIN2           SAVE NEW START POINT 
          SA1    CHAR 
          BX6    X1 
CHANGNA9  SB4    X6-1R             TEST IF BLANK
          ZR     B4,CHANGNA7       FINISHED IF CHAR BLANK 
          RJ     PUTCH
          SA7    TCRBIN2           MOVE REST OF CARD TO QSQIMAGE
          RJ     GETCH
          EQ     CHANGNA9 
          SPACE  1
CHANGNA7  SA1    QCOL              NOW MOVE THE EDITED LINE BACK TO 
          SX7    X1+B1             SQIMAGE. 
          SA7    A1 
          MOVE   X7+B1,A1,SQLGN 
          SA1    TCRBIN2           SET COLUMN TO SCAN REST OF CARD
          BX7    X1 
          SA7    COLUMN 
          EQ     CHANGNA1 
          SPACE  1
CHANGNA8  RJ     GETCH
          EQ     CHANGNA1 
          SPACE  1
CHANGNA0  SB4    SPARLIST          RESET POINTERS AND EXIT. 
          RJ     CLASSIFY 
          EQ     CHANGNAM 
          SPACE  1
**        PUTCH  PUTS CHARACTER IN QSQIMAGE                             01255370
*                                                                       01255371
*         PUTCH MOVES THE CHARACTER WHICH IS IN X6 INTO                 01255372
*         THE LINE THAT IS BEING BUILT IN QSQIMAGE.                     01255373
*         QCOL WILL CONTAIN THE CURRENT COLUMN POINTER                  01255374
*         FOR QSQIMAGE.                                                 01255375
*                                                                       01255376
*         ENTRY  X6 - CHARACTER TO BE PUT                               01255377
PUTCH     PS
          SA1    QCOL              PUTCH MOVES THE CHARACTER IN X6 INTO 
          SA2    X1+QSQIMAGE       THE LINE IT IS CREATING IN 
          UX1    X1,B7             QSQIMAGE.
          SB7    B7+6 
          SB6    60 
          SB5    B6-B7
          LX7    X2,B7
          BX7    X7+X6
          LX7    X7,B5
          SA7    A2 
          NZ     B5,PUTCH1
          SX1    X1+B1
          SB7    B0 
PUTCH1    PX7    X1,B7
          SA7    A1 
          EQ     PUTCH
          SPACE  1
**        SUBITEM  MOVES WORD TO QSQIMAGE                               01255379
*                                                                       01255380
*         THE WORD IN X5 (9 CHARACTERS OR LESS, LEFT JUSTI-             01255381
*         FIED WITH ZERO FILL) IS ADDED TO THE CARD BEING               01255382
*         BUILT IN QSQIMAGE BY SUCCESSIVE CALLS TO PUTCH.               01255383
*                                                                       01255384
*         ENTRY  X5 - WORD TO BE ADDED                                  01255385
*                                                                       01255386
*         CALLS  PUTCH                                                  01255387
SUBITEM   PS                       SUBITEM MOVES THE WORD IN X5 AND 
          MX3    54 
SUBITEM1  LX5    6                 AND ADDS IT TO THE WORD BEING
          BX6    -X3*X5            CONSTRUCTED IN QSQIMAGE. 
          BX5    X3*X5
          ZR     X6,SUBITEM        EXIT WHEN ALL CHARACTERS MOVED.
          RJ     PUTCH
          EQ     SUBITEM1 
          SPACE  1
**        SETMERGE  RESET TO PROCESS MERGE FILE                         01255389
*                                                                       01255390
*         THIS ROUTINE IS USED TO RESET ALL APPROPRIATE                 01255391
*         CALLS AND PARAMETERS TO THEIR ORIGINAL CONDITION              01255392
*         IN ORDER TO PROCESS THE SECOND OF TWO PLS OF                  01255393
*         A MERGE.  IT IS ALSO USED AS A CLEANUP ROUTINE                01255394
*         AFTER THE SECOND PL IS PROCESSED.  QFLAG NON-ZERO             01255395
*         INDICATES THAT THE ROUTINE IS BEING ENTERED A                 01255396
*         SECOND TIME.  THE FIRST TIME THROUGH, QFLAG IS                01255397
*         SET TO THE LENGTH OF THE DIRECTORY.  THIS SETS                01255398
*         QFLAG NON-ZERO FOR USE AS A FLAG AND ALSO SAVES               01255399
*         THE DIRECTORY LENGTH AFTER THE FIRST PL HAS BEEN              01255400
*         PROCESSED.  ALL READ ROUTINE CALLS WHICH MAY HAVE             01255401
*         BEEN CHANGED ARE RESET AND THE OLDPL AND NEWPL                01255402
*         FETS ARE SET UP.  ON ENTRY, X1 CONTAINS THE VALUE             01255403
*         OF MERGE, WHICH IS THE FILE NAME OF THE SECOND                01255404
*         OL.  THIS NAME IS PUT INTO THE OLDPL FET.  ON                 01255405
*         EXIT FROM THIS ROUTINE TO SECONDPL, ALL CON-                  01255406
*         DITIONS SHOULD HAVE BEEN RESET SO THAT AN OPEN                01255407
*         CAN BE ISSUED ON THE OLDPL WHICH IS NOW THE                   01255408
*         MERGE FILE.                                                   01255409
SETMERGE  SA3    QFLAG             QFLAG WILL BE NON-ZERO AFTER THE 
          NZ     X3,SECONDTI       MERGED PL HAS BEEN READ
          SA2    L.DIRECT          IT WILL CONTAIN THE DIRECTORY
          BX6    X2                LENGTH FROM BEFORE THE ADDITION
          SA6    A3                OF THE MERGED IDENTS 
          SX7    B0                CLEAR RANDOPL FLAG TO ZERO 
          MX6    1                 AND SET EDIT FLAG TO NEGATIVE
          SA7    RANDOPL
          SA6    EDITFLAG 
  
          ENV    ACT,(2,3),VER2 
          CLOSE  OLDPL
          SA1    OLDPL+FETFIT      GET FIT LOCATION 
          SA1    X1+B1             GET SECOND WORD OF FIT 
          SA2    RTW
          BX7    X1*X2             SET RT=W UNBLOCKED 
          SA7    A1 
          SA1    MERGE
VER2      ENDIF 
  
          SX7    3
          SX4    B1                SET THE OLDPL TO READ IN THE 
          BX7    X7+X1             LIBRARY TO BE MERGED 
          LX4    47                RESET THE RANDOM BIT IN
          SA7    OLDPL             THE FET AND SET UP TO READ 
          SA1    A7+B1             POSSIBLE RANDOM INDEX INTO 
          SX3    LRANIDX           RANIDX.
          SX6    RANIDX 
          BX7    X1+X4
          SA7    A1 
          LX3    18 
          BX6    X3+X6
          SA6    OLDPL+7
          MX7    0
          SX6    B0 
          ENV    NOT,(2,3),VER2 
          SA7    OLDPL+8           CLEAR LABEL FIELD IN OLDPL FET 
          SA6    OLDPL+11 
          SA7    A7+B1
          SA6    A6+B1
          SA7    A7+B1
          SA6    A6+B1
 VER2     ENDIF 
          SX6    B1 
          SA6    L.DECKS
          SA7    RJRBIN            RESET READ TYPE FLAG, CHECKSUM 
          SA7    RJROPL            1.2 STYLE PL 
          EQ     SECONDPL 
          SPACE  1
**        SECONDIT  RESET AFTER MERGE                                   01255411
*                                                                       01255412
*         THE SECOND PL OF THE MERGE HAS BEEN READ AND                  01255413
*         A COMBINED PL CALLED UPDTTPL HAS BEEN PRODUCED.               01255414
*         ALL OF THE FLAGS WHICH WHERE SET UP FOR THE                   01255415
*         MERGE ARE RESET AND ALL SCRATCH TABLES WHICH                  01255416
*         ARE NO LONGER NEEDED ARE ZEROED.                              01255417
*                                                                       01255418
*         CALLS  PRINT                                                  01255419
SECONDTI  MX6    0                 ENTER HERE AFTER PROCESSING THE
          MX7    60 
          SA6    WHATZIT
          SA6    SIXTY3 
          SA6    A3                SECOND LIBRARY OF THE PAIR OF
          SA7    EDITFLAG 
          SA6    IDNAM             LIBRARIES TO BE MERGED. RESET
          SA6    CHG+3             ALL TEMPORARY CELLS ND TABLES. 
          SA6    L.COUNT           CHECK TDICT TO SEE IF ANY IDENT
          SA1    L.TDICT           NAMES WERE ALTERED TO MAINTAIN 
          ZR     X1,ENDMERGE       UNIQUENESS. IF THERE WERE ANY
          SX6    EJECT
          SA6    LPCNT             SUITABLE MESSAGES. 
          SA1    LISTONE
          ZR     X1,MESSCHGL       NO LIST ERRORS 
          PRINT  P1CHGD1,8
          PRINT  P1CHGD2,8
          PRINT =8L0,1
MESSCHGL  SA1    L.TDICT           TDICT NOW CONTAINS A LIST OF IDENT 
          ZR     X1,MESSCHG3       NAMES WHICH HAD TO BE CHANGED TO 
          SA2    F.TDICT           AVOID DUPLICATE IDENTS. WE NOW 
          SX6    X1-2              FORMAT THEM INTO THE PROPER MESSAGE
          SX7    X2+2              TO BE PRINTED BY FILLING WITH
          SA6    A1                BLANKS AND INSERTING THEM INTO 
          SA7    A2                -MESS-. PRINT THESE ENTRIES
          SB2    B1+B1
          SA1    X2 
          SB6    5
MESSCHG2  SX3    1R 
          MX0    54 
          SB6    B6-B2
MESSCHG1  LX0    6
          BX6    -X0*X1 
          BX1    X1+X3
          LX3    6
          ZR     X6,MESSCHG1
          BX6    X1 
          SA1    A1+B1
          SA6    MESS+B6
          NE     B1,B6,MESSCHG2 
          PRINT  MESS,4 
          EQ     MESSCHGL 
 MESSCHG3 SX6    EJECT
          SA6    LPCNT
          EQ     ENDMERGE 
          SPACE  1
 DETOUR   ALLOC  COUNT,X2          READ SECOND DIRECTORY INTO -COUNT- 
          READWC OLDPL,X2,X3
          EQ     DETOURA
          SPACE  1
DETOUR1   SA1    L.COUNT           SET UP TO PROCESS THE 2ND DIRECTORY
          SX7    B1                BY SETTING WORKLGTH
          BX6    X1                EQUAL TO L.COUNT, AND L.COMIND EQUAL 
          SA6    WORKLGTH          TO 1.
          SA7    L.COMIND 
DETOUR2   SA3    WORKLGTH          WHEN WORKLGTH IS REDUCED TO
          ZR     X3,DETOUR3        ZERO, ALL ENTRIES ARE DONE.
          SA1    F.COUNT           CALCULATE THE LOCATION OF
          SA2    L.COUNT           AND FETCH THE NEXT ENTRY TO
          IX0    X1-X3             BE PROCESSED. DECREMENT
          SX6    X3-1              WORKLGTH.
          IX0    X0+X2             THIS IS THE ADDRESS WE WANT. 
          SB4    55                SHIFT COUNT TO SHIFT TO PURGE BIT. 
          SA6    A3                RESTORE WORKLGTH.
          SA1    X0                FETCH THE DIRECTORY ENTRY. 
          LX2    X1,B4             SHIFT TO PURGE BIT.
          BX7    X1 
          NG     X2,DETOUR6        SKIP NAME CHANGE IF PURGED 
          SA7    GETLIMT           SAVE IDENT.
          RJ     TLUDIR            LOOK FOR DUPLICATE.
          ZR     X2,DETOUR5        SKIP NAME CHANGE IF UNIQUE 
          SB5    54B               COUNT FOR IDCHANGE 
          SA7    IDNAM        STORE NAME TO BE CHANGED
 DETOUR4  RJ     IDCHANGE     ALTER NAME TO MAKE IT UNIQUE
          SA0    B0 
          SA2    IDNAM       FETCH NAME TO BE CHANGED 
          BX7    X2          SET FOR TLUDIR 
          RJ     TLUDIR            CHECK NEW NAME FOR DUPLICATE.
          NZ     X2,DETOUR4        LOOP UNTIL UNIQUE
          MX6    0
          SA6    A6                CLEAR CHANGE MESSAGE 
          ADDWRD TDICT,X1          ADD NEW NAME TO TDICT. 
          SA1    GETLIMT
          ADDWRD TDICT,X1          ADD OLD NAME TO TDICT. 
          SA1    IDNAM
          SPACE  1
          ENV    NOT,(2,3),S2LCM
 DETOUR5  ADDWRD DIRECT,X1         ADD VALID, UNIQUE NAME TO DIRECTORY
S2LCM     ELSE
DETOUR5   RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          EQ     DETOUR2
          SPACE  1
DETOUR6   SX1    20B               SUBSTITUTE PURGE BIT.
          EQ     DETOUR5
          SPACE  1
 COPYDONE SA1    RANDOPL           CHECK IF SEQUENTIAL LIBRARY. 
          ZR     X1,COPYDON1       IF SEQUENTIAL. 
          SA1    F.DECKS           SET UP TO READ NEXT RECORD.
          SA2    L.DECKS           ALL RECORDS DONE WHEN L.DECKS = 0. 
          SX6    X1+2 
          SX7    X2-2 
          SA6    A1 
          SA7    A2 
          ZR     X7,COPYDON1
          SA1    X6+B1
          BX6    X1 
          SA6    OLDPL+6
          CLEAR  OLDPL,READ 
          EQ     COPYLOOP 
          SPACE  1
COPYDON1  RJ     CHANGFL           JUMP TO CHANGFL TO CLEANUP AND RESET 
          SA1    TCRDEC            RESET DIRECTORY LENGTH TO WHAT 
          BX7    X1                IT REALLY IS.
          SA7    L.DIRECT 
          SX6    EJECT
          SA6    LPCNT
          SA6    DECKFLAG 
          MX6    0
          SX7    B0 
          SA6    L.CNTR 
          SA7    CURDK
          SA6    L.COMIND 
NOEDIT    SA1    MERGE             IF MERGE IS REQUIRED JUMP TO 
          NZ     X1,SETMERGE       SETMERGE TO MANIPULATE FILES.
ENDMERGE  MOVE   3,FTITL,TITLE+3
C         ENDIF 
  
          ENV    ACT,(2,3),VER2 
          MX7    0
          SA7    NEWPL+EOIPOS 
VER2      ENDIF 
  
**                                                                      01257119
*         THE NORMAL FIRST PASS (SECOND PASS IF EDIT OR MERGE IS        01257120
*         SPECIFIED) CONSISTS OF READING CARDS FROM THE INPUT FILE AND  01257121
*         SETTING UP THE APPROPRIATE FLAGS AND TABLES.  TEXT CARDS ARE  01257122
*         FILED AWAY ON THE FILE UPDTEXT FOR RETRIEVAL IN PASS 2.       01257123
*                                                                       01257124
*         THERE ARE FOUR LEVELS AT WHICH CONTROL CARDS ARE HANDLED.     01257125
*                                                                       01257126
*         1. HANDLED INSIDE THE INPUT READ ROUTINE                      01257127
*                *READ       CAUSES SUBSEQUENT READING TO TAKE PLACE    01257128
*                            FROM FILE SPECIFIED ON READ CARD           01257129
*                *TEXT       DEFEATS RECOGNITION OF CONTROL CARDS UNTIL 01257130
*                            ENDTEXT CARD                               01257131
*                *REWIND     CAUSES REWIND ON FILE SPECIFIED            01257132
*                *SKIP       CAUSES SOME NUMBER OF RECORDS ON SPECIFIED 01257133
*                            FILE TO BE SKIPPED                         01257134
*                */          IDENTIFIES COMMENT CARD, TO BE COPIED TO   01257135
*                            LISTING                                    01257136
*                *NOLIST     DEFEATS LISTING OF INPUT CARDS             01257137
*                *LIST       REACTIVATES LISTING OF INPUT CARDS         01257138
*                *ABBREV     ACTIVATES RECOGNITION OF CONTROL CARD      01257139
*                            ABBREVIATION                               01257140
*                *LIMIT      SETS LIMIT ON NUMBER OF LINES OF LISTING   01257141
*                *NOABBREV   DEFEATS RECOGNITION OF CONTROL CARD        01257142
*                            ABBREVIATIONS                              01257143
*                *END        IGNORED                                    01257144
*                *DECLARE    SPECIFIES DECK IN WHICH FOLLOWING MODS     01257145
*                            MUST OCCUR                                 01257146
*                                                                       01257147
*         2. CAN OCCUR AT ANY POINT IN THE INPUT STREAM                 01257148
*                *IDENT      CAUSES THE PREVIOUS IDENT (IF ANY) TO BE   01257149
*                            TERMINATED.  PREVIOUS IDENT IS ADDED TO THE01257150
*                            DIRECTORY AND THE NEW IDENT WILL BE USED   01257151
*                            TO GENERATE SEQUENCE FIELDS ON FOLLOWING   01257152
*                            TEXT CARDS.                                01257153
*                *PURGE      CAUSES TERMINATION OF PREVIOUS IDENT       01257154
*                            (IF ANY).  SETS BIT 4 IN APPROPRIATE       01257155
*                            DIRECTORY ENTRY.                           01257156
*                *COPY       CAUSES SPECIFIED CARDS TO BE READ FROM     01257157
*                            OLDPL AND WRITTEN ON SPECIFIED REMOTE FILE.01257158
*                            COPY ALSO MAY FUNCTION UNDER TYPE (3) BELOW01257159
*                            TO WRITE THE SPECIFIED RANGE OF CARDS ONTO 01257160
*                            UPDTEXT FOR LATER PROCESSING IN PASS 2.    01257161
*                *COMPILE    CAUSES SPECIFIED DECK NAMES TO BE ENTERED  01257162
*                            IN THE LIST OF DECKS TO BE PROCESSED       01257163
*                            (DKLIS).                                   01257164
*                *ADDFILE    SIMULATES A CREATION RUN WITHIN A          01257165
*                            CORRECTION RUN.  TERMINATES ANY PREVIOUS   01257166
*                            IDENT.  CARDS ON SPECIFIED FILE MUST BE    01257167
*                            IN SAME FORMAT AS INPUT FOR A CREATION RUN.01257168
*                *SEQUENCE   TERMINATES PRIOR IDENT.  CAUSES BIT 3 OF   01257169
*                            DIRECTORY ENTRY WITH SAME NAME AS SPECIFIED01257170
*                            DECK TO BE SET ON.  IF NO SUCH DIRECTORY   01257171
*                            ENTRY EXISTS, ONE IS CREATED.              01257172
*                *CHANGE     CAUSES NAME IN DIRECTORY ENTRY TO BE       01257173
*                            CHANGED                                    01257174
*                *SELPURGE   CAUSES ENTRY TO BE MADE IN PURYAN TABLE    01257175
*                *MOVE       ALTERS OLDPL ORDER BY ALTERING INDEX ORDER 01257176
*                            OF DECKS.  COPY AND MOVE REQUIRE A RANDOM  01257177
*                            OLDPL AND GENERATE ONE (UPDTTPL) IF        01257178
*                            NECESSARY.                                 01257179
*                *PURDECK    CAUSES BIT 0 OF APPROPRIATE DECK LIST      01257180
*                            ENTRY TO BE SET ON.                        01257181
*                *PULLMOD    CAUSES SPECIFIED IDENT NAME TO BE          01257182
*                            ENTERED IN PMODS TABLE.                    01257183
*                                                                       01257184
*         3. THE THIRD LEVEL OF CONTROL CARDS CAN BE ACCEPTED           01257185
*            ONLY AFTER AN IDENT CARD HAS BEEN PROCESSED SINCE THESE    01257186
*            CARDS CREATE CHB"S ON THE LIBRARY AND EACH CHB MUST        01257187
*            INCLUDE THE DIRECTORY ORDINAL OF THE IDENT                 01257188
*            WHICH CREATED IT.                                          01257189
*                                                                       01257190
*                *INSERT     THESE CARDS CREATE ENTRIES IN THE DICT     01257191
*                *RESTORE    TABLE.  ONLY AFTER ONE OF THESE CARDS CAN  01257192
*                *DELETE     TEXT INFORMATION OR THE SECOND TYPE OF     01257193
*                *BEFORE     COPY CARD BE VALID.                        01257194
*                                                                       01257195
*                *YANK       THESE FOUR CARDS PRODUCE ENTRIES IN THE    01257196
*                *SELYANK    TDICT TABLE WHICH ARE SIMULATIONS OF       01257197
*                *YANDECK    INSERT ENTRIES.  THESE ENTRIES ARE MADE IN 01257198
*                *DEFINE     TDICT BECAUSE THEY MUST BE PROCESSED BEFORE01257199
*                            ANY OTHER CARDS ON THE LIBRARY.            01257200
*                                                                       01257201
*                *DECK       THESE TWO CARDS CAUSE THE SPECIFIED DECK   01257202
*                *COMDECK    NAMES TO BE ENTERED INTO THE DECK LIST.    01257203
*                                                                       01257204
*         4. ALL OTHER CONTROL CARDS AND IN FACT, THE YANK, SELYANK,    01257205
*            YANKDECK, DEFINE, DECK AND COMDECK CARDS ARE TREATED IN    01257206
*            PASS 1 AS TEXT CARDS.  FURTHER SPECIAL PROCESSING WILL     01257207
*            OCCUR IN PASS 2.                                           01257208
          SPACE  1
          SA1    SQLGN             JUMP TO ECOR 
          ZR     X1,ECOR           IF THERE ARE NO MODIFICATIONS AS 
          SX7    4B                INDICATED BY SQUIMAGE=0.  OTHERWISE
          SX6    CORR5B            SET UP THE PROPER RETURN JUMP IN 
          LX7    54                READCD AND JUMP TO READCD22, WHERE 
          LX6    30                A SECOND LOOK AT THE INITIAL INPUT 
          BX7    X7+X6             CARD MUST BE TAKEN.
          SA7    READCD 
          JP     READCD22 
          SPACE  1
          IF     DEF,EDITKEY,2
MESS      DIS    4,    OLD                 NEW
EDITITLE  DIS    3,  EDIT OPERATIONS PERFORMED
          EJECT 
          SPACE  4
BADORDER  SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1BADORD,6 
          EQ     CORER1 
          SPACE  4
**        CHANGFL TERMINATES COPY OPERATIONS                            01254727
*                                                                       01254728
*         THIS SUBROUTINE IS CALLED AFTER ANY OPERATION                 01254729
*         IN WHICH AN OLDPL HAS BEEN COPIED TO A TEMPORARY              01254730
*         NEWPL DURING A CORRECTION RUN.  ALL NECESSARY                 01254731
*         CALLS AND CONTROL CELLS ARE RESET SO THAT FURTHER             01254732
*         PROCESSING CAN READ THE TEMPORARY NEWPL AS THE                01254733
*         OLDPL.  IF AN INPUT CARD HAD BEEN SAVED IN                    01254734
*         TSQIMAGE, IT WILL BE RESTORED IN SQIMAGE.                     01254735
*                                                                       01254736
*         CALLS  CALLIO, ADDWORD, MANAGER, MOUEIT, CLASSIFY, UCARD      01254737
          SPACE  1
CHANGFL   BSS    1
          BX6    X6-X6
          SA6    SIXTY3            CLEAR SIXTY3 
          SA6    WHATZIT           AND WHATZIT CONVERSION FLAGS 
          SA6    RJROPL            1.2 STYLE PL 
          SX7    B1 
          SA7    RJRBIN            NO CHECKSUM
          SA1    NOREWFLG 
          LX1    59-3 
          PL     X1,NOREWAA 
          REWIND OLDPL,RECALL 
 NOREWAA  CLOSE  OLDPL,NR,RECALL
          WRITER NEWPL,RECALL 
          SA1    SCRLOC 
          ADDWRD NEWDKS,X1
          SA1    NUMDECKS 
          ZR     X1,CHANGFL3
          LX1    1
          BX6    X1 
          SA6    A1 
          ALLOC  NEWDKS,X1
          SA5    F.DECKS     MOVE THE ADDED DECK NAMES TO NEWDKS
          SA4    L.DECKS
          SA1    NUMDECKS 
          IX3    X2+X3
          IX2    X5+X4
          IX3    X3-X1
          IX2    X2-X1
          MX6    0
          SA6    A1 
          MOVE   X1,X2,X3 
CHANGFL3  BSS    0
          MX6    0
          SX7    B1 
          SA6    RDCHSUM
          SA7    DECKFLAG 
          SA6    WRCHSUM
          SA6    L.DECKS
          SA1    CPYTOLIB          SKIP THE FOLLOWING CODE TO RESTORE 
          NZ     X1,CHANGFL        VARIOUS POINTERS AND SWITCH FILE 
          SPACE  1
A         IF     DEF,EDITKEY
          SA1    MERGE
          SA2    QFLAG
          ZR     X1,CHANGFL1
          NZ     X2,CHANGFL1
  
          ENV    ACT,(2,3),VER2 
          RJ     RSNPLFET 
VER2      ELSE
          SA1    TEMPNPL
          BX6    X1 
          SA6    NEWPL
VER2      ENDIF 
  
          EQ     CHANGFL
A         ENDIF 
          SPACE  1
CHANGFL1  BSS    0
          SA1    L.NEWDKS 
          ALLOC  DECKS,X1 
          SA4    F.NEWDKS 
          SX1    X3 
          SX3    X2 
          SX2    X4 
          MOVE   X1,X2,X3 
          SX6    B1 
          SA6    L.NEWDKS 
          SA4    F.DECKS
          SA3    X4+B1
          SA1    TEMPIN 
          SA2    TEMPNPL
          BX6    X1 
          LX7    X2 
          SA6    OLDPL
          SA7    NEWPL
          MX6    1
          BX7    X3 
          SA1    A6+B1
          LX6    48 
          BX6    X6+X1
          SA6    A1 
          SA7    OLDPL+6
          SA6    RANDOPL
          CLEAR  OLDPL,READ 
  
          ENV    ACT,(2,3),VER2 
          SA1    TEMPIN+1          SWITCH FIT POINTERS
          SA2    TEMPNPL+1
          BX6    X1 
          LX7    X2 
          SA6    OLDPL+FETFIT 
          SA7    NEWPL+FETFIT 
          RJ     RSNPLFET 
VER2      ENDIF 
  
          SA1    TSQLGN 
          MOVE   X1+B1,A1,SQLGN 
          SB4    LPARLIST 
          RJ     CLASSIFY 
          MX7    0
          SA7    CARD 
          EQ     CHANGFL
          EJECT  4                                                      01257477
**        CHECHAR  CHECK CONTROL CHARACTER                              01254739
*                                                                       01254740
*         THIS SUBROUTINE IS CALLED TO INSURE THAT THE                  01254741
*         CONTROL CHARACTER WITH WHICH THE OLDPL WAS CRE-               01254742
*         ATED IS THE SAME AS THE CONTROL CHARACTER SPE-                01254743
*         CIFIED FOR THE CURRENT RUN.  IN ANY CASE THE                  01254744
*         CHARACTER WITH WHICH THE PL WAS CREATED WILL                  01254745
*         BE USED TO PROCESS THIS RUN.  THIS ROUTINE ALSO               01254746
*         INSURES THAT THE CONTROL CHARACTER IS THE SAME                01254747
*         FOR BOTH PLS OF A MERGE.  AT THIS TIME A DETER-               01254748
*         MINATION IS MADE AS TO WHETHER OR NOT THE DOB                 01254749
*         CHARACTER IS TO BE SUPPORTED DURING THIS RUN.                 01254750
*                                                                       01254751
*         CALLS  CALLPP, CLASSIFY                                       01254752
          SPACE  2
CHECHAR   PS
          MX0    54 
          BX6    -X0*X2 
          SA6    OPLMCC            STORE MASTER CONTROL CHARACTER.       CP190
          AX2    6
          BX7    -X0*X2 
          SB7    X7-1RY 
          ZR     B7,CHECHAR1
          MX7    0
CHECHAR1  BSS    0
          SPACE  1
          IF     DEF,CHAR64,1 
          BX7    -X7
          SA7    CHARKEY
          AX2    12                                                     0214  52
          BX7    -X0*X2            GET CHARACTER FROM OLDPL HEADER      0214  53
          SA7    CHG63             SET FLAG                             0214  54
          SA7    OPLCSET           STORE OLDPL CHARACTER SET INDICATOR.  CP190
          SX7    X7-1R5 
          SA7    MODEP
          SA1    FLGCHAR           CHECK TO SEE IF PROPER 
          ZR     X6,CHECHAR        CONTROL CHARACTER
          BX0    X1-X6             IT IF NOT.  RECORD THIS
          ZR     X0,CHECHAR        AS A NON-FATAL ERROR.
          SPACE  1
          IF     DEF,EDITKEY,2
          SA4    QFLAG             ATTEMPT TO MERGE TWO PLS WITH
          NZ     X4,MERCHAR        DIFFERENT CONTROL CHARACTERS.
          SA3    CHARMESS+3        ALSO RE-CLASSIFY THE LAST CARD.
          LX6    12 
          BX7    X6+X3
          AX6    12 
          SA7    A3 
          SA6    A1 
          MESSAGE CHARMESS
          SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          RJ   SQUEEZE                                                  1330  23
          SB4    LPARLIST 
          RJ     CLASSIFY 
          SA4    DEFAULT                                                1330  25
          SA1    =10H *****                                             1330  26
          ZR   X4,CHECHAR2                                              1330  27
          SA1    =10H ///// 
CHECHAR2  BX6    X1                                                     1330  31
          SA6    DNAME                                                  1330  32
          EQ     CHECHAR
          SPACE  1
CHARMESS  DIS    3,IMPROPER MASTER CHARACTER CHAN 
          DATA   7LGED TO 
          SPACE  1
MERCHM    DATA   C+PLS HAVE DIFFERENT CONTROL CHARACTERS, ABORT.+ 
 MERCHAR  MESSAGE MERCHM
          EQ     ABORT
          EJECT  4                                                      01257479
**        CHECKATT  CHECKS FOR QUALIFIERS ON IDENT DIRECTIVE            01254754
*                                                                       01254755
*         THIS SUBROUTINE CHECKS FOR ATTRIBUTES SPECIFIED               01254756
*         ON AN IDENT CARD.  CURRENTLY, THE DEPENDENCY                  01254757
*         ATTRIBUTES K AND U ARE SUPPORTED AS WELL AS THE               01254758
*         SEQUENCE NUMBER BIAS ATTRIBUTE B.  FORMAT FOR                 01254759
*         THESE ATTRIBUTES MUST BE A = PARAM WHERE A IS                 01254760
*         A VALID ATTRIBUTE AND PARAM IS A VALID IDENT                  01254761
*         NAME (K OR U) OR A SEQUENCE BIAS VALUE (B).                   01254762
*         ATTRIBUTES ARE SEPARATED BY COMMAS AND END WITH               01254763
*         THE FIRST BLANK.                                              01254764
*                                                                       01254765
*         CALLS  GETCH, SCNN, SCITEM, TLUDIR, PRINTERR, PRINT           01254766
          SPACE  1
CHECKATT  PS
          MX6    0
          SA6    SEQBIAS           SET NORMAL VALUE OF BIAS 
CHECKAT1  SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,CHECKATT       NO COMMA 
          RJ     GETCH
          SA1    CHAR 
          SB7    X1-1RB 
          ZR     B7,CHKBIAS        JUMP TO PICK UP SEQUENCE BIAS
          SB7    X1-1RK 
          ZR     B7,KNOWN 
          SB7    X1-1RU 
          ZR     B7,UNKNOWN 
          EQ     CHECKATT 
          SPACE  1
CHKBIAS   RJ     GETCH
          SB7    X6-1R= 
          NZ     B7,CHECKAT1       JUMP IF NOT EQUATED TO ANYTHING
          RJ     GETCH             PASS THE EQUALS SIGN 
          RJ     SCNN              FETCH BIAS 
          SA6    SEQBIAS           AND STORE IT.
          EQ     CHECKAT1 
          SPACE  1
KNOWN     RJ     GETCH
          SB7    X6-1R= 
          NZ     B7,CHECKAT1       FIND EQUAL SIGN
          RJ     GETCH
          RJ     SCITEM 
          ZR     X7,CHECKAT1       SKIP IF NO NAME
          RJ     TLUDIR 
          NZ     X2,CHECKAT1       SKIP IF KNOWN
          SX6    B1 
          SA6    SKIPID            SET SKIP FLAG
          EQ     CHECKAT1          IF NOT KNOWN 
          SPACE  1
UNKNOWN   RJ     GETCH
          SB7    X6-1R= 
          NZ     B7,CHECKAT1       FIND EQUAL SIGN
          RJ     GETCH
          RJ     SCITEM            GET IDENT NAME 
          ZR     X7,CHECKAT1       NO NAME
          RJ     TLUDIR 
          ZR     X2,CHECKAT1       OK IF NOT KNOWN
          SX6    B1 
          SA6    SKIPID 
          EQ     CHECKAT1 
          EJECT  4                                                      01257481
A         IF     DEF,DECLKEY
          SPACE  2                                                      01257456
          SPACE  1
CHECKDCL  PS
          LX1    -36
          SB2    -B1
          SA3    F.DECTAB 
          IX0    X1+X3
          SA3    X0+B2             FETCH DECLARED DECK
          BX0    X7-X3             COMPARE NAMES
          NZ     X0,DECLERR2       ERROR IF NOT SAME
          EQ    CHECKDCL
          SPACE  1
DECLERR   SA1    LISTONE                                                1324   5
          ZR     X1,DECLERR1
          RJ     PRINTERR 
          PRINT  P1DCLER1,8 
DECLERR1  SA1    DTYPERR
          SX6    X1+B1
          SA6    A1 
          EQ     CORR5A 
          SPACE  1
DECLERR2  SA1    LISTONE                                                1324   7
          ZR     X1,DECLERR1
          RJ     PRINTERR 
          PRINT  P1DCLER2,7 
          EQ     DECLERR1 
          SPACE  1
A         ENDIF 
          SPACE  4
**        CMPL   PROCESS COMPILE DIRECTIVE                              01254768
*                                                                       01254769
*         TWO FORMATS ARE SUPPORTED ON THE COMPILE CARD.                01254770
*         INDIVIDUAL DECKS TO BE PROCESSED ARE SEPARATED                01254771
*         BY COMMAS.  A RANGE IS SPECIFIED BY TWO NAMES                 01254772
*         SEPARATED BY A PERIOD.  GETCH IS CALLED TO SKIP               01254773
*         DELIMITERS.  SCITEM IS CALLED TO READ DECK NAMES.             01254774
*         CHKDCKS IS CALLED TO VALIDATE DECK NAMES.  CRDKLIS            01254775
*         IS CALLED TO CREATE ENTRIES IN DKLIS.  WHEN A RANGE           01254776
*         IS TO BE PROCESSED, THE ORDER USED TO DETERMINE               01254777
*         WHICH DECKS SHOULD BE PROCESSED, IS THE ORDER OF              01254778
*         NAMES IN DECKS.  THIS LIST MAY NOT REFLECT THE                01254779
*         ACTUAL ORDER OF DECKS ON THE OLDPL, ESPECIALLY                01254780
*         IF THE PL BEING USED IS A PRE-VERSION 1.2 OLDPL.              01254781
*                                                                       01254782
*         CALLS  PRINT, GETCH, SCITEM, CHKDCKS, CRDKLIS, MOVEIT         01254783
          SPACE  1
CMPL      SA1    LISTTWO
          MX6    0
          SA6    FSTIME            SET TO ZERO. 
          ZR     X1,CMPL2 
          PRNTCARD
CMPL2     SA1    CHAR 
          SB4    X1-1R
          SA4    FSTIME            FETCH FIRST TIME THRU FLAG.
          NZ     B4,CMPL4          CONTINUE ON NON BLANK. 
          NZ     X4,CORR5A         EXIT ON BLANK AND NOT FIRST TIME . 
          EQ     SELPERR1          ERR IF BLANK NEXT AND 1ST TIME THRU. 
  
CMPL4     MX6    1
          SA6    A4                SET NON ZERO.
          EQ     B4,B1,CMPL5       COMMA, PROCESS NEXT NAME.
          SB3    B1+B1
          ZR     X1,CORER          COLON MEANS BAD CONTROL STATEMENT
          NE     B4,B3,CMPL6       NOT PERIOD, GET IDENT
          SB4    B0                SET PERIOD FLAG (B4=0) 
CMPL5     RJ     GETCH             SKIP COMMA OR PERIOD 
CMPL6     RJ     SCITEM            GET IDENT
          RJ     CHKDCKS
          NZ     X0,CMPL10         IF DECK NAME NOT FOUND.
          EQ     B2,B6,CMPL5
          SX6    B6                ORDINAL+2
          SA2    TCRBIN3
          SA6    A2 
          ZR     B4,CMPL7          JUMP TO PROCESS RANGE
CMPL6A    MX0    54                                                     0060   8
          BX1    X0*X7
          RJ     CRDKLIS           TRY TO PUT THIS IN DKLIS 
          ZR     X2,CMPL2          LIST AND LOOP                        0060  10
          SA1    F.DKLIS           ENTRY ALREADY THERE, SQUEEZE OUT 
          SA3    L.DKLIS                                                0060  12
          SX6    X3-1                                                   0060  13
          SA6    A3                REDUCE LENGTH BY 1                   0060  14
          BX0    X7                SAVE DECK NAME                       0060  15
          IX1    X1+X3                                                  0060  16
          SX2    A2+B1
          IX1    X1-X2
          MOVE   X1,X2,A2          MOVE REST OF ENTRIES UP
          BX7    X0                RESTORE DECK NAME                    0060  21
          EQ     CMPL6A            TRY TO PUT IT IN AGAIN               0060  22
          SPACE  1
CMPL7     IX3    X6-X2             CHECK THE ORDER
          NG     X3,BADORDER
          SX7    X2+B2
          ZR     X3,CMPL2          END OF RANGE REACHED 
          SA7    TCWBIN2
          SA1    F.DECKS           FIND NEXT ENTRY IN DECK LIST 
          MX0    54                AND ENTER INTO DKLIS.
          IX5    X1+X2
          SA1    X5 
          BX1    X0*X1
          RJ     CRDKLIS
          NZ     X2,CMPL9    IF ENTRY ALREADY EXISTS
CMPL8     SA2    TCWBIN2
          SA3    TCRBIN3
          SB2       B1+B1 
          BX6    X3 
          EQ     CMPL7
  
CMPL9     SA3    L.DKLIS
          SX6    X3-1 
          SA6    A3 
          LX0    X1 
          SA1    F.DKLIS
          IX1    X1+X3
          SX2    A2+B1
          IX1    X1-X2
          MOVE   X1,X2,A2          MOVE OTHER ENTRIES UP
          BX1    X0 
          RJ     CRDKLIS     CREATE NEW ENTRY AT END OF DKLIS 
          EQ     CMPL8
  
CMPL10    SA1    LISTONE
          ZR     X1,CMPL11         LIST OPTION 1 OFF
          SA6    NAMEMESS+1 
          RJ     PRINTERR 
          PRINT  NAMEMESS,5 
 CMPL11   SA1    ERRORS 
          SX7    X1+B1             BUMP ERROR COUNT.
          SA7    A1 
          EQ     CMPL2             LOOP.
          EJECT  4                                                      01257483
**        COPYOPL  CREATES A RANDOM LIBRARY                             01254785
*                                                                       01254786
*         MOVES AND COPYS CANNOT BE ACCOMPLISHED WITH A                 01254787
*         SEQUENTIAL OLDPL.  WHEN A SEQUENTIAL PL IS BEING              01254788
*         PROCESSED AND A MOVE OR COPY IS ATTEMPTED, COPYOPL            01254789
*         IS CALLED TO CREATE A RANDOM PL BEFORE ANY FURTHER            01254790
*         PROCESSING IS DONE.  SETCOPY IS CALLED BY COPYOPL             01254791
*         TO INITIALIZE FLAGS AND FETS FOR THE COPY PROCESS.            01254792
*         CARDS ARE READ FROM THE OLDPL BY THE NORMAL READ              01254793
*         ROUTINES.  EACH CURRENTLY ACTIVE DECK OR COMDECK              01254794
*         CARD CAUSES SETDECK TO BE CALLED TO TERMINATE THE             01254795
*         NEWPL RECORD CURRENTLY BEING WRITTEN AND MAKE                 01254796
*         THE APPROPRIATE TABLE ENTRIES.  WRNPL IS CALLED               01254797
*         TO WRITE EACH CARD TO THE NEWPL.  AT THE END OF               01254798
*         THE OLDPL, CHANGFL IS CALLED TO RESET FLAGS AND               01254799
*         REGISTERS AND SET UP SO THAT THE TEMPORARY NEWPL              01254800
*         JUST CREATED WILL BE READ AS THE OLDPL FOR FURTHER            01254801
*         PROCESSING.                                                   01254802
*                                                                       01254803
*         CALLS  SETCOPY, READOPL, CLASSIFY, WRNPL, SCITEM, SETDECK,    01254804
*                CHANGFL                                                01254805
          SPACE  1
COPYOPL   BSS    1
          RJ     SETCOPY
CPYLOOP   BSS    0
          READPL 2
          NZ     X1,CPYDONE 
          SB4    4                                                      0722   8
          RJ     CLASSIFY 
          CLASIFY                                                       0722  10
          ZR   X1,INACTCRD         JUMP IF NOT CONTROL CARD             0722  11
          CCJUMP DECK,STDKBIT4                                           CP190
          CCJUMP COMDECK,DECKCARD  JUMP IF DECK OR COMDECK              0722  13
          SA2    CARDSTAT 
          PL     X2,INACTCRD       IF CARD IS INACTIVE
          CCJUMP TEXT,CPY1                                              0722  14
          CCJUMP ENDTEXT,CPY2      JUMP IF TEXT OR ENDTEXT CARD         0722  15
INACTCRD  RJ     WRNPL
          EQ     CPYLOOP
          SPACE  1
DECKCARD  RJ     SCITEM 
          SA7    CPMSG+1
          RJ     SETDECK
          EQ     INACTCRD 
          SPACE  1
CPYDONE   MX6    0                 AT END OF SEQ PL, SET
          SA6    TXTFLAG           TEXT FLAG OFF. 
          RJ     CHANGFL
          MX7    60 
          SA7    EDITFLAG 
          EQ     COPYOPL
          SPACE  1                                                      0722  17
CPY1      SA2    TXTFLAG           FOR TEXT CARD                        0722  18
          SX6    X2+B1             ENCOUNTERED                          0722  19
          SA6    A2                                                     0722  20
          EQ   INACTCRD                                                 0722  21
          SPACE  1                                                      0722  22
CPY2      SA2    TXTFLAG                                                0722  23
          SX6    X2-1              FOR ENDTEXT CARD ENCOUNTERED         0722  24
          SA6    A2                                                     0722  25
          PL   X6,INACTCRD                                              1704   8
          RJ   TXTERR                                                   1704   9
          EQ   INACTCRD                                                 0722  26
          EJECT  4                                                      01257485
**        CORAD  PROCESS ADDFILE DIRECTIVE                              01254807
*                                                                       01254808
*         THE ADDFILE CARD SIMULATES A CREATION RUN WITHIN              01254809
*         A CORRECTION RUN.  ADDFILE CARDS ARE ILLEGAL ON               01254810
*         ANY FILE BEING READ AS A RESULT OF A READ CARD.               01254811
*         THE FIRST PARAMETER ON AN ADDFILE CARD MUST BE                01254812
*         THE NAME OF THE FILE FROM WHICH THE ADDFILE IS                01254813
*         TO BE MADE.  IF THIS PARAMETER IS ABSENT, ADDFILE             01254814
*         WILL BE MADE FROM THE MAIN INPUT UNIT.  IF THE                01254815
*         SECOND PARAMETER IS TO BE SPECIFIED AND THE DE-               01254816
*         FAULT IS TO BE USED FOR THE FILE NAME, A COMMA                01254817
*         MUST PRECEDE THE SECOND PARAMETER TO INDICATE                 01254818
*         THE ABSENCE OF A FIRST PARAMETER.  IF A FILE                  01254819
*         NAME IS FOUND IT IS CHECKED TO DETERMINE WHETHER              01254820
*         OR NOT IT IS THE SAME NAME THAT IS PRESENT IN                 01254821
*         THE INPUT FET.  ADDFLAG IS SET TO CONTAIN THE                 01254822
*         NAME OF THE FILE TO BE READ AND ALTUNIT IS SET                01254823
*         + NON-ZERO IF THE FILE IS OTHER THAN THE INPUT                01254824
*         UNIT.  IF THE SECOND PARAMETER IS ABSENT THE                  01254825
*         ADDFILE DECKS WILL BE INSERTED AT THE END OF                  01254826
*         THE LIBRARY.  IF THE SECOND PARAMETER IS AN                   01254827
*         ASTERISK THE DECK NAME USED WILL BE THE CURRENT               01254828
*         VALUE OF THE DEFAULT DECK NAME CELL.  IF THE                  01254829
*         SECOND PARAMETER IS FOLLOWED IMMEDIATELY BY A                 01254830
*         PERIOD UPDATE ASSUMES THAT THE ADDFILE IS OF                  01254831
*         THE FORM ADDFILE, DNAME, IDENT.SEQNUM.  THIS                  01254832
*         IS THE OLD STYLE ADDFILE.  IF THE PERIOD IS                   01254833
*         NOT PRESENT, THE SECOND PARAMETER MUST BE A                   01254834
*         VALID DECK NAME.  IN Q MODE THE NAME OF THE                   01254835
*         DECK AFTER WHICH THE ADDFILE IS TO BE MADE,                   01254836
*         IS ENTERED INTO DKLIS WITH BIT 1 ON SO THAT                   01254837
*         UPDATE WILL NOT SKIP PAST IT.  THE FIRST CARD                 01254838
*         ON THE FILE TO BE READ MUST BE A DECK OR COMDECK              01254839
*         CARD.  EACH DECK OR COMDECK CARD READ DURING AN               01254840
*         ADDFILE PRODUCES BOTH A NEW DECKS ENTRY AND A                 01254841
*         NEW DIRECT ENTRY.  IN Q MODE A DKLIS ENTRY IS                 01254842
*         ALSO MADE.  THE NUMBER OF DECKS BEING ADDED TO                01254843
*         THE LIBRARY IS KEPT IN NUMDECKS.  THIS VALUE                  01254844
*         IS NEEDED IF AT SOME LATER TIME COPYOPL MUST                  01254845
*         BE CALLED.  TEXT TO BE INSERTED IS COPIED TO                  01254846
*         THE TEXT FILE UPDTEXT AND APPROPRIATE ENTRIES                 01254847
*         ARE MADE IN DICT FOR USE IN PASS 2.  DICT ENTRIES             01254848
*         FOR OLD STYLE ADDFILES ARE THE SAME AS STANDARD               01254849
*         INSERT ENTRIES AND WILL BE PRINTED OUT AS SUCH                01254850
*         IF INTERPRETATION BECOMES NECESSARY AS THE RE-                01254851
*         SULT OF ERRORS.  NEW STYLE ADDFILES ARE TREATED               01254852
*         SEPARATELY AND THE DICT IS SEARCHED FOR THESE                 01254853
*         ENTRIES ONLY BETWEEN DECKS.  THE ADDFILE IS TER-              01254854
*         MINATED BY AN END OF RECORD.  ADDFILE FROM THE                01254855
*         MAIN INPUT UNIT IS ALSO TERMINATED BY ANY CARD                01254856
*         WHICH IS NOT A PART OF THE ADDFILE.                           01254857
*                                                                       01254858
*         CALLS  PRINTERR, PRINT, SCITEM, CPCLEAR, CHKFILE, GETCH,      01254859
*                CHKDCKS, CRDKLIS, CALLIO, READCD, CLASSIFY, CORIDX,    01254860
*                MANAGER, ADDWORD, ENTDICT, ENTTEXT, TLUDIR, SCNN,      01254861
*                MOVEIT                                                 01254862
          SPACE  1
CORAD     SA1    ALTUNIT           ADDFILE CARDS ARE INVALID ON A FILE
          NG     X1,CORAD0         BEING COPIED OR
          ZR     X1,CORAD1         BEING READ AS A RESULT OF A READ 
CORAD0    SA1    LISTONE           CARD.
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1ADDER1,5 
          EQ     CORER1 
          SPACE  1
CORAD1    SA1    LISTTWO
          ZR     X1,CORAD1A 
          PRNTCARD
CORAD1A   BSS    0
          MX7    0
          SA7    ADDCNT            SET ADDCNT TO ZERO 
          RJ     SCITEM            FETCH FILE NAME
          SA6    TCWBINC           SAVE FILE NAME 
          ZR     X7,CORAD10 
          BX1    X7                                                      UPD0330
          RJ     LFNCK                                                   UPD0330
          NG     X6,CORER          IF FILE NAME IS BAD.                  UPD0330
          SA1    INPUT             CHECK TO SEE IF
          MX0    42                WE ARE READING 
          BX1    X1*X0             FROM THE INPUT 
          IX6    X6-X1       UNIT. SET ALTUNIT ACCORDINGLY. 
          ZR     X6,CORAD9
          SX6    B1 
CORAD9    SA7    ADDFLAG           SET ADDFLAG NON-ZERO(FILE NAME)
          SA6    ALTUNIT           ALTUNIT ZERO IF ADDFILE FROM INPUT.
          SX7    X6-1 
          SA7    INITFIL           *ADDFILE FILE(-1 MAIN INPUT, 0 ALT)
          ZR     X6,CORAD2
          CLEAR  READFIL           IF WE ARE READING A REMOTE FILE, 
          SA2    ADDFLAG           CLEAR THE READFIL FET, SET THE NEW 
          SX1    B1                FILE NAME IN THE FET WORD 1, AND 
          BX7    X1+X2             CHECK FOR DUPLICATE FILE.
          BX1    X7 
          SA7    A1 
          RJ     CHKFILE
CORAD2    SA1    CHAR              IF THE NEXT CHARACTER IS BLANK, AS 
          SB7    X1-1R             A DEFAULT PUT THIS ADDFILE AT THE
          ZR     B7,CORAD7         END OF THE LIBRARY. IF THE NEXT
          NE     B7,B1,CORER       CHARACTER IS NOT A BLANK OR A COMMA
          RJ     GETCH       WE HAVE AN ERROR.  ELSE SKIP THE COMMA 
          SA1    CHAR              CHECK FOR ANOTHER COMMA. 
          SB7    X1-1R, 
          ZR     B7,CORAD7         IF ANOTHER COMMA PUT *AF AT END
          RJ     SCITEM            ELSE FETCH THE DECK NAME.
          ZR     X7,CORER          ERROR IF NULL DECK NAME. 
          SA2    =1L* 
          IX2    X7-X2
          ZR     X2,CORAD7A  IF CURRENT VALUE OF DEFAULT CELL IS TO 
*                            BE USED. 
          SA1    CHAR 
          SB7    X1-1R.            CHECK FOR OLD STYLE ADDFILE
          ZR     B7,CORADOLD
          RJ     CHKDCKS           FIND DECK LIST ENTRY 
          NZ     X0,CORADER1
          MX6    0
CORAD8    SA6    NEWAD                                                  0213  11
          SA1    FASTFLG           IF WE ARE IN Q MODE ENTER THE NEXT 
          SA7    A6+B1
          ZR     X1,CORAD5         DECK NAME IN THE DKLIS TABLE SO WE 
          SX4    B1+B1             DONT SKIP IT.
          BX1    X7+X4
          RJ     CRDKLIS
CORAD5    SA1    ALTUNIT
          ZR     X1,CORAD6         IF WE ARE WORKING FROM A FILE NOT
          SPACE  1
  
  
          OPEN   READFIL,ALTERNR
          CLEAR  READFIL,READ 
  
          ENV    ACT,(2,3),VER2 
          RJ     CHKFMT            CHECK *ADDFILE FILE FORMAT 
VER2      ENDIF 
  
CORAD6    RJ     READCD            READ A CARD. 
          NZ     X1,CORADER2       JUMP ON END OF RECORD
          SA1    TCWBINC           SET FILE NAME IN PLACE 
          BX6    X1 
          SA6    CARD3
          CLASIFY 
          MX6    0
          SA6    DEFAULT
          CCJUMP DECK,STDKBIT5                                           CP190
          CCJUMP COMDECK,CORADA 
          SA1    LISTONE
          ZR     X1,CORADER3
          RJ     PRINTERR 
          PRINT  P1ADDER2,6 
CORADER3  SA1    ERRORS            BUMP ERROR COUNT 
          SX6    X1+B1
          SA6    A1 
          EQ     CORADEND 
          SPACE  1
CORADER1  SA1    LISTONE
          ZR     X1,CORER1
          SA6    NAMEMESS+1 
          RJ     PRINTERR 
          PRINT  NAMEMESS,5 
          EQ     CORER1 
          SPACE  1
CORAD7    SA1    DEFDECK
          MX6    0
          BX7    X1 
          EQ     CORAD8 
          SPACE  1
CORAD7A   SA1    TGETLIMT 
          SA2    F.DIRECT 
          MX6    0
          IX0    X1+X2
          MX2    54 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X0 
S2LCM     ELSE
          RX1    X0 
S2LCM     ENDIF 
          SPACE  1
          BX7    X2*X1
          EQ     CORAD8 
          SPACE  1
CORAD10   SA1    INPUT
          MX0    42 
          BX1    X1*X0      7 CHARS OF FILENAME 
          RJ     SFN= 
          SA6    TCWBINC           SAVE INPUT AS FILENAME 
          BX7    X0*X6       FILENAME TO X7 
          SX6    B0 
          EQ     CORAD9 
          SPACE  1
CORADER2  SA1    LISTONE
          SA2    L.DKLIS
          SX6    X2-1              ADJUST DKLIS FOR NULL ADDFILE FILE 
          SA6    A2 
          ZR     X1,CORADER4
          PRINT  P1ADDER3,2 
CORADER4  SA1    NEWPL             FATAL ERROR IF NEWPL REQUESTED 
          NZ     X1,CORADER3
          SA1    NFERROR           ELSE NON-FATAL 
          SX6    X1+B1
          SA6    A1 
          EQ     CORADEND 
          SPACE  1
CORADA    RJ     CORIDX            FILE LAST IDENT
          SA1    LISTTWO
          ZR     X1,CORADA02  IF L=2 NOT SPECIFIED
          PRINT  =8L,1
CORADA02  RJ     SCITEM      GET DECK NAME
          ZR     X7,CORADER5       ERROR IF CARD HAS NO NAME ON IT. 
          RJ     TLUDIR 
          ZR     X2,CORADA1        NOT DUPLICATE IDENT
          SA1    LISTONE
          ZR     X1,CORADA01
          RJ     PRINTERR 
          PRINT  P1ADDER4,4 
CORADA01  SA2    ERRORS 
          SA1    =7L.ERROR. 
          SX6    X2+B1
          BX7    X1 
          SA6    A2 
CORADA1   SA2    ADDCNT 
          SX6    X2+3              INCREASE ADDCNT BY 3 
          SA6    A2                STORE ADDCNT.
          SA2    L.DIRECT          FETCH DIRECTORY LENGTH.
          BX6    X2 
          SA7    IDNAM
          SA6    IDFLG
          SA1    NUMDECKS 
          SX6    X1+B1
          SA6    A1 
          ALLOC  DECKS,2
          SA1    IDNAM
          SA4    DECKFLG           FETCH DECKBIT.                        CP190
          MX6    0
          BX7    X1+X4             SET DECK BIT.                         CP190
          SA6    A4                CLEAR DECKFLG.                        CP190
          IX0    X2+X3
          SA7    X0-2 
          SA6    A7+B1
          SA2    FASTFLG
          ZR     X2,CORADA0 
          RJ     CRDKLIS
CORADA0   MX1    0
          ADDWRD COUNT,X1 
          SX6    X3-1              IDENT. STORE ITS ORDINAL IN
          SA6    POINTER           -POINTER-. 
          SX1    20B
          SA2    NEWAD                                                  0566   8
          SA3    A2+B1
          NZ     X2,CORADAA        IF OLD STYLE 
          MX3    0
 CORADAA  BX7    X2 
          LX6    X3 
          RJ     ENTDICT
          SA1    NEWAD                                                  0213  13
          NZ     X1,CORADA3 
          SA1    NEWAD2                                                 0213  15
          SX7    1                 TO ADDFILE FORM. 
          BX7    X1+X7
          LX7    54 
          SA7    A6-2 
          MX0    24 
          SA1    A7+B1             ELIMINATE POSSIBLE DECLARE ENTRY 
          BX7    -X0*X1 
          SA7    A1 
CORADA3   RJ     ENTTEXT           ENTER THE DECK CARD INTO FPAGE.
          SA2    CURCARD
          ZR     X2,CORADA3B  IF NOT A CONTROL CARD 
          SA1    LISTTWO
          EQ     CORADA3A 
  
CORADA3B  SA1    AFLIST 
          ZR     X1,CORADA4        IF NO ADDFILE LIST 
          SA1    LISTFOUR 
CORADA3A  ZR     X1,CORADA4  IF CARD IS NOT TO BE LISTED
          PRNTCARD
CORADA4   RJ     READCD            READ THE NEXT CARD.
          ZR     X1,CORADA4A       IF NOT EOR.
          SA1    INITFIL
          NZ     X1,CORADEND       IF EOR NOT ON ALT FILE FROM *READ. 
          SX7    -B1               ELSE RESET TO INDICATE MAIN *ADDFILE 
          SA7    A1                    FILE IS BEING READ.
          SA1    TCWBINC
          BX7    X1 
          SA7    CARD3
          EQ     CORADA4           CONTINUE READING.
  
CORADA4A  CLASIFY 
          ZR     X1,CORADA3 
          MX6    0
          SA6    DEFAULT           ZERO DEFAULT-ID EXPANSION FLAG 
          CCJUMP DECK,STDKBIT5                                           CP190
          CCJUMP COMDECK,CORADA 
          CCJUMP CALL,CORADA6 
          CCJUMP WEOR,CORADA3 
          CCJUMP TEXT,CORADA3 
          CCJUMP CWEOR,CORADA3
          CCJUMP ENDTEXT,CORADA3
          CCJUMP IF,CORADA3 
          CCJUMP ENDIF,CORADA3
          CCJUMP WIDTH,CORADA3
          CCJUMP COPY,CORADA5 
          SA2    ALTUNIT           IF THIS IS A REMOTE ADDFILE WE HAVE
          NZ     X2,CORADER8       AN ERROR.
          NG     X2,CORADER8       ALSO ERROR IF COPYING
          SA1    =10H ***** 
          RJ     CORADED           CLEAN UP FLAGS, ETC. 
          EQ     CORR3
          SPACE  1
CORADA5   SA1    ALTUNIT
          SX6    B1 
          SA6    INSFLG 
          PL     X1,CORCOPY        OK IF NOT COPYING
CORADER8  SA1    LISTONE
          ZR     X1,CORADER7
          RJ     PRINTERR 
          PRINT  P1ADDER5,4 
CORADER7  SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          EQ     CORADA4
  
CORADA6   SA1    FASTFLG
          ZR     X1,CORADA3  IF NOT Q-MODE PROCESS *CALL LIKE OTHER TEXT
          RJ     SCITEM 
          SA7    TCRDEC2
          BX1    X7 
          RJ     CRDKLIS     ADD CALLED COMDECK TO DKLIS
          NZ     X2,CORADA3  IF ALREADY IN DKLIS, CONTINUE PROCESSING 
*                            LIKE OTHER TEXT
  
*         BE SURE CALLED COMDECK APPEARS ON DKLIS 
*         PRIOR TO THE ADDFILED DECK. 
  
          SA3    F.DKLIS
          SA4    L.DKLIS
          MOVE   X4-1,X3,X3+B1
          SA1    F.DKLIS
          SA2    TCRDEC2
          SX7    B1 
          BX7    X7+X2
          SA7    X1 
          EQ     CORADA3     CONINUE PROCESSING 
  
CORADER5  SA1    LISTONE
          ZR     X1,CORADER7
          RJ     PRINTERR 
          PRINT  P1ADDER6,4 
          EQ     CORADER7 
          SPACE  1
          SPACE  1
          SPACE  1
CORADEND  SA1    =1H
          RJ     CORADED           CLEANUP FLAGS, ETC.
  
          ENV    ACT,(2,3),VER2 
          SA1    INPUT+FETIN
          SA2    A1+B1
          IX1    X1-X2
          NZ     X1,CORR5A         IF NOT EMPTY 
          SA1    INPUT
          SX6    EOR6000
          BX6    X6*X1
          NZ     X6,ECOR           IF EOR ON INPUT FILE 
VER2      ENDIF 
  
          EQ     CORR5A 
          SPACE  1
CORADOLD  RJ     TLUDIR            CHECK FOR VALID IDENT. 
          ZR     X2,CORUID         NOT KNOWN
          SA6    NEWAD             STORE IDENT                          0213  17
          RJ     GETCH             SKIP THE PERIOD
          SA2    CHAR 
          SX2    X2-1R
          ZR     X2,GETERR   IF SEQNUM IS BLANK, FLAG CARD WITH *ERROR* 
          RJ     SCNN              GET SEQUENCE NUMBER
          SA6    NEWAD2                                                 0213  19
          EQ     CORAD5 
          SPACE  2
*         CORADED - CLEAN UP VARIOUS FLAGS, REARRANGE DICT ENTRIES
*         IF NECESSARY
          SPACE  1
CORADED   PS
          MX6    0                 CLEAR ALL NECESSARY INDICATORS, ETC. 
          BX7    X1 
          SA6    ADDFLAG
          SA7    DNAME
          SA6    ALTUNIT
          SA6    INITFIL
          SA1    =1H
          BX6    X1 
          SA6    CARD3
          RJ     CORIDX 
          SB3    3
          SA1    F.DICT            IF OLD STYLE ADDFILE, ORDER OF ITS 
          SA2    L.DICT            DICT ENTRIES MUST BE REVERSED
          SA3    ADDCNT 
          SB2    X3                FINISHED IF ONLY ONE ADDFILE DICT
          EQ     B2,B3,CORADED     ENTRY
          SB4    X1                SET B4 TO BEG OF ADDFILE ENTRIES 
          SB5    X2+B4             IN DICT
          SB4    B5-B2             SET B5 TO FIRST WORD OF LAST 
          SB5    B5-B3             DICT ENTRY 
CORADED1  MOVE   B3,B4,DICHOLD
          MOVE   B3,B5,B4          MOVE ENTRIES INTO PROPER ORDER 
          MOVE   B3,DICHOLD,B5
          SB4    B4+B3
          SB5    B5-B3
          LT     B4,B5,CORADED1 
          EQ     CORADED           EXIT 
          SPACE  1
DICHOLD   BSSZ   3
          SPACE  1
          EJECT  4                                                      01257487
**        CORBE  PROCESS BEFORE, DELETE, INSERT, RESTORE DIRECTIVES     01254864
*                                                                       01254865
*         THE INSERT, BEFORE, DELETE, AND RESTORE CARDS GENERATE ENTRIES01254866
*         DICT. ENTRIES ARE MADE BY THE ROUTINES ENTDICT. PARAMETERS ARE01254867
*         PASSED TO ENTDICT ARE 1. THE ORDINAL OF THE IDENT OF THE      01254868
*         INSERTION POINT (OR BEGINNING OF DELETE/RESTORE RANGE) IN X7  01254869
*         AND CORRESPONDING SEQUENCE NUMBER IN X6. 29 A CODE IN X1 WHICH01254870
*         INDICATES THE TYPE OF ENTRY. THESE CODES ARE INSERT-20B,      01254871
*         BEFORE-10B, DELETE-2, RESTORE-6.                              01254872
*                                                                       01254873
*         CALLS  GETLIM, ENTDICT, GETCH, PRINT                          01254874
          SPACE  1
*     BEFORE  CARD
          SPACE  1
CORBE     RJ     GETLIM 
          ZR     X7,NOTYANK 
          SX1    10B
          RJ     ENTDICT
          SA6    INSFLG 
          EQ     CORR6
          SPACE  1
*      DELETE CARD
  
CORDE     SX6    2
          EQ     CORRE1 
          SPACE  1
*     INSERT CARD 
  
CORIN     RJ     GETLIM            GET INSERTION LIMITS 
          ZR     X7,NOTYANK 
          SX1    20B               ENTER INSERT CONTROL INTO DICTIONARY.
          RJ     ENTDICT
          SA6    INSFLG            ALLOW INSERTIONS 
          EQ     CORR6
          SPACE  1
*     RESTORE CARD
  
CORRE     SX6    6
CORRE1    SA6    TEMP              SAVE DELETE/RESTORE FLAG 
          RJ     GETLIM            GET FIRST LIMITS 
          SA7    ID1               SAVE THE FIRST LIMIT IN ID1 AND N1 
          SA6    A7+B1             AND STORE THE SAME LIMIT IN ID2 AND
          SA7    A6+B1             N2 IN CASE THERE ARE NO SECOND 
          SA6    A7+B1             LIMITS ON THIS CARD
          SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,CORRE2
          RJ     GETCH
          RJ     GETLIM 
          SA7    ID2
          SA6    A7+B1
          SA3    ID1                                                    0007   6
          SA4    ID2                                                    0007   7
          BX3    X3-X4                                                  0007   8
          NZ     X3,CORRE1A        JUMP IF NOT SAME IDENT               0007   9
          SA3    A3+B1                                                  0007  10
          SA4    A4+B1                                                  0007  11
          IX3    X4-X3                                                  0007  12
          NG     X3,CORRE3         NON-FATAL ERROR IF REVERSED NUMBERS  0007  13
CORRE1A   SA3    ID1                                                    0007  14
          SA4    A3+B1
          BX7    X3 
          LX6    X4 
CORRE2    SA1    TEMP 
          RJ     ENTDICT
          SA6    INSFLG 
          EQ     CORR6
          SPACE  1                                                      0007  16
CORRE3    SA1    LISTONE                                                0007  17
          ZR     X1,CORRE1A        JUMP IF LIST NO ERRORS               0007  18
          PRINT  P1ROSN,7          ISSUE MESSAGE                        0007  19
          SA1    NFERROR                                                0007  20
          SX6    X1+B1             INCREASE NON-FATAL ERROR COUNT       0007  21
          SA6    A1                                                     0007  22
          EQ     CORRE1A                                                0007  23
          EJECT  4                                                      01257489
**        CORCHG PROCESS CHANGE DIRECTIVE                               01254876
*                                                                       01254877
*         A CHANGE CARD CAUSES THE DIRECT ENTRY WHICH COR-              01254878
*         RESPONDS TO THE FIRST PARAMETER ON THE CARD TO                01254879
*         BE REPLACED WITH THE SECOND PARAMETER FROM THE                01254880
*         CARD.                                                         01254881
*                                                                       01254882
*         CALLS  SCITEM, TLUDIR, GETCH, PRINTERR, PRINT                 01254883
          SPACE  1
CORCHG    RJ     SCITEM            GET IDENTIFIER 
          ZR     X7,SELPERR1       NULL IDENT 
          RJ     TLUDIR            CHECK VALIDITY 
          ZR     X2,CORUID         UNKNOWN IDENT
          ZR     X6,NOTYANK 
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          NZ     X1,DECLERR 
A         ENDIF 
          SPACE  1
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SX7    A2 
S2LCM     ELSE
          BX7    X3 
S2LCM     ENDIF 
          SPACE  1
          SA7    TCRBIN            SAVE DIRECTORY ADDRESS 
          SA1    CHAR              FETCH DELIMITER
          SB7    X1-1R, 
          NZ     B7,CORER          ERROR IF NOT A COMMA 
          RJ     GETCH             SKIP COMMA 
          RJ     SCITEM 
          ZR     X7,SELPERR1       NULL IDENT 
          SA7    GETLIMT           SAVE NEW NAME
          RJ     TLUDIR            BE SURE IT IS UNIQUE 
          NZ     X2,DUPCHN         ERROR IF ALREADY IN USE
          SA4    GETLIMT
          SA1    IDNAM             CHECK WITH CURRENT IDENT 
          BX1    X4-X1
          AX1    6
          ZR   X1,DUPCHN
          SA1    TCRBIN            REPLACE IDENT NAME 
          MX0    54                NEW NAME 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X1 
          BX2    -X0*X2 
          BX6    X2+X4
          SA6    A2 
S2LCM     ELSE
          RX2    X1                READ LCM INTO X2.
          BX2    -X0*X2            GET RID OF OLD NAME. 
          BX6    X2+X4             PUT IN NEW NAME. 
          WX6    X1                WRITE NEW NAME TO DIRECT.
S2LCM     ENDIF 
          SPACE  1
          SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,CORR6          EXIT ON ANYTHING BUT COMMA 
          RJ     GETCH             SKIP COMMA 
          EQ     CORCHG            AND START OVER 
          SPACE  1
DUPCHN    SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1CHGER,5
          EQ     CORER1 
          EJECT  4                                                      01257491
**        CORCOPY  PROCESS COPY DIRECTIVE                               01254885
*                                                                       01254886
*         A COPY OPERATION REQUIRES A RANDOM OLDPL.  IF                 01254887
*         THE CURRENT OLDPL IS SEQUENTIAL, COPYOPL CREATES              01254888
*         AN INTERMEDIATE OLDPL NAMED UPDTTPL BEFORE ANY                01254889
*         FURTHER PROCESSING TAKES PLACE.  THE FIRST PA-                01254890
*         RAMETER ON THE COPY CARD MUST BE THE NAME OF                  01254891
*         THE DECK WITHIN WHICH THE CARDS TO BE COPYED                  01254892
*         ARE TO BE FOUND.  THIS DECK MUST CURRENTLY EXIST              01254893
*         ON THE OLDPL.  THE SECOND PARAMETER MUST BE                   01254894
*         THE IDENTIFIER OF THE FIRST CARD TO BE COPYED.                01254895
*         IF NO THIRD PARAMETER IS PRESENT THE SECOND PA-               01254896
*         RAMETER IS DUPLICATED AS THE END OF THE RANGE                 01254897
*         OF CARDS TO BE COPYED.  IF A FOURTH PARAMETER                 01254898
*         IS PRESENT, IT MUST BE THE NAME OF A FILE TO                  01254899
*         WHICH THE CARDS ARE TO BE WRITTEN.  SCRLOC IS                 01254900
*         SET NON-ZERO IF THE CARDS ARE TO BE WRITTEN.                  01254901
*         TO AN EXTERNAL FILE.  IF NO FILE NAME IS SPECI-               01254902
*         FIED, THE CARDS WILL BE PLACED ON UPDTEXT FOR                 01254903
*         INSERTION IN PASS 2.                                          01254904
*                                                                       01254905
*         CALLS  PRINT, COPYOPL, SCITEM, CHKDCKS, GETCH, GETCIM, ATTACH,01254906
*                PRINTERR, CPCLEAR, ROPL, CLASSIFY, UCARD, WDEC, CALLIO 01254907
          SPACE  1
CORCOPY   SA1    RANDOPL
          NZ     X1,CORCOPY1
          RJ     COPYOPL           CREATE RANDOM FILE IF NECESSARY
CORCOPY1  RJ     SCITEM            GET DECK NAME
          ZR     X7,CCPERR1  IF NO DECKNAME 
          RJ     CHKDCKS
          NZ     X0,CCPERR2  IF INVALID DECKNAME
          SA0    A2          HOLD ADDRESS OF  DNAME ENTRY IN DECKS
          RJ     TLUDIR      GET DIRECT ORDINAL OF DNAME/IDENT
          ZR     X2,CORCPY1A IF DNAME NOT ALSO AN IDENT 
          SA6    TGETLIMT    STORE DNAME/IDENT ORDINAL
          SA6    TGETLIMT+1  STORE DNAME/IDENT ORDINAL
CORCPY1A  SX6    A0+B1       INDEX ADDRESS
          SA1    CHAR 
          SA6    CHBTAB 
          SB7    X1-1R, 
          NZ     B7,CCPERR3  IF WRONG DELIMITER 
          RJ     GETCH             SKIP THE COMMA 
          RJ     GETLIM            GET THE FIRST IDENT AND SEQNUM 
          SA7    ID1               STORE IDENT
          SA6    A7+B1             AND SEQUENCE NUMBER
          SA7    A6+B1             STORE AS END VALUES FOR DEFAULT
          SA6    A7+B1
          SA1    CHAR 
          SX6    B1 
          SB7    X1-1R
          SA6    WRNPL             SET FLAG 
          NE     B7,B1,CORCPY11    TRY FOR DEFAULT THIRD PARAMETER
          RJ     GETCH             SKIP THE COMMA 
          RJ     GETLIM            GET THE SECOND IDENT AND NUMBER
          SA7    ID2               STORE THE IDENT
          SA6    A7+B1             AND SEQUENCE NUMBER
          SA1    CHAR 
          SB7    X1-1R
CORCPY11  MX7    0
          ZR     B7,CORCOPY2       NO MORE PARAMETERS 
          NE     B7,B1,CCPERR3  IF WRONG DELIMITER
          SA2    ALTUNIT           IT IS ILLEGAL TO HAVE A COPY TO
          ZR     X2,CORCOPY4       A FILE WHILE READING A REMOTE FILE 
          SA1    LISTTWO
          ZR     X1,CORCPY12  IF L=2 NOT SPECIFIED
          PRNTCARD
CORCPY12  SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1CPYER4,9 
          EQ     CORER1 
          SPACE  1                                                      1340  10
CORCOPY2  SA1    IDFLG
          NZ     X1,CORCPY2A  IF PART OF A CORRECTION SET 
          SA1    NEWPL
          NZ     X1,CORER    IF NEWPL IS BEING WRITTEN
          SA1    =7L.NO.ID. 
          BX6    X1 
          SA6    IDNAM
          SA1    L.DIRECT 
          MX7    0
          BX6    X1 
          SA7    INSFLG 
          SA6    IDFLG
          MX1    0
          ADDWRD COUNT,X1 
          SX6    X3-1 
          SA6    POINTER
          SA1    LISTONE
          ZR     X1,CCPERR3  IF L=1 NOT SPECIFIED 
          PRINT  P1DFIDT,9
          SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     CCPERR3
  
CORCPY2A  SA1    INSFLG 
          ZR     X1,CCPERR3  IF INSERTS ARE NOT ALLOWED 
          EQ     CORCOPYB    CONTINUE PROCESSING THE COPY CARD
          SPACE  1
CORCOPY4  BSS    0
          RJ     GETCH             SKIP THE COMMA 
          RJ     ATTACH            ATTACH THE FILE
          NZ     X6,CORR5A
          SA1    CHAR 
          SX6    X1-1R,            CHECK FOR MORE PARAMETERS
          SX7    -B1
          NZ     X6,CORCOPYB       NO, USE DEFAULT
          RJ     GETCH             SKIP COMMA 
          RJ     SCNN              GET (,6) OR (,8) 
          SX7    X6-7              6->-1, 8->+1 
          AX6    X7,B1
          NZ     X6,CORER          NOT 6 OR 8 
          NZ     X7,CORCOPYB
          EQ     CORER
CORCOPYB  SA7    SCRLOC            SAVE FLAG                            1340   8
          SA1    LISTTWO
          ZR     X1,CORCOPYC  IF L=2 NOT SPECIFIED
          PRNTCARD
 CORCOPYC CLEAR  OLDPL,READ 
          SA1    CHBTAB            FETCH INDEX ADDRESS
          SA1    X1 
          BX6    X1 
          ZR     X1,CMVERR         DECK NOT ON LIB
          SA6    OLDPL+6           SET RANDOM READ
CORCOPY3  RJ     ROPL              READ A CARD
          NZ     X1,CCPERR         END OF DECK BEFORE TERMINAL ADDRESS
          MX0    44 
          SA2    CHBTAB 
          SA1    ID1               SEARCH FOR FIRST 
          BX2    -X0*X2            CARD IN RANGE
          IX2    X1-X2             OF COPY
          NZ     X2,CORCOPY3
          SA1    SEQNUM 
          SA2    N1 
          IX2    X1-X2
          NZ     X2,CORCOPY3
          SA1    =10H COPY
          SA2    ALTUNIT
          BX6    X1                MARK CARDS COPIED
          BX7    -X2
          SA6    CARD3
          SA7    ALTUNIT
          SA1    =1H
          BX6    X1 
          SA6    DNAME
CORCOPY5  SA1    CARDSTAT 
          PL     X1,CORCOPY6       SKIP INACTIVE CARDS
          SB4    SPARLIST 
          RJ     CLASSIFY 
          SA6    WRNPL             CLEAR FLAG 
          SA1    SCRLOC 
          ZR     X1,READCD7        EXIT TO NORMAL LOOP
          PL     X1,CORCPY5A
          RJ     XCARD             6-BIT COPY 
          WRITEC READFIL,CARD 
          EQ     CORCOPYP 
 CORCPY5A RJ     XCARD8            8-BIT COPY 
          WRITEC READFIL,CARD8
          SPACE  1
CORCOPYP  SA1    CURCARD
          ZR     X1,CORCOPY6
          SA2    =1H
          BX6    X2 
          SA6    DNAME
CORCOPY6  SA1    CHBTAB 
          MX0    44 
          SA2    ID2               CHECK FOR END OF RANGE 
          BX1    -X0*X1 
          IX1    X1-X2
          NZ     X1,CORCOPY7
          SA1    SEQNUM 
          SA2    N2 
          IX1    X1-X2
          ZR     X1,CORCOPY9       END OF RANGE REACHED 
CORCOPY7  RJ     ROPL 
          ZR     X1,CORCOPY5       CHECK NEXT CARD
          SA1    LISTONE
          ZR     X1,CORCOPY8
          PRINT  P1CPYER1,10
CORCOPY8  SA1    NFERROR           INCREMENT NON-FATAL ERROR COUNT
          SX6    X1+B1
          SA6    A1 
CORCOPYA  SA1    SCRLOC 
          ZR     X1,CORCPY10       NO REMOTE FILE INVOLVED
          WRITER READFIL
          SPACE  1
  
          ENV    ACT,(11),VER2
          CLOSE  READFIL
          CLEAR  READFIL                                                0007  40
          MX6    0                                                      0007  41
          SA6    READFIL                                                0007  42
VER2      ENDIF 
 CORCPY10 CLEAR  OLDPL,READ 
          SA1    =1H
          SA2    F.DECKS
          BX6    X1 
          SA2    X2+B1
          SA6    CARD3
          BX7    X2                SET UP FOR YANK DECK 
          SA7    OLDPL+6
          SA1    ALTUNIT
          BX6    -X1
          SA6    A1 
          SA1    ADDFLAG
          NZ     X1,CORADA4 
          EQ     CORR5A 
          SPACE  1
CORCOPY9  SA1    WRNPL
          ZR     X1,CORCOPYA       CARDS WERE COPIED
          SA1    LISTONE
          ZR     X1,CORCOPY8
          PRINT  P1CPYER2,8 
          EQ     CORCOPY8 
          SPACE  1
CCPERR    SA1    LISTONE
          ZR     X1,CORCOPY8
          PRINT  P1CPYER3,8 
          EQ     CORCOPY8 
  
CCPERR1   SA1    LISTTWO
          ZR     X1,SELPERR1  IF L=2 NOT SPECIFIED
          RJ     PRINTERR 
          EQ     SELPERR1 
  
CCPERR2   SA1    LISTTWO
          ZR     X1,CORADER1  IF L=2 NOT SPECIFIED
          SA6    PRTEMP      SAVE DECK NAME ACROSS PRINT
          RJ     PRINTERR 
          SA1    PRTEMP      RESTORE DECK NAME
          BX6    X1 
          EQ     CORADER1 
  
CCPERR3   SA1    LISTTWO
          ZR     X1,CORER    IF L=2 NOT SPECIFIED 
          RJ     PRINTERR 
          EQ     CORER
          EJECT  4                                                      01257493
**        CORID  PROCESS IDENT DIRECTIVE                                01254909
*                                                                       01254910
*         AN IDENT CARD IS PLACED IN THE TITLE AREA SO THAT             01254911
*         IT WILL APPEAR IN THE TITLE OF ALL PAGES ASSO-                01254912
*         CIATED WITH IT.  A PAGE EJECT IS ALSO GENERATED.              01254913
*         IF THE NAME ON THE IDENT CARD IS A DUPLICATE OF               01254914
*         AN IDENT ALREADY IN THE DIRECTORY, IDCHANGE IS                01254915
*         CALLED TO CREATE A UNIQUE ENTRY IF SUCH AN OPER-              01254916
*         ATION IS ALLOWED.  THE NEW ORDINAL IS EQUAL TO                01254917
*         THE CURRENT LENGTH OF THE DIRECTORY.  A WORD IS               01254918
*         ADDED TO COUNT WHICH WILL BE USED TO HOLD THE                 01254919
*         SEQUENCE NUMBER TO BE GIVEN TO CARDS BELONGING                01254920
*         TO THIS IDENT.  THE ORDINAL WITHIN COUNT OF THIS              01254921
*         WORD IS KEPT IN POINTER AND WILL BE ADDED TO THE              01254922
*         DICT ENTRY FOR EACH OPERATION WITHIN THIS IDENT.              01254923
*         IF THIS IS SO, THE ALTERED NAME IS PUT INTO THE               01254924
*         TITLE AND AN APPROPRIATE MESSAGE PRINTED.                     01254925
*                                                                       01254926
*         CALLS  CORIDX, SCITEM, CHECKATT, TLUDIR, IDCHANGE, ADDWORD,   01254927
*                PRINT                                                  01254928
          SPACE  1
CORID     RJ     CORIDX            FILE AWAY OLD ID 
          SX6    EJECT
          SA6    LPCNT
          RJ     SCITEM            FETCH IDENT NAME 
          ZR     X7,SELPERR1       NULL IDENT 
          SA7    IDNAM             SAVE FOR LATER TABLE ENTRY 
          SA1    =10H IDENT 
          SA6    TITLE+4
          SX7    B0 
          SA7    SKIPID            INITIALIZE SKIP COUNTER
          BX7    X1 
          SA1    =10H 
          SA7    A6-B1
          BX6    X1 
          SA6    A6+B1
          SA6    A6+B1
          RJ     CHECKATT 
          SA1    SKIPID 
          NZ     X1,OMITIT         SKIP IDENT IF FLAG ON. 
 CORRET   SA1    IDNAM             FETCH NAME TO CHANGE 
          BX7    X1 
          SA0    B1 
          SB5    54B
          RJ     TLUDIR            LOOK UP NAME IN DICTIONARY 
          ZR     X2,CORID1
          SA1    NEWPL                                                  1606   5
          NZ  X1,IDCHANG0                                               1606   6
          RJ     IDCHANGE 
          EQ     CORRET 
  
OMITIT    SA1    TITLE+4           FETCH IDENT NAME.
          MX2    18                CREATE MASK. 
          BX3    X2*X1             GET 3 CHARACTERS.
          LX3    18                PUT 3 CHARS INTO LOWER BITS. 
          SA4    MESG8             FETCH FIRST WORD OF MESSAGE. 
          LX2    18                SHIFT MASK TO LOWER BITS.
          BX4    -X2*X4            AND OFF LOWER 3 CHARACTERS.
          BX7    X4+X3             PUT 3 CHARS OF IDENT NAME INTO MSG.
          SA7    A4                STORE IT.
          LX1    18                SHIFT IDENT NAME 3 CHARACTERS. 
          BX1    -X2*X1            ISOLATE LAST 6 CHARS OF NAME.
          SA2    =3RWIL            CREATE 2ND WORD
          BX6    X2+X1                             AND
          SA6    A4+B1                                 STORE IT.
          MESSAGE MESG8 
          EQ     CORR5A 
          SPACE  1
CORID1    SA2    L.DIRECT          THE NEW ORDINAL IS THE PRESENT LENGTH
          BX6    X2                OF THE DIRECTORY. KEEP THIS VALUE IN 
          SA6    IDFLG             -IDFLG-. ADD A ZERO WORD TO -COUNT-. 
          SA1    SEQBIAS
          ADDWRD COUNT,X1          THIS WILL BE USED TO COUNT THE SEQ.
          SX6    X3-1              NUMBER OF THIS IDENT DURING PASS2. 
          SA1    CHG+3             PUT THE INDEX WITHIN THE TABLE OF
          SA6    POINTER           THIS WORD IN -POINTER- SO THAT IT
          ZR     X1,CORR6          CAN BE ADDED TO DICTIONARY ENTRIES.
          SA2    =10H IDENT        TOOK PLACE WE MUST RECONSTRUCT THE 
          BX6    X1                TITLE AND THE CARD AND PRINT THE 
          LX7    X2                APPROPRIATE MESSAGE. 
          SA6    TITLE+4
          SA7    A6-B1
          MX0    6
          SA3    FLGCHAR
          BX7    -X0*X7 
          LX3    54 
          BX7    X7+X3
          SA6    CARD+1 
          SA7    A6-B1
          MX7    0                 END OF LINE
          SA7    A6+B1
          LX6    54 
          SA6    A1 
          SA1     LISTONE 
          ZR     X1,CORID2         NO LIST ERRORS 
          SA1    NFERROR
          SX6    X1+B1
          SA6    A1                INCREMENT NON-FATAL ERROR COUNT
          PRINT  CHG,5
CORID2    MX6    0
          SA6    CHG+3
          EQ     CORR6
          SPACE  1
CHG       DIS    3,0***DUPLICATE IDENT CHANGED TO 
          DATA   0
          DATA   4L *** 
          SPACE  4
**        CORIDX  ADDS IDENT TO DIRECTORY                               01254930
*                                                                       01254931
*         IDFLG HOLDS THE ORDINAL OF THE CURRENTLY ACTIVE               01254932
*         IDENT, IF ONE EXISTS.  IDNAM HOLDS THE IDENT NAME.            01254933
*         CORIDX ADDS THIS IDENT TO THE DIRECTORY AND DE-               01254934
*         ACTIVATES IT BY SETTING BOTH CELLS TO ZERO.                   01254935
*         INSFLG IS ALSO SET TO ZERO TO INDICATE THAT TEXT              01254936
*         CARDS ARE NOW ILLEGAL UNTIL A NEW POSITION CARD               01254937
*         IS PROCESSED.                                                 01254938
*                                                                       01254939
*         CALLS  ADDWORD                                                01254940
          SPACE  1
CORIDX    PS
          SA2    IDFLG             IDFLG CONTAINS THE ORDINAL OF THE
          ZR     X2,CORIDX         IDENT IF ONE IS ACTIVE. IDNAM
          MX6    0                 CONTAINS THE ZERO-FILL IDENT NAME. 
          SA1    IDNAM
          SA6    A2 
          SA6    A1 
          SA6    INSFLG 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          EQ     CORIDX 
          SPACE  4
**        CORMOVE  PROCESS MOVE DIRECTIVE                               01254942
*                                                                       01254943
*         CORMOVE FIRST CHECKS FOR A RANDOM OLDPL AND CALLS             01254944
*         COPYOPL TO PRODUCE ONE IF ONE DOES NOT ALREADY                01254945
*         EXIST.  MOVES ARE THEN PROCESSED BY MOVING THE                01254946
*         DECKS ENTRIES, SINCE A NEWPL WILL BE PRODUCED                 01254947
*         WITH DECKS PHYSICALLY POSITIONED IN THE ORDER                 01254948
*         OF ENTRIES IN DECKS.                                          01254949
*                                                                       01254950
*         CALLS  COPLOPL, SCITEM, CHKDCKS, CHECKDCL, GETCH, MOVEIT,     01254951
*                PRINTERR, PRINT                                        01254952
          SPACE  1
CORMOVE   SA1    RANDOPL
          NZ     X1,CORMOVE1
          RJ     COPYOPL
CORMOVE1  RJ     SCITEM 
          ZR     X7,SELPERR1
          RJ     CHKDCKS           BESURE ITS A DECK
          NZ     X0,CMVERR
          EQ     B2,B6,NOTYANK
          SPACE  1
          SPACE  1
          SA1    A2+B1
          BX6    X2                STORE TEMPORARILY DECK 
          ZR     X1,CMVERR
          LX7    X1                AND POSSIBLE INDEX TO
          SA6    GETLIMT           BO MOVED 
          SA7    A6+B1
          SX6    A2 
          SA6    MOVEFLAG          SAVE FIRST DECK ADDRESS
          SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,CORER          SYNTAX ERROR 
          RJ     GETCH             PASS THE COMMA 
          RJ     SCITEM            GET SECOND IDENT 
          ZR     X7,SELPERR1
          RJ     CHKDCKS
          NZ     X0,CMVERR
          SX6    A2 
          SA2    A2+B1
          ZR     X2,CMVERR
          SA6    TCWDEC            SAVE ADDRESS TO PUT DECK 
          SA3    MOVEFLAG 
          IX1    X6-X3             NOW DECIDE WHAT MUST BE MOVED TO 
          BX0    -X1               MAKE ROOM FOR THE MOVED DECK, AND
          NG     X1,MVDOWN         WHAT DIRECTION.
          MOVE   X1,X3+2,X3 
          SA1    TCWDEC 
          EQ     MVCONT 
          SPACE  4
CMVERR    SA1    LISTONE
          ZR     X1,CMVERR1 
          RJ     PRINTERR 
          PRINT  P1MVERR,8
CMVERR1   SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     CORR5A 
          SPACE  4
MVDOWN    MOVE   X0-2,X6+2,X6+4 
          SA1    TCWDEC 
          SX1    X1+2 
MVCONT    SA2    GETLIMT
          SA3    A2+B1             FETCH THE ENTRY WHICH WE ARE 
          BX6    X2                MOVEING AND STORE IT AT THE ADDRESS
          LX7    X3                SAVED IN -WDEC- (OR -WDEC+2- ).
          SA6    X1 
          SA7    A6+B1
          SA1    CHAR 
          SB7    X1-1R
          NE     B7,B1,CORR6
          RJ     GETCH             PASS COMMA AND 
          EQ     CORMOVE1          LOOP IF MORE 
          SPACE  4
**        CORPD  PROCESS PURDECK DIRECTIVE                              01254954
*                                                                       01254955
*         DECKS ARE MARKED FOR PURGING BY SETTING BIT                   01254956
*         0 OF THE DECKS ENTRY ON.  IF THE RANGE FORM OF                01254957
*         THE CARD IS BEING PROCESSED (ENTRIES SEPARATED                01254958
*         BY A PERIOD), THE FIRST ENTRY MUST OCCUR IN THE               01254959
*         DECK LIST DECKS BEFORE THE SECOND ENTRY.                      01254960
*                                                                       01254961
*         CALLS  PRINT, SCITEM, CHKDCKS, CHECKDCL, GETCH                01254962
          SPACE  1
CORPD     RJ     SCITEM 
          ZR     X7,SELPERR1
          RJ     CHKDCKS
          NZ     X0,CORADER1
          EQ   B2,B6,NOTYANK       ERROR IF YANK$$$                     0640   8
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORPD6
          RJ     CHECKDCL 
CORPD6    BSS    0
A         ENDIF 
          SPACE  1
          SX7    A2                SAVE ADDRESS OF ENTRY. 
          SX0    B1 
          SA7    TCRBIN 
          BX6    X2+X0             ADD PURGE BIT
          SA6    A2 
          SA1    CHAR 
          SB2    B1+B1
          SB7    X1-1R
          ZR     B7,CORR6          QUIT AT END. 
          EQ     B7,B1,CORPD2      JUMP TO PROCESS LIST FORM. 
          NE     B7,B2,CORER       ERROR IF NOT PERIOD. 
          RJ     GETCH             SKIP THE PERIOD. 
          RJ     SCITEM            GET SECOND NAME. 
          ZR     X7,SELPERR1       NO NAME. 
          RJ     CHKDCKS
          NZ     X0,CORADER1
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORPD7
          RJ     CHECKDCL 
CORPD7    BSS    0
A         ENDIF 
          SPACE  1
          SA1    TCRBIN            FIRST DECK INDEX 
          SX3    A2 
          IX7    X3-X1
          NG     X7,BADORDER
          SA4    X1 
          SX0    B1 
CORPD3    ZR     X7,CORR6 
          SX7    X7-2              PROCESS INTERVAL FORM. 
          SA4    A4+2 
          BX6    X4+X0
          SA6    A4 
          EQ     CORPD3 
          SPACE  1
CORPD2    RJ     GETCH
          EQ     CORPD
          EJECT  4                                                      01257495
**        CORPU  PROCESS PURGE DIRECTIVE                                01254964
*                                                                       01254965
*         IDENTS ARE MARKED FOR PURGING BY SETTING BIT                  01254966
*         4 OF THE DIRECTORY ENTRY ON.  THREE FORMS OF                  01254967
*         THE CARD ARE RECOGNIZED.  1. IDENT NAMES SE-                  01254968
*         PARATED BY COMMAS; 2.  AN IDENT NAME FOLLOWED                 01254969
*         BY A COMMA AND AN ASTERISK; 3.  TWO IDENT NAMES               01254970
*         SEPARATED BY A PERIOD.  IN THE FIRST TYPE IN-                 01254971
*         DIVIDUAL IDENTS ARE MARKED.  IN THE SECOND ALL                01254972
*         IDENTS WHICH APPEAR IN THE DIRECTORY AFTER THE                01254973
*         FIRST IDENT MENTIONED ON THE PURGE CARD ARE                   01254974
*         PURGED.  IN THE THIRD FORM THE INCLUSIVE RANGE                01254975
*         OF IDENTS BOUNDED BY THE TWO NAMED IDENTS ARE                 01254976
*         PURGED.  IF THE IDENT BEING PURGED IS ASSOCIATED WITH A DECK
*         WHICH ORIGINATED FROM A *DECK, THEN ALSO SET PURDECK BIT IN 
*         THE ENTRY FOR THAT DECK IN THE DECKS TABLE. 
*                                                                       01254978
*         CALLS  PRINT, SCITEM, TLUDIR, CORLUIDA, GETCH                 01254979
          SPACE  1
CORPU     BSS    0
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          NZ     X1,DECLERR 
A         ENDIF 
          SPACE  1
          RJ     SCITEM      FETCH IDENT NAME 
CORPU0    RJ     TLUDIR      LOOK UP IDENT
          NZ     X2,CORPU5         ERROR IF NOT FOUND.
          RJ     CORUIDA
          SA1    ERRORS 
          SX6    X1+B1             INCREMENT ERROR COUNT
          SA6    A1 
          MX6    0           IN CASE OF A RANGE,
          SA6    TEMP1       FLAG BAD IDENT 
          EQ     CORPU3 
          SPACE  1
CORPU5    ZR     X6,NOTYANK        ERROR IF YANK DECK.
          SA6    TEMP1             STORE ORDINAL IN TEMP1.
          SX1    20B               NOW ADD PURGE BIT
          BX6    X2+X1             TO DIRECTORY ENTRY.
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2                PLACE UPDATED ENTRY IN DIRECTORY.
          SX6    A2+B1             SAVE NEXT ADDRESS IN RBIN IN CASE
S2LCM     ELSE
          WX6    X3                WRITE X6 TO LCM LOC X3.
          SX6    X3+B1             PUT NEXT ADDRESS INTO X6.
S2LCM     ENDIF 
          SPACE  1
          SA6    TCRBIN            OF INTERVAL FORM 
          RJ     CHKDCKS           CHECK IF IDENT ASSOCIATED WITH DECK. 
          NZ     X0,CORPU3         IF NOT IN DECKS. 
          SX1    B1 
          BX6    X2+X1             IF SO SET PURDECK BIT IN DECK ENTRY. 
          SA6    A2                PLACE UPDATED ENTRY IN DECKS.
CORPU3    SA1    CHAR              NOW CHECK THE NEXT CHARACTER ON THE
          SB2    B1+B1
          SB7    X1-1R             CARD. IF IT IS A BLANK WE ARE THROUGH
          ZR     B7,CORR6    IF IT IS A PERIOD JUMP TO CORPU2 TO
          EQ     B7,B2,CORPU2      PROCESS THE INTERVAL. IF IT IS NOT 
          NE   B7,B1,CORR6         A PERIOD OR COMMA  WE ARE THROUGH    0009  12
          RJ     GETCH             SKIP THE COMMA.
          RJ     SCITEM      FETCH IDENT NAME 
          SA2    =1L* 
          IX2    X7-X2
          NZ     X2,CORPU0   IF NOT AN ASTERISK, CONTINUE PROCESSING
          SA4    L.DIRECT          NEXT NAME IN LIST. 
          SX6    X4-1        THE END INDEX IS L.DIRECT-1
          EQ     CORPU7 
  
CORPU1    SA3    TEMP1             FETCH TEMP1(THE LAST ORDINAL DONE),
          SA2    TCRBIN            RBIN(THE ADDRESS OF THE NEXT TO BE 
          SA4    TCWBIN3           DONE), AND WBIN(THE END ORDINAL) 
          IX7    X4-X3             IF THE LAST ORDINAL DONE IS EQUAL TO 
          SX6    X3+B1             THE END ORDINAL WE ARE THROUGH WITH
          ZR     X7,CORPU3         THE RANGE. 
          SX5    20B               ADD THE PURGE BIT
          SA6    A3                AND INCREMENT THE
          SX7    X2+B1             ADDRESS AND ORDINAL. 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA3    X2                NEXT IDENT TO BE PURGED. 
          SA7    A2                SAVE NEXT ADDRESS IN RBIN. 
          BX6    X5+X3             ADD PURGE BIT. 
          SA6    A3                PLACE UPDATED ENTRY IN DIRECTORY.
S2LCM     ELSE
          RX3    X2                NEXT IDENT TO BE PURGED. 
          SA7    A2                SAVE NEXT ADDRESS IN RBIN. 
          BX6    X5+X3             ADD PURGE BIT. 
          WX6    X2                PLACE UPDATED ENTRY IN DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
          MX5    54 
          BX7    X5*X6             ZERO OUT LOWER BITS OF DIRECT ENTRY. 
          RJ     CHKDCKS           CHECK IF IDENT ASSOCIATED WITH DECK. 
          NZ     X0,CORPU1         IF NOT IN DECKS. 
          SX3    B1 
          BX6    X2+X3             IF IN DECKS, SET PURDECK BIT.
          SA6    A2                PLACE UPDATED ENTRY IN DECKS.
          EQ     CORPU1 
          SPACE  1
CORPU2    RJ     GETCH             HERE WE ARE PROCESSING THE INTERVAL
          RJ     SCITEM            FORM. SKIP THE PERIOD AND FETCH THE
          ZR     X7,SELPERR1       NEXT IDENT NAME. 
          RJ     TLUDIR 
          NZ     X2,CORPU7         ERROR IF NOT FOUND.
          EQ   CORUID                                                   0615  14
          SPACE  1
CORPU7    SA4    TEMP1             FETCH FIRST ORDINAL. 
          ZR     X4,CORR5A   BEGINNING OF RANGE WAS BAD, DONE 
          IX2    X6-X4             COMPARE WITH END.
          NG     X2,BADORDER       ERROR IF OUT-OF-ORDER. 
          SA6    TCWBIN3
          EQ       CORPU1 
          SPACE  1
**        CORPM  PROCESS PULLMOD DIRECTIVES                             01254981
*                                                                       01254982
*         IDENT NAMES ON PULLMOD CARDS ARE CHECKED FOR                  01254983
*         VALIDITY AND INSERTED IN THE TABLE PMODS.                     01254984
*                                                                       01254985
*         CALLS  SCITEM, TLUDIR, CORUIDA, GETCH, ADDWORD                01254986
G         IF     DEF,PMODKEY
          SPACE  4
CORPM     RJ     SCITEM            GET MOD NAME 
          ZR     X7,CORER          NO NAME
          RJ     TLUDIR            LOOK UP IN DIRECTORY 
          NZ     X2,CORPM1         FOUND IT 
          RJ     CORUIDA           ERROR--UNKNOWN IDENT 
          SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
CORPM2    SA1    CHAR 
          SB7    X1-1R,            LOOP ON COMMA
          NZ     B7,CORR6 
          RJ     GETCH             SKIP COMMA 
          EQ     CORPM
          SPACE  1
CORPM1    BX1    X6 
          ADDWRD PMODS,X1 
          EQ     CORPM2 
G         ENDIF 
          SPACE  4                                                      01254988
**        CORR4A  PROCESS DECK AND COMDECK DIRECTIVES                   01254989
*                                                                       01254990
*         DECK NAMES ON DECK OR COMDECK CARDS ARE ADDED                 01254991
*         TO THE TABLE DECKS.                                           01254992
*                                                                       01254993
*         CALLS  SCITEM, CHECKDCL, ADDWORD                              01254994
          SPACE  1
CORR4A    RJ     SCITEM            GET NAME 
          ZR     X7,SELPERR1
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORR4AB 
          RJ     CHECKDCL 
CORR4AB   BSS    0
A         ENDIF 
          SPACE  1
          SA2    DECKFLG           SET DECK BIT INTO WORD CONTAINING     CP190
          BX1    X7+X2             DECK NAME.                            CP190
          MX6    0                 CLEAR                                 CP190
          SA6    A2                      DECKFLG.                        CP190
          ADDWRD DECKS,X1 
          MX1    0
          ADDWRD DECKS,X1 
          SA1    NUMDECKS 
          SX6    X1+B1
          SA6    A1 
          EQ     CORR3B 
          SPACE  5                                                      0062  11
**        CORCA  PROCESS CALL DIRECTIVE                                 01254996
*                                                                       01254997
*         ENTERS COMDECK NAME FROM CALL DIRECTIVE IN DKLIS SO IT WILL   01254998
*         BE PROCESSED                                                  01254999
*                                                                       01255000
*         CALLS  SCITEM, CRDKLIS                                        01255001
          SPACE  1                                                      0062  13
CORCA     RJ     SCITEM                                                 0062  14
          ZR     X7,SELPERR1       ENTER COMDECK NAME IN                0062  15
          MX0    54                DKLIS SO THAT IT WILL BE             0062  16
          BX1    X0*X7             PROCESSED                            0062  17
          RJ     CRDKLIS                                                0062  18
          EQ     CORR3B                                                 0062  19
          SPACE  4
**        CORSELP  PROCESS SELPURGE DIRECTIVE                           01255003
*                                                                       01255004
*         THE SELPURGE CARD CONTAINS ENTRIES WHICH CON-                 01255005
*         SIST OF A DECK NAME, A PERIOD, AND AN IDENT                   01255006
*         NAME.  AFTER THE NAMES ARE CHECKED FOR VALIDITY,              01255007
*         A TWO WORD ENTRY IS MADE IN THE PURYAN TABLE.                 01255008
*                                                                       01255009
*         CALLS  SCITEM, CHKDCKS, CHECKDCL, GETCH, PRINT, PRINTERR,     01255010
*                ADDWORD                                                01255011
          SPACE  1
CORSELP   RJ     SCITEM            GET IDENTIFIER 
          ZR     X7,SELPERR1       NULL IDENT 
          SA7    TCRBIN            SAVE DECK NAME 
          RJ     CHKDCKS           CHECK VALID DECK NAME
          NZ     X0,CORADER1
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORSELP1       JUMP IF NOT IN DECLARE MODE
          RJ     CHECKDCL 
CORSELP1  BSS    0
A         ENDIF 
          SPACE  1
          SA1    CHAR 
          SB7    X1-1R. 
          NZ     B7,CORER          ERROR IF DELIMITER NOT PERIOD
          RJ     GETCH             SKIP THE PERIOD
          RJ     SCITEM            GET SECOND IDENT 
          ZR     X7,SELPERR1       NULL IDENT 
          RJ     TLUDIR            CHECK VALIDITY 
          ZR     X2,CORUID         COMPLAIN IF UNKNOWN
          SX3    B1                TABLE FLAG BIT 
          LX3    22 
          BX1    X3+X6
          ADDWRD PURYAN,X1
          SA1    TCRBIN            MAKE PURYAN
          ADDWRD PURYAN,X1         TABLE ENTRY
          SA1    CHAR 
          SB7    X1-1R
          ZR     B7,CORR6 
          NE     B7,B1,CORER
          RJ     GETCH             SKIP THE COMMA AND 
          EQ     CORSELP           GO BACK FOR MORE 
          SPACE  1
SELPERR1  SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1SPERR,2
          EQ     CORER1 
          EJECT  4                                                      01257497
**        CORSEQ  PROCESS SEQUENCE DIRECTIVE                            01255013
*                                                                       01255014
*         RESEQUENCING (SEQUENCE CARD) TAKES A DECK AND                 01255015
*         SEQUENCES ALL ACTIVE CARDS IN THE DECK USING                  01255016
*         THE IDENT NAME WHICH IS THE SAME AS THE NAME OF               01255017
*         THE DECK BEING SEQUENCED.  IF THE SPECIFIED DECK              01255018
*         NAME IS NOT ALSO AN IDENT NAME, A NEW ENTRY IS                01255019
*         MADE INTO THE DIRECTORY CONTAINING THIS NAME.                 01255020
*         BIT 3 OF THE DIRECTORY ENTRY IS TURNED ON FOR                 01255021
*         EACH IDENT WHICH WILL BE USED FOR RESEQUENCING                01255022
*         A DECK.                                                       01255023
*                                                                       01255024
*         CALLS  GETCH, CORIDX, SCITEM, CHKDCKS, CHECKDCL, TLUDIR,      01255025
*                ADDWORD                                                01255026
          SPACE  1
CORSEQ1   RJ     GETCH             SKIP THE DELIMITER 
CORSEQ    RJ     CORIDX 
          RJ     SCITEM 
          ZR     X7,SELPERR1       NULL IDENT 
          RJ     CHKDCKS
          NZ     X0,CORADER1
          EQ     B2,B6,NOTYANK     ERROR IF YANK$$$ 
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORSEQ2 
          RJ     CHECKDCL 
CORSEQ2   BSS    0
A         ENDIF 
          SPACE  1
          SX6    B6-2              SAVE DECK LIST ORDINAL FROM
          SA6    SEQFLAG           CALL TO CHKDCKS
          RJ     TLUDIR 
          NZ     X2,IDOK           NAME IS AN IDENT.
          MX1    1
          LX1    4
          BX1    X1+X7
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          EQ     FINISHT
          SPACE  1
IDOK      BSS    0
          ZR     X6,NOTYANK 
          MX1    1
          LX1    4                 SET SEQUENCE BIT 
          BX6    X1+X2             (BIT 3) IN 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2                DIRECTORY
S2LCM     ELSE
          WX6    X3 
S2LCM     ENDIF 
          SPACE  1
FINISHT   BSS    0
          SA1    CHAR 
          SB2    B1+B1
          SB7    X1-1R
          ZR     B7,CORR6          EXIT IF NO MORE TO PROCESS 
          EQ     B7,B1,CORSEQ1     LOOP FOR NEXT ON COMMA 
          NE     B7,B2,CORER       ERROR IF NOT PERIOD
          RJ     GETCH             SKIP PERIOD
          RJ     SCITEM            GET SECOND LIMIT.
          ZR     X7,SELPERR1       NULL IDENT 
          RJ     CHKDCKS
          NZ     X0,CORADER1
          SA3    SEQFLAG
          SX1    B6-B2
          IX7    X1-X3
          SX6    X3+B2
          SA6    A3 
          NG     X7,BADORDER       DECKS IN WRONG ORDER 
          ZR     X7,CORR6          EXIT IF SAME DECK
          SX6    X1+B2
          SA6    TCRDEC3
          EQ     ENTER1 
  
SEQLOOP   MX0    54 
          BX7    X0*X2
          RJ     TLUDIR 
          MX1    1
          LX1    4
          NZ     X2,IDOK1 
          BX1    X1+X7
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          EQ     ENTER1 
          SPACE  1
IDOK1     BSS    0
          BX6    X1+X2             ADD SEQUENCE BIT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2 
S2LCM     ELSE
          WX6    X3                STORE ENTRY INTO DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
ENTER1    BSS    0
          SA1    SEQFLAG           NEXT ADDRESS 
          SA2    TCRDEC3           LAST ADDRESS 
          IX7    X1-X2
          ZR     X7,FINISHT        DONE 
          SX6    X1+2 
          SA6    A1 
          SA2    F.DECKS
          IX1    X1+X2
          SA2    X1 
          EQ     SEQLOOP
          SPACE  4
**        CORSEYA  PROCESS SELYANK DIRECTIVE                            01255028
*                                                                       01255029
*         IDENTS AND DECK NAMES ON THE SELYANK CARD ARE                 01255030
*         CHECKED FOR VALIDITY.  TABLE ENTRIES FOR THESE                01255031
*         CARDS ARE MADE AT CORYA1.                                     01255032
*                                                                       01255033
*         CALLS  SCITEM, CHKDCKS, CHECKDCL, GETCH                       01255034
          SPACE  1
CORSEYA   RJ     SCITEM 
          ZR     X7,SELPERR1
          RJ     CHKDCKS
          NZ     X0,CORADER1
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORSEYA1
          RJ     CHECKDCL 
CORSEYA1  BSS    0
A         ENDIF 
          SPACE  1
          SA1    CHAR 
          SB7    X1-1R. 
          NZ     B7,CORER 
          RJ     GETCH             PASS PERIOD
          RJ     SCITEM            GET SECOND IDENT 
          ZR     X7,SELPERR1       NULL 
          RJ     TLUDIR 
          ZR     X2,CORUID         UNKNOWN IDENT
          SX0    2
          BX7    X2+X0       SET INITIAL YANK BIT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA7    A2 
S2LCM     ELSE
          WX7    X3                WRITE ENTRY BACK INTO DIRECT.
S2LCM     ENDIF 
          SPACE  1
          SA1    CHAR 
          SB7    X1-1R
          ZR     B7,CORYA1
          NE     B7,B1,CORER
          RJ     GETCH
          EQ     CORSEYA
          SPACE  4
**        CORUIDA  UNKNOWN IDENT NAME                                   01255036
*                                                                       01255037
*         WHEN AN IDENT IS REFERENCED WHICH IS NOT IN THE               01255038
*         DIRECTORY, CORUIDA IS CALLED TO PRINT THE PROPER              01255039
*         ERROR MESSAGE.                                                01255040
*                                                                       01255041
*         CALLS  PRINTERR, PRINT                                        01255042
          SPACE  1
CORUID    RJ     CORUIDA
          EQ     CORER1 
          SPACE  1
CORUIDA   BSS    1
          SA1    LISTONE           IF THE LIST ERRORS OPTION IS ON
          ZR     X1,CORUIDA        PUT THE UNKNOWN IDENT IN MESSAGE AND 
          SA6    UIDMESS+3         PRINT MESSAGE. 
          RJ     PRINTERR 
          PRINT  UIDMESS,5
          EQ     CORUIDA
          SPACE  4
**        CORYA - PROCESS YANK DIRECTIVE
*                                                                       01255045
*         CORYA CHECKS FOR A *DECLARE IN EFFECT AND IF ONE IS 
*         FOUND, ISSUES A DECLARE DIAGNOSTIC.  OTHERWISE, SYB 
*         IS CALLED TO SET THE INITIAL YANK BIT IN THE
*         APPROPRIATE DIRECTORY ENTRY.
*                                                                       01255050
*         CALLS - SYB, MANAGER, MOVEIT, ADDWORD, ENTTEXT
          SPACE  1
CORYA     BSS    0
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          NZ     X1,DECLERR 
A         ENDIF 
  
          SX6    B1 
          LX6    59-4 
          SA6    YNKFLG      SET FLAG FOR PASS1 YANK PROCESSING 
          RJ     SYB         SET INITIAL YANK BIT 
  
*         YANK, SELYANK, AND YANKDECK CARDS ARE ENTERED AS
*         TEXT ON THE FILE UPDTEXT AND INSERT ENTRIES ARE 
*         CREATED IN *TDICT* SO THAT THESE CARDS WILL BE
*         INSERTED BEFORE ANY OTHER CARDS ON THE LIBRARY. 
  
CORYA1    BSS 
          SA1    INSFLG 
          ZR     X1,CORYA2
          SA1    F.DICT            IF INSERTION IS IN PROGRESS, 
          SA2    L.DICT            THEN BUMP THE INSERTION COUNT
          IX3    X1+X2
          SX0    B1 
          SA1    X3-1 
          LX0    18 
          IX6    X1+X0
          SA6    A1 
 CORYA2   ALLOC  TDICT,3
          SX4    3
          IX1    X3-X4
          IX3    X2+X4
          MOVE   X1,X2,X3 
          SA2    IDFLG             SET UP THE ENTRY IN AN EXTENSION OF
          SA1    LFPAGE            -DICT- SO THAT -ENTTEXT- MAY BE USED 
          SA3    TXTBIAS           TO ENTER THE CARD IN -FPAGE-. THIS 
          IX1    X3+X1             TAKES CARE OF OVERFLOW AND GUARANTEES
          LX1    36                ALL POINTERS ARE SET PROPERLY WHEN 
          BX1    X1+X2             WE HAVE CREATED THE ENTRY IN -DICT-
          ADDWRD DICT,X1           MOVE IT TO -TDICT- AND GET RID OF
          RJ     ENTTEXT           THE EXTRA -DICT- WORD. 
          SA2    F.TDICT
          MX7    0
          SA7    X2 
          SA7    A7+B1
          SA6    A7+B1
          SA1    L.DICT 
          SX6    X1-1 
          SA6    A1 
          EQ     CORR6
          SPACE  4
**        CORYD  CHECKS YANKDECK DIRECTIVE FOR VALIDITY                 01255053
*                                                                       01255054
*         CALLS  SCITEM, CHKDCKS, CHECKDCL, GETCH                       01255055
          SPACE  1
CORYD     RJ     SCITEM 
          ZR     X7,SELPERR1       NULL IDENT 
          RJ     CHKDCKS
          NZ     X0,CORADER1
          EQ   B2,B6,NOTYANK       ERROR IF YANK$$$                     0640  10
          SPACE  1
A         IF     DEF,DECLKEY
          SA1    DECLDECK 
          ZR     X1,CORYD1
          RJ     CHECKDCL 
CORYD1    BSS    0
A         ENDIF 
  
          SX0    2
          BX6    X2+X0       SET INITIAL YANK BIT IN DECK ENTRY 
          SA6    A2 
          SA1    CHAR 
          SB7    X1-1R
          ZR     B7,CORYA1
          NE     B7,B1,CORER
          RJ     GETCH             SKIP DELIMITER 
          EQ     CORYD             PROCESS NEXT NAME
          SPACE  4
**        DUMTXT  DUMP TEXT ONTO FTEXT                                  01255057
*                                                                       01255058
*         TEXT CARDS TO BE INSERTED INTO THE LIBRARY                    01255059
*         DURING PASS 2 ARE ACCUMULATED IN A STATIC TABLE               01255060
*         BEGINNING AT FPAGE.  WHEN THIS TABLE IS FULL,                 01255061
*         ITS CONTENTS ARE WRITTEN AS A RECORD IN THE                   01255062
*         RANDOM FILE UPDTEXT.  THE NUMBER OF THE LAST                  01255063
*         RECORD WHICH WAS WRITTEN IN THE FILE IS KEPT                  01255064
*         IN CURNO.  THE INDEX OF THE BEGINNING OF THE                  01255065
*         RECORD BEING BUILT WITH RESPECT TO THE BEGINNING              01255066
*         OF THE FILE IS KEPT IN TXTBIAS.  WHEN ALL TEXT                01255067
*         HAS BEEN ACCUMULATED AND BEFORE PASS 2 PROCESSING             01255068
*         BEGINS, A SPECIAL CALL IS MADE TO DUMTXT WITH X2              01255069
*         SET NEGATIVE.  IN THIS CASE IF NO RECORDS HAVE                01255070
*         ACTUALLY BEEN WRITTEN IN THE UPDTEXT FILE, THERE              01255071
*         IS NO NEED TO WRITE THE CURRENT RECORD, SO CURNO              01255072
*         IS SET TO 1 TO INDICATE THAT THE FIRST RECORD                 01255073
*         OF THE FILE IS NOW IN CORE.  NO OTHER PROCESSING              01255074
*         IS NECESSARY.  IF AT LEAST ONE RECORD HAS AL-                 01255075
*         READY BEEN WRITTEN, THIS SPECIAL LAST CALL TO                 01255076
*         DUMTEXT MUST WRITE OUT THE LAST RECORD TO THE                 01255077
*         FILE SINCE PASS 2 PROCESSING WILL NEED TO READ                01255078
*         THIS RECORD BACK IN SOME TIME AFTER THE OTHER                 01255079
*         RECORDS HAVE BEEN READ.  IF THE CURRENT CONTENTS              01255080
*         OF FPAGE ARE TO BE WRITTEN OUT TO THE FILE AND                01255081
*         IF THIS IS THE FIRST RECORD TO BE WRITTEN, THE                01255082
*         TXTLIM TABLE WILL BE SET OFF.  IN THIS CASE,                  01255083
*         THE BIAS OF THE BEGINNING OF THE FIRST RECORD                 01255084
*         (0) IS ENTERED AS THE FIRST TABLE ENTRY.  IN                  01255085
*         ALL CASES, TWO ADDITIONAL WORDS ARE NOW ALLOCATED             01255086
*         IN TXTLIM.  THE FIRST OF THESE TWO WORDS WILL                 01255087
*         CONTAIN THE DISK ADDRESS OF THE RECORD WHICH                  01255088
*         WILL NOW BE WRITTEN.  THE VALUE NOW IN LFPAGE                 01255089
*         IS THE LENGTH OF THE CURRENT RECORD.  THIS VALUE              01255090
*         WILL BE KEPT IN THE SECOND WORD WHICH WAS JUST                01255091
*         ALLOCATED IN TXTLIM.  THESE LENGTH VALUES WILL                01255092
*         BE ADDED TOGETHER IN PASS 2 TO DETERMINE WHICH                01255093
*         RECORD CONTAINS ANY GIVEN LINE TO BE INSERTED.                01255094
*         AFTER THE CURRENT RECORD HAS BEEN WRITTEN, THE                01255095
*         VALUE IN TXTBIAS IS INCREMENTED BY THE LENGTH                 01255096
*         OF THAT RECORD SO THAT TXTBIAS WILL REFLECT THE               01255097
*         TOTAL LENGTH OF THE RECORDS WHICH HAVE BEEN                   01255098
*         WRITTEN.  CURNO IS INCREMENTED BY 1, TO INDICATE              01255099
*         THAT A NEW RECORD IS NOW RESIDENT IN CORE AND                 01255100
*         LFPAGE IS RESET TO ZERO.  IF THE RECORD JUST                  01255101
*         WRITTEN IS THE LAST RECORD WHICH WILL BE CREATED,             01255102
*         AS INDICATED BY THE NEGATIVE ENTRY FLAG, TXTBIAS              01255103
*         AND LFPAGE ARE NOT UPDATED BUT CURNO IS INCRE-                01255104
*         MENTED.  THIS LEAVES ALL APPROPRIATE POINTERS                 01255105
*         INDICATING THAT THE LAST RECORD IS STILL CORE                 01255106
*         RESIDENT.                                                     01255107
*         CALLS  ADDWORD, MANAGER, CALLIO, CPCLEAR                      01255108
          SPACE  1
DUMTXT    PS
          BX6    X2                X2 IS A FLAG. IT IS NEGATIVE FOR THE 
          SA6    TCRBIN            FINAL ENTRY TO THIS ROUTINE. AT ALL
          PL     X2,DUMTXT1        OTHER ENTRIES IT IS POSITIVE. FOR ALL
          SA3    CURNO             BUT THE LAST ENTRY A RECORD IS 
          ZR     X3,SKIPDUMP       CREATED ON THE FTEXT FILE, TXTBIAS 
  
          ENV    ACT,(2,3),VER2 
 DUMTXT1  SA1    UPDTEXT+FETFIT 
          SA3    X1 
          NZ     X3,DUMTXT1A
          OPEN   UPDTEXT,WRITE
 DUMTXT1A SA1    L.TXTLIM          IS BUMPED BY THE RECORD LENGTH 
 VER2     ELSE
 DUMTXT1  SA1    L.TXTLIM 
VER2      ENDIF 
  
  
          NZ     X1,DUMTXT2        SKIP IF NOT FIRST TIME 
          ADDWRD TXTLIM,X1
 DUMTXT2  ALLOC  TXTLIM,2 
          IX3    X2+X3             WHICH WAS WRITTEN,LFPAGE IS ZEROED,
          SX6    X3-2              CURNO IS BUMPED BY 1. DURING THESE 
          SA6    UPDTEXT+6         INTERMEDIATE CALLS TXTBIAS HOLDS THE 
          SA1    LFPAGE            INDEX INTO THE TEXT FILE OF THE START
          BX7    X1                OF THE CURRENT RECORD BEING CONSTRUCT
          SA7    X3-1              -ED. CURNO CONTAINS THE RECORD NUMBER
          SX6    X1+FPAGE          OF THE LAST RECORD ACTUALLY DUMPED TO
          SA6    UPDTEXT+2         UPDTEXT.  TXTBIAS+LFPAGE GIVES THE 
          WRITER UPDTEXT           STARTING INDEX WITHIN THE FILE OF THE
          CLEAR  UPDTEXT           NEXT SQUEEZED LINE TO BE WRITTEN 
          SA1    LFPAGE            ON THE LAST ENTRY ONE OF TWO THINGS
          SA2    TXTBIAS           HAPPENS. IF THE CURRENT RECORD IS THE
          SA4    TCRBIN            ONLY RECORD, THE VALUE OF CURNO IS 
          SA3    CURNO             BUMPED TO REFLECT THE RECORD PRESENT 
          NG     X4,SKIPDUMP       -LY IN CORE AND NO FILE IS WRITTEN.
          IX7    X1+X2             IF OTHER RECORDS HAVE BEEN WRITTEN 
          MX6    0                 THE CURRENT RECORD IS WRITTEN TO 
          SA7    A2                THE FTEXT FILE, THE VALUE OF CURNO 
          SX7    X3+B1             IS BUMPED, AND THE RECORD IS LEFT IN 
          SA6    A1                CORE.
          SA7    A3 
          EQ     DUMTXT 
          SPACE  1
SKIPDUMP  SX7    X3+B1
          SA7    A3 
          EQ     DUMTXT 
          SPACE  4
**        ENDICT  ENTER TRIPLE INTO DICTIONARY                          01255110
*                                                                       01255111
*         THIS SUBROUTINE IS CALLED TO MAKE ENTRIES INTO                01255112
*         DICT.  ON ENTRY, X6 CONTAINS THE SEQUENCE NUMBER              01255113
*         AND X7 THE ORDINAL OF THE IDENT TO WHICH THIS                 01255114
*         DICT ENTRY WILL REFER.  IN THE CASE OF ADDFILE                01255115
*         ENTRIES, WHERE THE ENTRY WILL BE ALTERED UPON                 01255116
*         RETURN TO CORAD, THE CONTENT OF X6 AND X7 IS                  01255117
*         IMMATERIAL.  X1 SHOULD CONTAIN ON ENTRY A CODE                01255118
*         WHICH INDICATES THE TYPE OF ENTRY TO WHICH THE                01255119
*         DICT ENTRY WILL REFER.  IF THE SECOND WORD OF                 01255120
*         THIS DICT ENTRY IS RELEVANT FIT POINTS TO THE                 01255121
*         END OF A DELETE OF RESTORE RANGE), ID2 MUST CON-              01255122
*         TAIN THE ORDINAL AND N2 THE SEQUENCE NUMBER OF                01255123
*         THE APPROPRIATE CARD.                                         01255124
*         ENTRY  X1 - FLAG IN BITS 0-6 TO BE PUT IN BITS 54-59 OF FIRST 01255125
*                     WORD OF ENTRY                                     01255126
*         CALLS  ADDWORD                                                01255127
          SPACE  1
 ENTDICTX ADDWRD DICT,X1           ADD THIRD WORD 
          SA1    DEFAULT
          NZ     X1,EXPAND
ENTDICT   PS
          LX1    54 
          LX6    18 
          IX1    X1+X7
          IX1    X1+X6
          SX0    4                 SET BIT 2 OF THE DIRECTORY ENTRY FOR 
          SA2    F.DIRECT          THIS IDENT ON TO INDICATE THAT 
          IX2    X2+X7             THERE IS AT LEAST ONE ENTRY IN THE 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X2                DICTIONARY WHICH REFERENCES IT.
          BX7    X2+X0
          SA7    A2 
S2LCM     ELSE
          RX7    X2                READ DIRECTORY.
          BX7    X7+X0             SET BIT. 
          WX7    X2                STORE ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          ADDWRD DICT,X1
          SPACE  1
          IF     DEF,DECLKEY,1
          SA1    DECLDECK 
          SA2    ID2               FORMAT AND ENTER SECOND
          SA3    A2+B1             WORD 
          SPACE  1
          IF     DEF,DECLKEY,1
          IX2    X1+X2
          LX3    18 
          IX1    X2+X3
          ADDWRD DICT,X1
          SA2    IDFLG
          SA1    LFPAGE 
          SA3    TXTBIAS
          IX1    X3+X1
          LX1    36 
          BX1    X2+X1
          EQ     ENTDICTX 
          SPACE  4
**        ENTTEXT  PUT TEXT INFPAGE                                     01255129
*                                                                       01255130
*         THIS SUBROUTINE IS CALLED TO PLACE A LINE OF                  01255131
*         CODE IN FPAGE AND THE UPDATE CARD COUNT AND                   01255132
*         BIAS VALUES IN THE DICT ENTRY WHICH REFERS TO                 01255133
*         THIS CARD.  THE LAST WORD IN DICT IS THE WORD                 01255134
*         TO BE UPDATED.  IF THERE IS NOT ROOM IN FPAGE,                01255135
*         IT IS EMPTIED BY DUMTXT AND THE CURRENT CARD                  01255136
*         BEGINS A NEW FPAGE.  THE CARD ITSELF IS WRITTEN               01255137
*         TO FPAGE AS IT OCCURS IN SQIMAGE.  THE LENGTH                 01255138
*         VALUE IN SQLGN IS COMBINED WITH THE VALUE OF                  01255139
*         POINTER AND WRITTEN AS A HEADER WORD TO THE                   01255140
*         CARD IMAGE.  POINTER CONTAINS A VALUE WHICH POINTS            01255141
*         TO THE WORD IN COUNT WHICH WILL BE USED TO ACCU-              01255142
*         MULATE THE SEQUENCE NUMBERS FOR THIS IDENT.                   01255143
*                                                                       01255144
*         CALLS  MOVEIT, DUMTXT                                         01255145
          SPACE  1
ENTTEXT   PS
          SA1    CARD8             IS THERE AN 8-BIT CARD 
          ZR     X1,ENTTX1         NO 
          RJ     SQUEEZ8           YES, SQUEEZE IT
 ENTTX1   SA2    SQLGN8 
          NZ     X2,ENTTX2         HAVE 8-BIT CARD
          RJ     SQUEEZE
          SA2    SQLGN
          NZ     X2,ENTTX2         HAVE 6-BIT SQUEEZED CARD 
          RJ     SQUEEZE
          SA2    SQLGN
 ENTTX2   SA1    LFPAGE            CHECK FOR FIT
          SX2    X2-SZFPAGE+1 
          IX2    X1+X2
          NG     X2,ENTTX3
          RJ     DUMTXT            NO FIT, DUMP BUFFER
  
 ENTTX3   SA1    SQLGN8 
          SA3    POINTER
          BX7    -X1
          LX3    18 
          NZ     X1,ENTTX4         8-BIT CARD 
          SA1    SQLGN             6-BIT CARD 
          LX7    X1 
 ENTTX4   SA4    LFPAGE            LENGTH OF TEXT ON FPAGE
          SX1    X1+B1             LENGTH OF THIS LINE
          BX7    X7-X3             LENGTH+POINTER (NEG IF 8-BIT)
          IX6    X4+X1             NEW TEXT LENGTH
          SA7    A1 
          SA6    A4 
          MOVE   X1,A1,FPAGE+X4    MOVE CARD TO FPAGE 
          SA1    F.DICT            FETCH WORD 3 OF THE CURRENT
          SA2    L.DICT            DICT ENTRY AND INCREMENT THE 
          IX3    X1+X2             CARD COUNT BY ONE
          SX0    B1 
          SA1    X3-1 
          LX0    18 
          IX6    X1+X0
          SA6    A1 
          SA1    SQLGN8 
          ZR     X1,ENTTEXT        IF 6-BIT LINE
          BX6    -X1               RESTORE POSITIVE WORD COUNT
          SA6    A1 
          EQ     ENTTEXT
          SPACE  4
**        EXPAND  INSERT DEFAULT NAME                                   01255147
*                                                                       01255148
*         THIS ROUTINE IS CALLED BY ENTDICT WHEN A DEFAULT              01255149
*         IDENT NAME HAS BEEN USED.  DETTYPE IS CALLED TO               01255150
*         INSERT THE DEFAULT NAMES IN THE CARD FOR LISTING              01255151
*         PURPOSES.                                                     01255152
*                                                                       01255153
*         CALLS  DETTYPE                                                01255154
EXPAND    MX6    0
          IX0    X2+X3
          SA6    A1 
          SA1    X0-3 
          RJ     DETTYPE
          SA1    =10H ///// 
          BX6    X1 
          SA6    DNAME
          EQ     ENTDICT
          SPACE  4
**        GETLIM  PROCESS DIRECTIVE PARAMETERS                          01255156
*                                                                       01255157
*         THIS ROUTINE IS CALLED TO PROCESS PARAMETERS                  01255158
*         FROM BEFORE, INSERT, DELETE, RESTORE AND COPY                 01255159
*         CARDS.  THE PARAMETERS MUST BE IN ONE OF THREE                01255160
*         FORMS:  1.  IDENT.SEQNUM  2.  .SEQNUM                         01255161
*         3.  SEQNUM; TYPE 1 ENTRIES CAUSE THE CELLS                    01255162
*         TGETLIMT  AND TGETLIMT+1 TO BE UPDATED.  TGETLIMT             01255163
*         WILL CONTAIN THE LAST IDENT THAT WAS REFERENCED               01255164
*         BY ONE OF THE ABOVE MENTIONED CARDS THAT IS ALSO              01255165
*         A DECK NAME.  TGETLIMT+1 WILL CONTAIN THE LAST                01255166
*         IDENT (WHETHER IT WAS A DECK NAME OR NOT) THAT                01255167
*         WAS REFERENCED BY ONE OF THE ABOVE MENTIONED                  01255168
*         CARDS.  TYPE 2 ENTRIES USE THE SUBSTITUTE IDENT               01255169
*         NAME (WHICH WILL ALSO BE A DECK NAME) WHOSE OR-               01255170
*         DINAL IS IN TGETLIMT.  TYPE 3 ENTRIES USE THE                 01255171
*         SUBSTITUTE IDENT NAME WHOSE ORDINAL IS IN                     01255172
*         TGETLIMT+1.  THE ORDINAL RETURNED BY GETLIM                   01255173
*         IS RETURNED IN X7, THE SEQUENCE NUMBER IN X6.                 01255174
*         IF THE SUBSTITUTION OF A DEFAULT NAME WAS MADE,               01255175
*         THE FLAG DEFAULT IS SET NON-ZERO.                             01255176
*                                                                       01255177
*         EXIT   X6 - SEQUENCE NUMBER                                   01255178
*                X7 - ORDINAL                                           01255179
*                                                                       01255180
*         CALLS  SCITEM, TLUDIR, GETCH, SCNN, CHKDCKS, PRINTERR, PRINT  01255181
          SPACE  1
GETLIM    PS
          SA1    CHAR 
          SB7    X1-1R. 
          SA2    A1+B1             GET COLUMN POINTER 
          SB4    B1+B1
          ZR     B7,SUBS1          JUMP TO PROCESS .SEQNUM FORM 
          BX6    X2 
          LX7    X1 
          SA6    TCOL              SAVE COLUNM
          SA7    TCHAR             AND CHAR 
          RJ     SCITEM            FETCH IDENT
          SA7    TCRDEC4
          ZR     X7,CORER          NULL 
          SA1    CHAR 
          SB7    X1-1R
          ZR     B7,SUBS           JUMP TO SEE IF THIS IS SEQUENCE NUM
          EQ     B7,B1,SUBS        JUMP ON COMMA
          NE     B7,B4,CORER       UNKNOWN DELIMITER
          RJ     TLUDIR            CHECK VALID IDENT
          ZR     X2,CORUID         JUMP IF UNKNOWN
          SA6    GETLIMT           SAVE ORDINAL 
          RJ     GETCH             PASS THE PERIOD
          RJ     SCNN 
          ZR     X6,GETERR
          BX2    X6 
          AX2    17 
          NZ     X2,GETERR   IF NUMBER NEGATIVE OR GT 131071
          SA6    GETLIMT+1         STORE SEQUENCE NUMBER
          SA2    A6-B1
          SA3    TCRDEC4
          BX6    X2 
          BX7    X3 
          RJ     CHKDCKS
          NZ     X0,GETLIM8        NOT DECK NAME
          SA6    TGETLIMT 
GETLIM8   SA6    TGETLIMT+1 
          SA1    GETLIMT+1
          LX7    X6 
          BX6    X1 
          EQ     GETLIM7
          SPACE  1
GETERR    SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1GLERR,7
          EQ     CORER1 
          SPACE  1
SUBS      SA1    TCOL              RESTORE
          SA2    TCHAR
          BX6    X1                COLUMN 
          LX7    X2 
          SA6    A1-B1             POINTER
          SA7    A6-B1             RESTORE CHAR 
          SA7    DEFAULT
          RJ     SCNN 
          ZR     X6,GETERR         BAD NUMBER 
          SA1    TGETLIMT+1 
          BX7    X1 
          EQ     GETLIM7
          SPACE  1
SUBS1     RJ     GETCH             SKIP PERIOD
          RJ     SCNN 
          ZR     X6,GETERR
          SA1    TGETLIMT 
          BX7    X1 
          SA7    DEFAULT
GETLIM7   SA1    CHAR 
          SB7    X1-1R
          ZR     B7,GETLIM
          EQ     B7,B1,GETLIM 
          EQ     CORER
          EJECT  4                                                      01257499
**        IDCHANGE  MAKES IDENTS UNIQUE                                 01255183
*                                                                       01255184
*         THERE ARE TWO TIMES AT WHICH UPDATE CAN ATTEMPT               01255185
*         TO ALTER A NAME TO MAKE IT UNIQUE.  IDENT AND                 01255186
*         DECK NAMES FROM THE SECOND OF TWO PLS TO BE MERGED            01255187
*         WITH DUPLICATE NAMES ON THE FIRST PL ARE CHANGED.             01255188
*         DURING NORMAL CORRECTION RUNS DUPLICATE IDENTS                01255189
*         ARE CHANGED SO LONG AS A NEWPL IS NOT BEING GE-               01255190
*         NERATED.  THE LAST CHARACTER IN THE NAME IS                   01255191
*         CHANGED BY ADDING 1 TO THE DISPLAY CODE VALUE                 01255192
*         UNTIL ALL CHARACTERS LESS THAN 55B HAVE BEEN                  01255193
*         TRIED.  IF NO UNIQUE NAME IS FOUND, A NEW CHARAC-             01255194
*         TER IS TACKED ON, THIS NEW CHARACTER IS CHANGED               01255195
*         UNTIL ALL CHARACTERS HAVE BEEN TRIED, AND SO                  01255196
*         ON.  IF A UNIQUE NAME CANNOT BE FOUND BY THE TIME             01255197
*         ALL POSSIBLE NINTH CHARACTERS HAVE BEEN TRIED,                01255198
*         UPDATE GIVES UP AND ISSUES AN ERROR MESSAGE.                  01255199
*         ON ENTRY TO IDCHANGE, IDNAM SHOULD CONTAIN THE                01255200
*         NAME TO BE CHANGED.  B5 SHOULD CONTAIN THE NUM-               01255201
*         BER OF CHARACTERS IN THE SET 01B TO 54B WHICH                 01255202
*         HAVE NOT YET BEEN TRIED.  IDCHANGE WILL ADD 1                 01255203
*         TO THE LAST CHARACTER (MOD 55) AND DECREMENT                  01255204
*         B5.  WHEN B5 REACHES A NEGATIVE VALUE, THE NEXT               01255205
*         CHARACTER IS ADDED TO THE NAME AND THE WHOLE                  01255206
*         PROCESS STARTS OVER.  IDCHANG RETURNS THE NEW                 01255207
*         NAME WITH ZERO FILL IN IDNAM AND WITH BLANK FILL              01255208
*         IN CHG+3.  WHEN IDCHANGE IS CALLED FROM THE MERGE             01255209
*         PROCESSOR, A0 IS SET TO ZERO; WHEN CALLED FROM                01255210
*         CORID, A0 IS SET NON-ZERO.  THIS FLAG (A0) IS                 01255211
*         USED TO DETERMINE WHERE IDCHANGE SHOULD RETURN                01255212
*         WHEN ALL POSSIBILITIES FOR ALTERATION HAVE BEEN               01255213
*         EXHAUSTED.                                                    01255214
*                                                                       01255215
*         CALLS  PRINTERR, PRINT, PAD                                   01255216
IDCHANGE  PS
          SA1 MERGE                THIS ROUTINE CHANGES AN IDENT NAME 
          NZ  X1,CHANGER           TO MAKE IT UNIQUE. THIS CAN BE DONE
          SA1 NEWPL                DURING A MERGE OR DURING A NORMAL
          ZR  X1,CHANGER           UPDATE WHEN NO NEWPL IS BEING
IDCHANG0  SA1    LISTONE           CREATED.  IN ANY OTHER CASE DUPLICATE
          ZR  X1,CORER1            IDENTS RESULT IN A FATAL ERROR.
          RJ     PRINTERR 
          PRINT  P1IDERR,4
          EQ     CORER1 
          SPACE  1
CHANGER   SA1    IDNAM             PICK UP IDNAME 
          SB2    B1 
          MX0    6
          SB4    6
          SX3    B1 
          SB3    B0 
          LX0    6
          SB5    B5-B1
NLOOP     SB2    B2-B1             LOOP UNTIL WE FIND THE END 
          LX0    6                 OF THE NAME
          BX2    X0*X1
          SB3    B3+B4
          LX3    6
          ZR     X2,NLOOP          LOOP IF ZERO 
          NG     B5,IDCHANG1       TRY NEXT CHARACTER 
IDCHANG3  IX2    X2+X3             FORM NEW CHARACTER 
          AX2    X2,B3
          SB4    X2-1R
          PL     B4,IDCHANG2       TOO BIG--START AT A
          IX7    X1+X3             CREATE NEW CHARACTER 
          BX1    X7 
          SA7    IDNAM
          RJ     SFN= 
          SA6    CHG+3
          EQ     IDCHANGE 
          SPACE  1
IDCHANG1  PL     B2,IDCHANG4       CANNOT CHANGE NINTH CHARACTER
          AX3    X3,B4
          SB3    B3-B4
          SB5    54B
          MX2    0                                                      0610   8
          EQ     IDCHANG3 
          SPACE  1
IDCHANG2  BX1    -X0*X1            REMOVE OLD CHARACTER 
          MX2    0
          EQ     IDCHANG3 
          SPACE  1
          IF     -DEF,EDITKEY,1 
IDCHANG4  EQ     IDCHANG0 
          SPACE  1
M         IF     DEF,EDITKEY
IDCHANG4  SB4    A0 
          NZ     B4,IDCHANG0
          SA1    LISTONE
          ZR     X1,IDCHANG5
          RJ     PRINTERR 
          PRINT  P1IDERR,4
IDCHANG5  SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          EQ     DETOUR5
M         ENDIF 
          EJECT                                                          CP190
**        LFNCK   CHECKS NAME FORMAT.                                    CP190
*                                                                        CP190
*         THIS ROUTINE VERIFIES THAT A NAME IS OF THE FORMAT             CP190
*         ALLOWED FOR FILE NAMES AND LIBRARY NAMES.  CHECKS ARE          CP190
*         MADE FOR 1) FIRST CHARACTER ALPHABETIC, 2) REMAINING           CP190
*         CHARACTERS ARE ALPHANUMERIC.                                   CP190
*                                                                        CP190
*         ENTRY    (X1) = LFN LEFT JUSTIFIED ZERO FILL.                  CP190
*                         LOWER 18 BITS OF X1 ARE IGNORED AND MASKED OFF CP190
*         EXIT     (X6) = LFN LEFT JUSTIFIED ZERO FILL, IF FORMAT IS OK  CP190
*                       < 0 IF LFN IS BAD.                               CP190
*                  (X1) = UNCHANGED, EXCEPT LOWER 18 BITS ARE CLEARED.   CP190
*         USES     B2,X2,X3,X4                                           CP190
*         CALLS    NONE.                                                 CP190
                                                                         CP190
LFNCK     PS                                                             CP190
          MX2    42                                                      CP190
          SB2    B0                INITIALIZE CHAR COUNT.                CP190
          BX1    X2*X1                                                   CP190
          MX3    -6                                                      CP190
          BX2    X1                                                      CP190
          ZR     X1,LFNCK2         IF EMPTY NAME, FLAG ERROR.            CP190
          BX6    X1                SAVE IN X6 FOR RETURN.                CP190
LFNCK1    LX2    6                 LOOK AT NEXT CHAR.                    CP190
          BX4    -X3*X2                                                  CP190
          ZR     X4,LFNCK          IF NO MORE CHARS, EXIT.               CP190
          R=     X4,X4-1R+                                               CP190
          PL     X4,LFNCK2         IF NOT ALPHANUMERIC, FLAG ERROR.      CP190
          SB2    B2+B1                                                   CP190
          NE     B2,B1,LFNCK1      IF NOT 1ST CHAR.                      CP190
          R=     X4,X4+1R+-1R0                                           CP190
          NG     X4,LFNCK1         IF 1ST CHAR ALPHABETIC                CP190
LFNCK2    MX6    1                 SET ERROR FLAG FOR RETURN.            CP190
          EQ     LFNCK             EXIT.                                 CP190
                                                                         CP190
          EJECT  4                                                      01257501
*    ENTER HERE ON FINDING MISSING OR UNPROCESSABLE CONTROL CARD       *
          SPACE  1
CORER     SA1    LISTONE           LISTONE NON-ZERO MEANS PRINT ERRORS
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1CCERR,4
CORER1    SA1    ERRORS 
          SX7    X1+B1       BUMP ERROR COUNT 
          SA7    A1 
          EQ     CORR5A 
          SPACE  1
*    ENTER HERE ON ATTEMPT TO YANK OR PURGE YANK DECK.                 *
          SPACE  1
NOTYANK   SA1    LISTONE
          ZR     X1,CORER1
          RJ     PRINTERR 
          PRINT  P1YKERR,8
          EQ     CORER1 
          SPACE  4
**        RANOPL  READ LISTS FROM RANDOM PL                             01255227
*                                                                       01255228
*         UPDATE ENTERS RANOPL WHEN IT HAS BEEN DETERMINED              01255229
*         THAT THE OLDPL IS A RANDOM FILE.  THE 3 WORD                  01255230
*         UPDATE INDEX HAS BEEN READ INTO LOCATIONS BUFN                01255231
*         THROUGH BUFN+2.  THE THIRD WORD CONTAINS THE                  01255232
*         CONTROL CHARACTER OF THIS LIBRARY AND THE 64                  01255233
*         CHARACTER SET FLAG.  CHECHAR PROCESSES THIS                   01255234
*         WORD.  THE READ CALLS WHICH REFER TO READING                  01255235
*         OF THE OLDPL ARE RESET TO CALLS TO RBIN SINCE                 01255236
*         RANDOM OLDPLS ARE NOT CHECKSUMMED.  RANDOPL                   01255237
*         IS SET NON-ZERO AS A FLAG TO INDICATE THE PRESENCE            01255238
*         OF A RANDOM OLDPL.  THE LENGTH AND INDEX ENTRY                01255239
*         OF THE DECK LIST AND IDENTIFIER TABLE ARE CONTAINED           01255240
*         IN THE FIRST TWO WORDS OF THE INDEX WHICH WAS RE-             01255241
*         TURNED BY OPEN AND THESE TWO LISTS ARE READ INTO              01255242
*         THE PROPER TABLES.  THE TABLE INTO WHICH THE                  01255243
*         IDENT LIST IS READ DEPENDS ON WHETHER OR NOT A                01255244
*         MERGE IS BEING DONE.  THE INDEX ENTRY FOR THE                 01255245
*         YANK$$$ DECK IS PLACED INTO OLDPL+6 SO THAT THIS              01255246
*         DECK WILL BE THE FIRST ONE READ.                              01255247
*                                                                       01255248
*         CALLS  CHECHAR, MANAGER, RBIN, CPCLEAR, CALLPP                01255249
          SPACE  2
RANOPL    SA1    CPYTOLIB 
          NZ     X1,CPYLIBER
          SA2    RANIDX+2 
          SA5    HEADER 
          ZR     X5,RANOPL2  IF OLDPL HEADER IS OK
          RJ     CHGHDER
          SA6    RANIDX+2 
RANOPL2   ZR     X2,RANOPL1 
          RJ     CHECHAR
          SA2    RANIDX+2 
          MX0    54 
          AX2    12                                                     0432   7
          BX2    -X0*X2 
          ZR     X2,RANOPL1        JUMP IF NOT LABELED
          SA1    RANIDX+3 
          SA2    A1+B1             FETCH LABEL FROM INDEX 
          BX6    X1 
          SA6    OLDPL+9           PUT LABEL IN FET 
          BX6    X2 
          SA6    A6+B1
RANOPL1   BSS    0
*                                  THIS ROUTINE RESETS THE READ ROUTINE 
*                                  CALLS TO NOT USE CHECKSUM READS SINCE
*                                  IT IS USELESS TO CHECKSUM A RANDOM 
*                                  FILE. THE INDEX FOR THE RECORDS
*                                  CONTAINING THE DIRECTORY AND DECK
          SX7    B1                LIST IS IN BUFN. READ THE DIRECTORY
          SA7    RJRBIN            AND DECK LIST. SET RANDOM OLDPL FLAG.
          MX0    30                JUMP TO -MERGEPL- IF PROCESSING 2ND
          SA7    RANDOPL           LIBRARY OF A MERGE.
          SA1    RANIDX 
          BX6    -X0*X1            X6 HAS RANDOM ADDRESS
          AX1    18                                                     0110  54
          SA6    OLDPL+6                                                0110  55
          BX1    -X0*X1                                                 0110  56
          AX1    12                                                     0110  57
          IX1    X1-X7
          ALLOC  DECKS,X1 
          READW  OLDPL,X2,X3
          NZ     X1,ROPLE 
          CLEAR  OLDPL,READ 
          SA1    RANIDX+1 
          MX0    30 
          BX6    -X0*X1 
          AX1    30 
          SB2    -B1
          SA6    OLDPL+6
          IF     DEF,EDITKEY,2
          SA2    QFLAG             JUMP IF PROCESSING SECOND
          NZ     X2,MERGEPL        LIBRARY OF MERGE.
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ALLOC  DIRECT,X1+B2 
          READW  OLDPL,X2,X3
S2LCM     ELSE
          SX1    X1+B2             LENGTH MINUS 1 CUZ YANK$$$ THERE.
          RJ     MANAGL 
          RBINL  OLDPL,X2,X3
S2LCM     ENDIF 
          SPACE  1
 MERGEPL1 CLEAR  OLDPL,READ 
          SA2    F.DECKS
          SA2    X2+B1
          BX6    X2 
          SA6    OLDPL+6
          EQ     CORR2A 
          SPACE  1
 CPYLIBER MESSAGE P1AOERR 
          EQ     ABORT
          SPACE  1
C         IF     DEF,EDITKEY
 MERGEPL  ALLOC  COUNT,X1 
          READW  OLDPL,X2,X3
          SA1    F.COUNT           REMOVE YANK$$$ ENTRY 
          SA2    L.COUNT
          SX6    X1+1 
          SX7    X2-1 
          SA6    A1 
          SA7    A2 
          EQ     MERGEPL1 
C         ENDIF 
          SPACE  1
 BMODERR  MESSAGE P1BOERR 
          EQ     ABORT
          ENV    NOT,(2,3),VER2 
 RDR      SPACE  4
**        RDR - READ DIRECTORY. 
*         EXIT   (X1) < 0 IF PROGRAM RANDOM.
  
  
 RDR      PS                 ENTRY/EXIT 
          SA1    OLDPL+1     CHECK FET
          SA2    RANIDX 
          LX1    12 
          LX2    12 
          MX6    48 
          BX2    -X6*X2 
          PL     X1,RDR      IF NOT RANDOM
          SB7    X2-7000B 
          ZR     B7,RDR      IF RANDOM
          MX6    18 
          LX6    36 
          SKIPEI OLDPL,R
          BKSP   OLDPL,R
          CLEAR  OLDPL,READ 
          READW  OLDPL,BUFN,LBUFN 
          ZR     X1,RDR1     IF NOT EOR 
          SA2    RANIDX 
          LX2    12 
          MX6    48 
          BX2    -X6*X2 
          SB7    X2-7000B 
          NZ     B7,RDR1     IF NOT RANDOM
          CLEAR  OLDPL,READ 
          MX1    1
          EQ     RDR         RETURN 
 RDR1     REWIND OLDPL
          CLEAR  OLDPL,READ 
          SA1    OLDPL+1     CLEAR RANDOM BIT IN FET
          SX2    B1 
          LX2    47 
          BX6    -X2*X1 
          SA6    A1 
          MX1    0
          EQ     RDR         RETURN 
          EJECT  4                                                      01257503
VER2      ENDIF 
  
**        SETCOPY  FILE INITIALIZATION FOR COPY                         01255251
*                                                                       01255252
*         WHEN A SEQUENTIAL PL IS TO BE COPIED TO A TEM-                01255253
*         PORARY RANDOM PL,  SETCOPY IS CALLED TO SAVE THE              01255254
*         CURRENT CARD IN SQIMAGE, IF NECESSARY, AND TO                 01255255
*         SET UP THE TEMPORARY FILE IN THE NEWPL FET.                   01255256
*                                                                       01255257
*         CALLS  CALLPP, WAIT, CALLIO, WAIT, MOVEIT, ADDWORD            01255258
          SPACE  1
SETCOPY   BSS    1
          SA1    CPYTOLIB          THIS FLAG IS SET ON BY AN -A- ON THE 
          NZ     X1,UPDATEA5       UPDATE CALL CARD. -A- MODE IS USED TO
  
          ENV    ACT,(2,3),VER2 
          RJ     SVNPLFET 
VER2      ENDIF 
  
          ENV    NOT,(2,3),VER2 
          RECALL NEWPL
 VER2     ENDIF 
          SA1    NEWPL
  
          SA2    TEMPIN            LIBRARY.  IF IT IS NOT ON SET UP THE 
          BX6    X1                FILE -TEMPIN- AS AN INTERMEDIATE 
          LX7    X2                LIBRARY USING -NEWPL- FET. IF -QFLAG-
          SA6    TEMPNPL           IS NON-ZERO WE ARE PROCESSING THE
          SA7    A1                SECOND OF TWO PL-S BEING MERGED. SET 
  
          ENV    ACT,(2,3),VER2 
          SA1    NEWPL+FETFIT      SWITCH FIT POINTERS
          SA2    TEMPIN+1 
          BX6    X1 
          LX7    X2 
          SA6    TEMPNPL+1
          SA7    NEWPL+FETFIT 
          MX7    0
          SA7    NEWPL+EOIPOS 
VER2      ENDIF 
  
          SX6    B1 
          IF     DEF,EDITKEY,2
          SA1    QFLAG             UP THE SECOND GROUP OF YANK AND
          NZ     X1,SETCOPYM       SELYANK CARDS IN A RECORD NAMED
          SA6    L.NEWDKS          (...   ...)
  
          ENV    ACT,(2,3),VER2 
          OPEN   NEWPL,WRITE
VER2      ELSE
          EVICT  NEWPL
          ENV    ACT,(11),X 
          OPEN   NEWPL,WRITENR
X         ENDIF 
          RECALL NEWPL
VER2      ENDIF 
  
          SA1    SQLGN
          MOVE   X1+B1,A1,TSQLGN   STORE CURRENT CARD 
MERGERET  SX6    SCRLOC            SET UP TO PUT RANDOM ADDRESS IN
          SA6    NEWPL+6           SCRLOC.
          MX7    60 
          SA7    DECKFLAG 
          EQ     SETCOPY
          SPACE  1
          IF     DEF,EDITKEY,3
SETCOPYM  SA1    =10H...   ...A 
          ADDWRD NEWDKS,X1
          EQ     MERGERET 
          SPACE  2
* SET UP FOR A MODE COPY (SEQ TO RAN) 
 UPDATEA5 SX6    B1 
          SA6    L.NEWDKS 
          SA6    FMODE             FLAG TO STOP SETNEWPL EARLY
          RJ     SETNEWPL 
          EQ     MERGERET 
          EJECT  4                                                      01257505
**        SETDECK MAKES ENTRIES TO DECKS                                01255260
*                                                                       01255261
*         DURING THE COPY OPERATION WHICH CREATES THE                   01255262
*         TEMPORARY RANDOM PL, EACH DECK OR COMDECK MUST                01255263
*         BE WRITTEN AS A SEPARATE RECORD AND THE TABLE                 01255264
*         NEWDKS MUST BE BUILT CONTAINING THE NAMES AND                 01255265
*         INDEXES OF THE RECORDS.  SETDECK IS CALLED TO                 01255266
*         DO THIS EACH TIME AN ACTIVE DECK OR COMDECK                   01255267
*         CARD IS READ.                                                 01255268
*                                                                       01255269
*         CALLS  CALLIO, CALLPP, CPCLEAR, ADDWORD                       01255270
          SPACE  1
SETDECK   BSS    1
          SA1    CARDSTAT 
          PL     X1,SETDECK2
SETDECK3  BSS    0
          WRITER NEWPL
          MESSAGE CPMSG,1 
          CLEAR  NEWPL,WRITE
          SA1    SCRLOC 
          SX6    A1 
          SA6    NEWPL+6
          ADDWRD NEWDKS,X1
          SA1    CPMSG+1
          BX7    X1 
          RJ     CHKDCKS
          SA3    DECKFLG           SET DECKBIT INTO WORD                 CP190
          BX1    X7+X3             CONTAINING DECK NAME.                 CP190
          NZ     X0,SETDECK1
          BX1    X2+X3             SET DECK BIT INTO DECK NAME WORD.     CP190
SETDECK1  MX6    0                 CLEAR                                 CP190
          SA6    A3                      DECKFLG.                        CP190
          ADDWRD NEWDKS,X1
          EQ     SETDECK
          SPACE  1
SETDECK2  LX1    58-54
          NG     X1,SETDECK3       THIS IS A YANKED DECK
          MX6    0
          SA6    DECKFLG
          EQ     SETDECK
          SPACE  4
**        SETNEWPL  SET UP NEWPL FILE                                   01255272
*                                                                       01255273
*         IF NO NEWPL IS TO BE PRODUCED, NEWPL WILL BE                  01255274
*         ZERO, AND THE NEWPL INITIALIZATION CODE WILL                  01255275
*         BE SKIPPED.  THE RANDOM BIT (FET WORD 5, BIT                  01255276
*         47) IS REMOVED FROM THE NEWPL FET IF THE W OR                 01255277
*         B OPTION HAS BEEN SPECIFIED.  NEWPL IS OPENED                 01255278
*         AND THE RANDOM BIT IS CHECKED.  IF IT IS PRESENT,             01255279
*         THE NEWPL WILL BE A RANDOM PL.  NO FURTHER                    01255280
*         INITIATION NEED BE DONE IF B MODE IS SPECIFIED.               01255281
*         IF THE NEWPL IS TO BE RANDOM, RANDNPL IS SET                  01255282
*         + NON-ZERO.  IF NEWPL IS TO BE SEQUENTIAL,                    01255283
*         RANDNPL IS SET NEGATIVE, THE NEWPL WRITE ROUTINE              01255284
*         CALLS ARE RESET TO CALL THE CHECKSUMMED WRITES                01255285
*         AND DUMPLIST IS CALLED TO WRITE THE DECK LIST AND             01255286
*         DIRECTORY TO THE NEWPL.  IF THE Q OPTION WAS NOT              01255287
*         AND IF NO NEWPL OR SOURCE FILE IS TO BE GENERATED,            01255288
*         FMODE, WHICH HAS LOST ANY ORIGINAL SIGNIFICANCE               01255289
*         SINCE IT IS OVER BY THE Q OPTION, IS SET TO 0                 01255290
*         SPECIFIED OR IF THE INITIALIZATION IS NEEDED.                 01255291
*         FOR USE AS A FLAG.  AT THIS TIME, FASTFLG IS                  01255292
*         SET NEGATIVE NON-ZERO IF K HAS BEEN SPECIFIED.                01255293
*         IF NEWPL OR SOURCE IS TO BE PRODUCED IN Q MODE                01255294
*         WITH A RANDOM OLDPL, SETNEWPL ALSO SEARCHES ALL               01255295
*         DECKS WHICH ARE TO BE PROCESSED FOR CALL CARDS                01255296
*         TO INSURE THAT THE NEWPL WILL CONTAIN ALL COMDECKS            01255297
*         WHICH ARE NEEDED.  NOTE THAT THIS SEARCH IS ONLY              01255298
*         DONE TO ONE LEVEL, SO A COMDECK CALLED ONLY BY                01255299
*         A COMDECK WILL NOT BE INCLUDED UNLESS SPECIFIED               01255300
*         ON A COMPILE CARD.                                            01255301
*                                                                       01255302
*         IF IN NORMAL MODE, COMDECKS CALLED BY DECKS SPECIFIED ON       UPD0319
*         *COMPILE DIRECTIVES ARE ENTERED INTO TABLE DKLIS. THIS IS DONE UPD0319
*         TO INSURE THAT THE CALLED COMDECK IS AUDITED IF AUDIT IS       UPD0319
*         SPECIFIED.                                                     UPD0319
*                                                                        UPD0319
*         *** WARNING - PRECAUTION MUST BE TAKEN PRIOR TO ANY TABLE 
*                       MANAGEMENT CALLS MADE WHILE IN THIS ROUTINE.
*                       THIS IS BECAUSE OF THE CHANGE MADE TO *L.DIRECT*
*                       BY THE CALL MADE AT LOCATION *NOTQMODE*.
*                       PRESENTLY, THIS PRECAUTION IS NECESSARY ONLY AT 
*                       THE CALL AT *SETPL8.1* TO *CRDKLIS*.  NOTE USE
*                       OF THE TEMP *SETPLXA*.
* 
*         CALLS  OPENPL, CPCLEAR, DUMPLIST, CHKDCKS, ROPL, CLASSIFY,
*                SCITEM, CRDKLIS, MOVEIT. 
SETNEWPL  PS
          SA1    NEWPL
          ZR     X1,SETPL5
          RJ     OPENNPL     OPEN,REWIND(IF OK) THE NEWPL TO BE WRITTEN.0658  66
          SA6    RANDNPL
          SA2    CPYFMLIB 
          NZ     X2,SETNEWPL       EXIT IF IN B MODE
          PL     X6,SETPLY         IF NEWPL IS RANDOM.                  0658  69
          SA1    CPYTOLIB          IF A OPTION IS ON NEWPL MUST BE
          NZ     X1,CPYLIBER       RANDOM.
          MX7    0
          SA7    RJWBIN            SET TO DO WRITE WITH CHECKSUM
          SA1    EDITFLAG 
          NZ     X1,SETPL5         IF EDITFLAG SET
          RJ     DUMPLIST 
SETPL5    SA1    RANDOPL           RANDOM OR SEQUENTIAL OLDPL FLAG.      UPD0319
          ZR     X1,SETNEWPL       IF SEQUENTIAL OLDPL, *** EXIT ***.    UPD0319
          SA3    FASTFLG           ELSE GET QUICK MODE UPDATE FLAG.      UPD0319
          NZ     X3,SETPL5A        IF Q MODE UPDATE. CHECK FOR *CALLS.   UPD0319
          SA1    FMODE             ELSE GET FULL MODE UPDATE FLAG.       UPD0319
          NZ     X1,SETNEWPL       IF FULL MODE UPDATE, *** EXIT ***.    UPD0319
          EQ     SETPL5B           ELSE NORMAL MODE. CHECK FOR *CALLS.   UPD0319
          SPACE  1                                                       UPD0319
SETPL5A   SA1    SOURCE            PREPARE TO CHECK WHETHER NEWPL OR     UPD0319
          SA2    NEWPL              SOURCE ARE SPECIFIED.                UPD0319
          BX0    X1+X2
          ZR     X0,SETPLS         JUMP IF NO SOURCE OR NEWPL 
SETPL5B   SA1    L.DKLIS           AT THIS POINT IN PROCESSING, L.DKLIS  UPD0319
          BX6    X1                 CONTAINS NO. OF DECKS *COMPILED.     UPD0319
          SA6    WORKLGTH          SET WORKLGTH TO NUMBER OF DECKS.      UPD0319
SETPL6    SA3    WORKLGTH 
          NZ     X3,SETPL6A 
          SA1    CLDKS
          ZR     X1,SETPL9         CHECK IF ANY DECKS ADDED 
          SX6    X1-1              REDUCE CALLED DECK COUNT 
          SA2    F.DKLIS
          SA6    A1 
          IX0    X2+X6
          EQ     SETPL6B
          SPACE  1
SETPL6A   SA1    L.DKLIS
          SA2    F.DKLIS
          SX6    X3-1              SEARCH ALL DECKS SPECIFIED ON COMPILE
          IX0    X2+X1             ON COMPILE CARDS FOR CALLS TO
          IX0    X0-X3             COMMON DECKS AND ENTER THE NAMES OF
          SA6    A3                ALL CALLED COMMON DECKS INTO THE LIST
SETPL6B   SA4    X0 
          BX7    X4 
          LX4    58 
          NG     X4,SETPL6         IF FAKE ENTRY
          RJ     CHKDCKS
          SA2    A2+B1
          BX6    X2 
          ZR     X2,SETPL6         NOT A DECK ON OLDPL
          SA6    OLDPL+6
          CLEAR  OLDPL,READ 
SETPL7    RJ     ROPL 
          NZ     X1,SETPL6
          SA1    CARDSTAT 
          PL     X1,SETPL7         IF CARD IS INACTIVE. 
          SB4    SPARLIST 
          RJ     CLASSIFY 
          CLASIFY 
          ZR     X1,SETPL7
          CCJUMP CALL,SETPL8
          EQ     SETPL7 
          SPACE  1
SETPL8    RJ     SCITEM 
          SA7    TCRDEC5           ENTER THIS COMDECK IN LIST 
          RJ     CHKDCKS           SEARCH DECK LIST.
          NZ     X0,SETPL8.1       DECKNAME NOT FOUND.
          LX2    59-3              GET DECK BIT.
          NG     X2,SETPL7         IF DECK BIT, DONT PUT IN TABLE.
 SETPL8.1 SA7    TCRDEC5           ENTER THIS COMDECK IN LIST 
          SA2    SETPLXA     TRUE *L.DIRECT* LENGTH OR ZERO 
          ZR     X2,SETPL8.2 IF *L.DIRECT* HAS ITS TRUE VALUE 
          BX6    X2          SET IT TO SUCH 
          SA6    L.DIRECT 
 SETPL8.2 BX1    X7          (X1) = NAME
          RJ     CRDKLIS     CREATE ENTRY IN *DKLIS*
          SA3    SETPLXA     TRUE *L.DIRECT* LENGTH OR ZERO 
          ZR     X3,SETPL8.3 IF ABOVE CHANGE WAS NOT DONE 
          SA4    ORGLGTH     SET *L.DIRECT* BACK TO ORIGINAL LENGTH 
          BX6    X4 
          SA6    L.DIRECT 
 SETPL8.3 NZ     X2,SETPL7   IF COMDECK NAME WAS JUST ADDED, MOVE IT
          SA3    F.DKLIS      TO FRONT OF THE LIST
          SA4    L.DKLIS
          MOVE   X4-1,X3,X3+B1
          SA1    F.DKLIS
          SA2    TCRDEC5
          SX7    B1 
          BX7    X7+X2
          SA7    X1 
          SA1    CLDKS
          SX6    X1+B1             INCREASE COUNT OF CALLED DECKS 
          SA6    A1 
          EQ     SETPL7 
          SPACE  1
 SETPL9   CLEAR  OLDPL,READ 
          SA2    F.DECKS
          SA2    X2+B1
          BX6    X2 
          SA6    OLDPL+6           RESET TO READ IN YANK DECK FIRST 
          EQ     SETNEWPL 
          SPACE  1
SETPLS    SA1    ORDERFLG 
          MX6    60 
          MX7    1
          SA6    FMODE
          ZR     X1,SETNEWPL
          SA7    A3 
          EQ     SETNEWPL 
          SPACE  1
SETPLY    BSS    0                 NEWPL TO BE RANDOM.                  0658  71
          SX6    RANDTEMP          SET RANDOM WRITE 
          SA6    NEWPL+6           INDEX. 
          EQ     SETPL5 
  
 SETPLXA  CON    0           SET NZ IF NECESSARY TO RESTORE *L.DIRECT*
                              PRIOR TO ANY TABLE MANAGEMENT 
SPP       SPACE  4,5
**        SPP - SET PRINT PAGE PARAMETERS.
* 
*         ENTRY  (A0) = FILE FET ADDRESS
* 
*         EXIT   PRINT DENSITY CODE WRITTEN IF NOT TTY FILE 
* 
*         CALL   CPM=,STF,CPCLEAR,WRITEC. 
* 
  
 SPP      PS                 ENTRY/EXIT 
  
          SA1    A0          GET FILE NAME
          ZR     X1,SPP      IF NO FILE NAME THERE
  
          GETPAGE SPPA       GET JOB PAGE PARAMETERS
          SA1    SPPA 
          MX0    -8 
          AX1    12 
          BX6    -X0*X1 
          SA6    JPW         SAVE JOB PRINT WIDTH 
          AX1    8
          BX6    -X0*X1 
          SA6    JPS         JOB PAGE SIZE
          AX1    8+1         JOB PRINT DENSITY / 2
          MX0    -3 
          BX6    -X0*X1 
          SX6    X6+1RS-6/2  FORM DISPLAY CODE *PD* 
          SA2    MODEO       GET PRINT FILE MODE ( 6 OR 8 ) 
          LX6    -6 
          NG     X2,SPP1     IF 6 BIT MODE
          LX6    6
          SX6    X6+100B     CONVERT OT ASCII CODE
          LX6    -12
 SPP1     SA6    JPD         PRINT IMAGE OF CURRENT PRINT DENSITY 
  
*         CHECK TERMINAL OUTPUT FILE
  
          ENV    NOT,(2,3),TTY
          SX2    A0 
          RJ     STF
          SA6    TTY
 TTY      ENDIF 
  
          CLEAR  A0,WRITE    FORCE WRITE OP-CODE
          SA1    TTY
          ZR     X1,SPP      IF TTY OUTPUT FILE 
  
          WRITEC A0,JPD 
          EQ     SPP
  
 SPPA     BSSZ   2           GETPAGE PARAMETER RETURN AREA
          SPACE  2                                                      0658   5
*     OPENNPL    THIS ROUTINE OPENS AND REWINDS(UNLESS REWIND SUPPRESSED0658   6
*                THE NEWPL.                                             0658   7
*     EXIT - X6=1 IF NEWPL IS TO BE RANDOM                              0658   8
*            X6 IS NEGATIVE IF NEWPL TO BE SEQUENTIAL                   0658   9
          SPACE  1                                                      0658  10
OPENNPL   DATA   0                                                      0658  18
          SA2    NORANDOM          FETCH CALL CARD -W- PARAMETER VALUE. 0658  19
          SA4    NOREWFLG                                               0658  20
          SA3    NEWPL+1                                                0658  21
          SX1    LRANIDX
          SX6    RANIDX 
          MX7    0                                                      0658  24
          LX1    18                                                     0658  25
          SA7    X6                CLEAR WORD 1 OF POSSIBLE INDEX BUFFER0658  26
          BX6    X1+X6                                                  0658  27
          SA6    NEWPL+7           SET IDNEX INFO IN FET IF NEWPL AREADY0658  28
          SA3    NEWPL+1                                                658A   5
          ZR   X2,OPENNPL1         NOT W OPTION                         658A   6
          MX2    1                                                      658A   7
          LX2    48D                                                    658A   8
          BX6    -X2*X3                                                 658A   9
          SA6    A3                CLEAR RANDOM BIT IN NEWPL FET        658A  10
*                                  EXISTS ON RANDOM FILE OF SAME NAME.  0658  29
 OPENNPL1 MX2    -18               GET INFO ABOUT NEWPL 
          SA1    NEWPL             GET NEWPL NAME 
          BX1    X1*X2             ZERO OUT REST OF WORD
          SX2    50000B            ADD LENGTH OF REQUEST BUFFER 
          BX6    X1+X2
          SA6    FILEINFO          STORE NAME AND STORAGE LENGTH. 
  
          ENV    ACT,(2,3),VER2 
*         SEE FILINFO MACRO IN SYSTEXT FOR FORMAT OF INFO. RETURNED 
*         BY THIS CALL. 
+         VFD    30D/0130001101B,12D/,18D/FILEINFO
  
 VER2     ELSE
          FILINFO FILEINFO
  
 VER2     ENDIF 
  
          LX4    59-2                                                   0658  31
          NG     X4,OPENNPL2       IF NEWPL TO BE REWOUND BEFORE RUN.   0658  32
          OPEN   NEWPL,WRITENR     OPEN FOR WRITE,DONT REWIND.          0658  33
          EQ     OPENNPL3                                               0658  34
OPENNPL2  BSS    0                                                      0658  35
          OPEN   NEWPL,WRITE       OPEN FOR WRITE-REWIND NEWPL.         0658  36
*                                                                       0658  38
          ENV    ACT,(11),VER2
          REWIND NEWPL                                                  0658  40
 VER2     ENDIF 
OPENNPL3  BSS    0                                                      0658  41
* 
* PREPARE NEWPL FOR USE 
* 
          CLEAR  NEWPL,WRITE
          SA1    FILEINFO+1 
          MX0    -6 
          BX3    -X0*X1            FILE TYPE
          SX3    X3-4              PERMANENT (DIRECT ACCESS)
          MX0    -4 
          AX1    6
          BX1    -X0*X1            PERMISSIONS
          ZR     X1,OPNNPL1B       NEW LOCAL FILE 
          LX1    59-7+6            IF ANY BITS ARE SET, WRITE MUST BE SET 
          PL     X1,OPNNPLE        ERROR, CANT WRITE
          NZ     X3,OPNNPL1        THIS IS ENOUGH FOR NON-PERM FILES
          SX1    X1-3              MUST HAVE MODIFY+EXTEND FOR PERM FILES 
          ZR     X1,OPNNPL1        OK 
          SPACE  1
 OPNNPLE  MESSAGE  (=C+*** ERROR, NO PERMISSION TO WRITE NEWPL ***+)
          EQ     ABORT
          SPACE  1
* 
 OPNNPL1  SA1    A1                FILEINFO+1 
          =X6    X3+4-3            CHECK FOR PUNCH DISPOSITION
          LX1    59-15             CHECK FOR MASS STORAGE RESIDENCE 
          ZR     X6,OPNNPL4A       PUNCH FILE 
          PL     X1,OPNNPL4A       NOT ON MASS STORAGE (MAKE SEQ) 
  
 OPNNPL1B SA1    NEWPL+1
          LX1    12                GET RANDOM BIT 
          PL     X1,OPNNPL4        SEQUENTIAL PL
* 
          MX6    1                 RANDOM FILE
          BX6    -X6*X1            CLEAR RANDOM BIT 
          LX6    60-12
          SA6    A1 
          NZ     X3,OPNNPL2        IF LOCAL, RANDOM FILE
          SA6    DIRNEWPL          FLAG FOR LATER CLOSE ACTION
          REWIND NEWPL,RECALL      PERMANENT RANDOM FILES 
          SPACE  1
          ENV    ACT,(1,7,8,9),NOS
          WRITER NEWPL,RECALL      NOS ONLY 
 NOS      ELSE
          ALTER  NEWPL,RECALL      ALL OTHER SYSTEMS
 NOS      ENDIF 
          SPACE  1
          EQ     OPNNPL3
* 
 OPNNPL2  BSS    0
          ENV    ACT,(2,3),VER2 
          REWIND NEWPL
 VER2     ELSE
          EVICT  NEWPL,RECALL 
 VER2     ENDIF 
 OPNNPL3  SA1    NEWPL+1           RESTORE RANDOM BIT 
          MX6    1
          LX6    48 
          BX6    X1+X6
          SA6    A1 
          CLEAR  NEWPL,WRITE
          SX6    B1                FLAG AS RANDOM 
          EQ     OPENNPL
* 
* SEQUENTIAL PL 
* 
 OPNNPL4  BSS    0
  
 OPNNPL4A BSS    0
          ENV    NOT,(1,7,8,9),NOS
          NZ     X3,OPNNPL5        ALL SYSTEMS BUT NOS
          ALTER  NEWPL,RECALL 
 NOS      ENDIF 
          SPACE  1
 OPNNPL5  CLEAR  NEWPL,WRITE
          SA1    EDITFLAG 
          ZR     X1,OPNNPL6        USE GIVEN PL IF NOT EDITING (OR CREATE)
          SA2    TEMPNEW           USE TEMPORARY NEWPL FOR SEQUENTIAL OUTPUT
          SA1    NEWPL
          BX6    X2 
          LX7    X1 
          SA6    A1 
          SA7    HOLD              PLACE TO SAVE REAL NEWPL NAME
          OPEN   NEWPL,WRITE       OPEN WITH REWIND 
          REWIND NEWPL
          CLEAR  NEWPL,WRITE
 OPNNPL6  MX6    1                 SHOW SEQUENTIAL PL 
          SA6    NORANDOM 
          EQ     OPENNPL
          EJECT  4                                                      01257507
**        SETUPOLD  SET UP TO READ OLD STYLE  PL                        01255306
*                                                                       01255307
*         THIS ROUTINE IS CALLED WHEN THE FIRST WORD OF                 01255308
*         AN OLDPL DOES NOT CONTAIN CHECK IN THE TOP 30                 01255309
*         BITS.  IT IS ASSUMED THAT THE OLDPL IS A PRE-                 01255310
*         VERSION 1.2 PL.  ALL READ CALLS ARE SET TO THE                01255311
*         NON-CHECKSUMMED READ ROUTINE.  ALL CALLS TO THE               01255312
*         OLDPL PROCESSOR ARE RESET TO READOPL INSTEAD OF               01255313
*         ROPL.  A TABLE IS SET UP AND CLEARED IN CNTR                  01255314
*         WHICH IS THE SAME SIZE AS DIRECT.  THIS TABLE                 01255315
*         WILL BE USED TO ACCUMULATE SEQUENCE NUMBERS.                  01255316
*         EDITFLAG IS SET POSITIVE ZERO IF NO EDIT IS RE-               01255317
*         QUIRED, POSITIVE NON-ZERO IF EDIT IS REQUIRED.                01255318
*                                                                       01255319
*         CALLS  MANAGER, CALLPP                                        01255320
          IF     -DEF,OLDPLKEY,1
SETUPOLD  EQ     CORR2T 
          SPACE  1
D         IF     DEF,OLDPLKEY 
 SETUPOLD SX7    B1 
          SA7    RJRBIN            SET TO USE NON-CHECKSUM READ 
          SA7    RJROPL            SET TO USE READOPL 
          MX7    0                 SET PRE-SCOPE 3.3 TO 63 TYPE         0214  56
          SA7    CHG63                                                  0214  57
          SA2    TEMP              CNTR IS USED WHILE READING 
          AX2    18                OLD STYLE PLS TO KEEP TRACH OF 
          SX1    X2+B1
          NG     X1,CORR2T         ERROR IF NEGATIVE NUMBER 
          SX3    X2-LGSTTAB 
          PL     X3,CORR2T         ERROR IF TOO LARGE 
          ALLOC  CNTR,X1
          SA1    EDITFLAG 
          MX7    0
          SA7    A1 
          SA7    RDCHSUM
          SPACE  1
          IF     DEF,CHAR64,2 
          MX7    60 
          SA7    CHARKEY
          SB5    X3-1 
SETUPOL1  SA7    X2+B5             CLEAR OUT COUNTERS 
          SB5    B5-B1
          PL     B5,SETUPOL1
          ZR     X1,RCHK1 
          SX7    B1 
          SA7    A1                RESET EDITFLAG IF NECESSARY. 
          EQ     RCHK1
D         ENDIF 
          SPACE  1
          SPACE  1
 CORR2Q   MESSAGE P1PLERR 
          SA1    LISTONE
          ZR     X1,ABORT 
          RJ     PRINTERR 
          PRINT  (0*** NO OLDPL, NOT CREATION RUN, UPDATE ABORT. ***) 
          EQ     ABORT
          SPACE  1
 CORR2T   MESSAGE P1GHERR 
          SA1    LISTONE
          ZR     X1,ABORT 
          PRNTCARD
          PRINT  (0*** GARBAGE IN OLDPL HEADER, UPDATE ABORT. ***)
          EQ     ABORT
          EJECT  4                                                      01257509
**        UPDATEA  A AND B MODE PROCESSING                              01255322
*                                                                       01255323
*         THE SECTION OF CODE AT LOCATIONS FROM UPDATEA                 01255324
*         THROUGH AND INCLUDING UPDATEB6 IS A COLLECTION                01255325
*         OF SHORT CUTS WHICH ARE TAKEN IN A OR B MODE.                 01255326
*         A AND B MODE REALLY CONSITS OF SEPARATE AND                   01255327
*         DISTINCT PATHS THROUGH UPDATE, HOWEVER, SOME                  01255328
*         SECTIONS OF THE NORMAL CODE THAT ARE USED FOR                 01255329
*         THE A AND B PATHS, JUMP IN AND OUT OF THE MAIN                01255330
*         PATH AT SEVERAL PLACES.  THIS SECTION OF CODE                 01255331
*         FILLS IN THE GAPS WHERE THE A AND B MODE PATHS                01255332
*         ARE NOT EVEN CLOSE TO THE NORMAL PATH.                        01255333
*                                                                       01255334
*         CALLS  ADDWORD, COPYOPL, DUMDIR, MANAGER, MOVEIT, SETNEWPL,   01255335
*                DUMPLIST, CALLPP, CPCLEAR, RBIN, CALLIO                01255336
UPDATEA   MX6    60                THIS CODE IS USED TO SET FLAGS AND 
          SA6    RANDNPL           CALLS FOR -A- MODE 
          MX6    1
          SA6    EDITFLAG 
          SA1    =7LYANK$$$ 
          ADDWRD NEWDKS,X1
          ADDWRD DECKS,X1 
          SX0    B1 
          BX1    X1+X0
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
UPDATEA1  SX6    B1 
          SA1    TTY
          ZR     X1,UPDATE.A IF TTY, LIMIT LIST OPTION DEFAULT
          SA6    LISTA
 UPDATE.A SA6    LISTONE     SET ERROR OPTION 
          MX0    6                 CREATE MASK
          SA1    AUDIT             FETCH LISTING OPTIONS. 
          BX6    X1 
          NZ     X6,NOT0OPT        IF NOT 0 OPTION
          SA6    OUTPUT            DONT ALLOW ANY OUTPUT
NOT0OPT   SA1    NEWPL             SET DEFAULT OF NEWPL IF A SUBSTITUTE 
          NZ     X1,UPDATEB1       NAME HAS NOT BEEN COMPILED 
          SA2    TEMPNPL
          BX6    X2 
          SA6    A1 
          EQ     UPDATEB1 
          SPACE  1
UPDATEB2  SA1    =7LYANK$$$ 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ADDWRD DIRECT,X1
S2LCM     ELSE
          RJ     ADDWRDL
S2LCM     ENDIF 
          SPACE  1
          ADDWRD DECKS,X1 
          MX6    60 
          SA6    EDITFLAG          CLEAR THE EDIT FLAG
          EQ     UPDATEA1    GO SET UP NAME OF NEWPL AND DEFAULT
*                            LIST OPTIONS 
  
UPDATEA2  RJ     COPYOPL
          EQ     UPDATEA3 
          SPACE  1
UPDATEB3  SA1    L.DECKS
          ALLOC  NEWDKS,X1
          SX1    X3 
          SX3    X2 
          SA2    F.DECKS
          MOVE   X1,X2,X3 
          SX6    B1 
          SA6    NORANDOM 
          RJ     SETNEWPL 
          RJ     DUMDIR 
          RJ     DUMPLIST 
UPDATEB4  SA1    L.DECKS
          ZR     X1,UPDATEB6
          SA2    F.NEWDKS 
          SA3    L.NEWDKS 
          SX6    X1-2 
          IX0    X2+X3
          SA6    A1 
          IX0    X0-X1
          SA2    X0+B1
          ZR     X2,UPDATEB4
          BX6    X2 
          SA6    OLDPL+6
          SA1    A2-B1
          MX0    54 
          BX7    X0*X1
          SA7    CPMSG+1
          MESSAGE CPMSG,1 
          CLEAR  OLDPL,READ 
 UPDATEB5 READW  OLDPL,TEMP1,1
          NZ     X1,UPDATEB4
          SA1    TEMP1
          BX6    X1 
          SA6    SQLGN
 UPDATEB8 WRITEWC  NEWPL,TEMP1,1
          SA1    TEMP1
          MI     X1,UPDATEB9 IF THIS LAST WORD OF CHBS
          READW  OLDPL,TEMP1,1
          EQ     UPDATEB8 
 UPDATEB9 SA1    SQLGN
          LX1    24 
          SX7    X1                WORD COUNT 
          LX1    60-24+59-S.8BIT   8-BIT BIT
          SA7    SQLGN
          BX6    X1 
          SA6    SQLGN8 
          ZR     X7,UPDATEBA       NULL CARD
          READW  OLDPL,A7+B1,X7 
 UPDATEBA SA2    SQLGN8 
          NG     X2,UPDATEB7       NEVER HAVE TO CONVERT 8-BIT
  
          IF     -DEF,CHAR64,1
          EQ     UPDATEB7 
  
          IF     DEF,CHAR64,1 
          EQ     ROPLCH      POSSIBLE CHARACTER SET CONVERSION
  
 UPDATEB7 SA1    SQLGN
          WRITEWC  NEWPL,A1+B1,X1 
          EQ     UPDATEB5 
          SPACE  1
 UPDATEB6 WRITEW NEWPL,WRCHSUM,1
          WRITER NEWPL
          CLOSE  OLDPL
          WRITEF NEWPL
          SPACE  1
          ENV    NOT,(1,7,8,9),NOS
          SA1    DIRNEWPL          RESET END OF PERMANENT FILE
          ZR     X1,UPDATEBB       NOT PERMANENT (DIRECT ACCESS)
          ALTER  NEWPL
 NOS      ENDIF 
          SPACE  1
 UPDATEBB BKSP   NEWPL
          SA1    NOREWFLG 
          LX1    59-2 
          PL     X1,NOAUDIT 
          REWIND NEWPL
          EQ     NOAUDIT
          TITLE  PASS 1 MAIN LOOP 
*    RETURN HERE AFTER PROCESSING CONTROL CARD                         *
          SPACE  1
CORR6     SA1    LISTTWO           LISTTWO ON INDICATES PRINT 
          ZR     X1,CORR5A         CONTROL CARDS
          EQ     CORR6A 
          SPACE  1
*    RETURN HERE AFTER PROCESSING NON-CONTROL CARD                     *
          SPACE  1
CORR5     SA1    LISTFOUR          LISTFOUR ON INDICATES PRINT
          ZR     X1,CORR5A         NON-CONTROL CARDS
 CORR6A   PRNTCARD
CORR5A    RJ     READCD            READ NEXT CARD FROM I FILE 
 CORR5B   BSS    0                 READCD MAY RETURN HERE FOR FIRST CARD
          NZ     X1,ECOR           JUMP TO PASS 2 AT END-OR-RECORD
CORR3     CLASIFY 
          ZR     X1,CORR3C         JUMP IF NOT CONTROL CARD 
          MX6    0
          SA6    DEFAULT           ZERO DEFAULT-ID EXPANSION FLAG 
          CCJUMP IDENT,CORID
          CCJUMP PURGE,CORPU
          CCJUMP COPY,CORCOPY 
          CCJUMP COMPILE,CMPL 
          CCJUMP ADDFILE,CORAD
          CCJUMP SEQUENCE,CORSEQ
          CCJUMP CHANGE,CORCHG
          CCJUMP SELPURGE,CORSELP 
          CCJUMP MOVE,CORMOVE 
          CCJUMP PURDECK,CORPD
          SPACE  1
          IF     DEF,PMODKEY,1
          CCJUMP PULLMOD,CORPM
          EJECT 
CORR3C    SA1    IDFLG             IF IDFLG IS NON-ZERO (INDICATING AN
          NZ     X1,CORR3A         ACTIVE IDENT) GO TO PROCESS POSSIBLE 
          SA1    NEWPL             INSERTS, DELETES, ETC. OTHERWISE 
          NZ     X1,CORER          USE THE SUBSTITUTE IDENT .NO.ID. 
          SA1    =7L.NO.ID.        IF A NEWPL IS NOT REQUESTED. 
          BX6    X1 
          SA6    IDNAM
          SA1    L.DIRECT 
          MX7    0                 SET IDENT FLAG, CLEAR INSERT FLAG, 
          BX6    X1                AND GO ON TO PROCESS CARD. 
          SA7    INSFLG 
          SA6    IDFLG
          MX1    0
          ADDWRD COUNT,X1 
          SX6    X3-1 
          SA6    POINTER
          SA1    LISTONE
          ZR     X1,CORR3A
          PRINT  P1DFIDT,9
          SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     CORR3A 
          SPACE  4
*    ENTER HERE WITH ACTIVE IDENT TO PROCESS INSERT, DELETE, ETC       *
          SPACE  1
CORR3A    CLASIFY 1 
          ZR     X1,CORR3B
          CCJUMP INSERT,CORIN 
          CCJUMP DELETE,CORDE 
          CCJUMP YANK,CORYA 
          CCJUMP RESTORE,CORRE
          CCJUMP BEFORE,CORBE 
          CCJUMP SELYANK,CORSEYA
          CCJUMP YANKDECK,CORYD 
          CCJUMP DECK,STDKBIT6                                           CP190
          CCJUMP COMDECK,CKINSTFG 
          CCJUMP DEFINE,CORYA1
          CCJUMP CALL,CORCA                                             0062   9
CORR3B    SA2    INSFLG            ARE INSERTIONS VALID 
          ZR     X2,CORER          NO 
          RJ     ENTTEXT           GO PUT TEXT ON TEMP FILE 
          EQ     CORR5
CKINSTFG  SA2    INSFLG            CHECK IF INSERTS ALLOWED 
          NZ     X2,CORR4A         INSERTS OK 
          EQ     CORER
  
          EJECT  4                                                      01257514
          TITLE  PASS 2 INITIALIZATION
          EJECT 
**         END OF PASS 1                                                01257258
*                                                                       01257259
*         WHEN THE END OF THE INPUT STREAM IS ENCOUNTERED, UPDATE CHECKS01257260
*         TO SEE WHETHER OR NOT FATAL ERRORS WERE ENCOUNTERED           01257261
*         DURING PASS 1.  IF FATAL ERRORS DID OCCUR, UPDATE ABORTS      01257262
*         UNLESS THE U OPTION WAS SPECIFIED.                            01257263
*                                                                       01257264
          SPACE  1
 ECOR     BSS    0
          SX2    -1 
          MX7    0                 (ZERO OUT TXTFLAG TO AVOID TROUBLE 
          SA7    TXTFLAG           CAUSED BY INSERTING A TEXT CARD) 
          RJ     DUMTXT            INTO THE DIRECTORY. IF THERE ARE NO
          RJ     CORIDX            FATAL ERRORS SO FAR JUMP TO -ECOR0-, 
          SA1    ERRORS            OTHERWISE DEFEAT NEWPL, SOURCE, AND
          ZR     X1,ECOR0          COMPILE FILES, PRINT AND ENTER INTO
          SA2    ERRMODE
          NZ     X2,EMODE 
          MX6    0                 DAYFILE APPROPRIATE ERROR MESSAGES 
          SA6    NEWPL             AND JUMP TO -ECOR0- TO CONTINUE. 
          SA6    COMP 
          SA6    SOURCE 
EMODE     BSS    0
          RJ     CONDEC 
          SA6    ERINLNM
          MX7    30 
          BX6    -X7*X6 
          SA1    ERINLN 
          BX7    X7*X1
          BX7    X7+X6
          SA2    LISTONE
          ZR     X2,EMODE1   IF L=1 NOT SELECTED
          SA7    A1 
          SA2    ERRMODE
          NZ     X2,EMODE2   IF U OPTION SELECTED 
          PRINT  ERINLN,7 
EMODE1    MESSAGE ERINLNM 
          SA1    ERRMODE           (REGISTERS MAY BE DESTROYED BY PRINT)
          NZ     X1,ECOR0          IF U MODE SELECTED, CONTINUE 
          EQ     ABORT             ELSE BOMB THE JOB
  
EMODE2    PRINT  ERINLN,3 
          EQ     EMODE1      GO ISSUE DAYFILE MESSAGE 
  
ERINLNM   DIS    1, 
          DIS    ,+ ERRORS IN UPDATE INPUT+ 
          SPACE  1
ERINLN    DIS    1,0*** 
          DIS    6, ERRORS IN INPUT.   NEWPL, COMPILE, SOURCE SUPPRESSED
,. ***
          TITLE  PASS 2 MAIN LOOP 
          EJECT  6                                                      01257517
**                                                                      01257266
*         INITIALIZATION FOR PASS 2 CONSISTS OF THE FOLLOWING:  IF      01257267
*         PULLMOD CARDS WERE ENCOUNTERED, THE INPUT FET IS SET UP TO BE 01257268
*         USED AS THE UPDTPMD FILE; THE PURGE BIT IS SET FOR ANY IDENTS 01257269
*         WHICH ARE TO BE SEQUENCED SO THAT ANY CARDS BELONGING TO THE  01257270
*         SEQUENCED IDENT WHICH EXIST OUTSIDE OF THE SEQUENCED DECK     01257271
*         WILL BE PURGED; THE READFIL FET IS SET UP TO BE USED AS       01257272
*         AUDITING IS TO TAKE PLACE; WORKLGTH IS SET TO CONTAIN THE     01257273
*         NUMBER OF DECKS WHICH WILL BE PROCESSED.                      01257274
*         THE COMDECK TABLE IS BUILT HERE FROM THE SECONDARY OLDPLS.     CP190
*         SECONDARY OLDPLS ARE OPENED, CHECKED TO MAKE SURE THAT THE     CP190
*         LFN IS NOT A DUPLICATE OF A LFN IN ANOTHER FET, CHECKED TO     CP190
*         MAKE SURE ITS RANDOM AND THAT THE CHARACTER SETS AND MASTER    CP190
*         CONTROL CHARACTERS ARE THE SAME. THEN THE DECK LIST IS READ    CP190
*         AND THE COMDECK TABLE IS BUILT. IF WHILE READING THE DECK      CP190
*         LIST, A DECK BIT IS ENCOUNTERED, THEN THAT DECK LIST ENTRY     CP190
*         IS NOT ADDED TO THE COMDECK TABLE. AFTER THE DECKLIST          CP190B 
*         IS READ, THE DIRECTORY IS READ OFF OF THE SECONDARY OLDPL      CP190B 
*         AND APPENDED TO THE DIRECTORY TABLE. THIS HAS TO BE DONE       CP190B 
*         SO THAT THE ORIGINAL CARD IDENTIFIER CAN BE ASSIGNED TO        CP190B 
*         CARDS OBTAINED FROM SECONDARY OLDPLS.                          CP190B 
*                                                                       01257275
ECOR0     MOVE   3,COMCHG,TITLE+3 
          SA1    L.DIRECT          FETCH DIRECTORY LENGTH.               UPDA165
          BX6    X1                                                      UPDA165
          SA6    ORGLGTH           STORE ORIGINAL DIRECT LENGTH.         UPDA165
          SA4    SCNUM             IF THERE ARE NOT ANY                  CP190
          ZR     X4,CONT           SECONDARY OLDPLS TO PROCESS.          CP190
          SB4    B0                                                      CP190
BEGIN     SB5    SCNDPL            POINT TO BEGINNING OF TABLE.          CP190
          SA1    B5+B4             POINT TO CORRECT ENTRY.               CP190
          SX2    A1                                                      CP190
          SX3    3                 STATUS BITS FOR FWA OF FET.           CP190
          PX7    X2,B4             PACK ADDRESS AND POINTER.             CP190
          SA7    INDX                                                    CP190
          BX6    X1+X3                                                   CP190
          SA6    OLDPL2            PUT NAME INTO FET.                    CP190
          SA4    L.DIRECT          OBTAIN LENGTH OF DIRECTORY.           CP190B 
          BX7    X4                                                      UPDA168
          SA7    DIRLTH            SAVE LENGTH OF PRIMARY OLDPL DIRECT.  UPDA168
          BX6    X4+X1             OR AMOUNT OF OFFSET WITH PL NAME.     CP190B 
          SA6    A1                PUT NAME PLUS OFFSET IN TABLE.        UPDA168
          CHKFILE OLDPL2           CHECK FOR DUPLICATE OR GT 7 CHARS.    CP190
          SX2    LSRANIX           LENGTH OF RANDOM INDEX.               CP190
          SX6    SRANIX            WHERE RANDOM INDEX WILL BE.           CP190
          LX2    18                                                      CP190
          BX6    X6+X2             COMBINE RANDOM INDEX ADD AND LGTH.    CP190
          SA6    OLDPL2+7          STORE IN FET.                         CP190
          MX7    0                                                       CP190
          SA7    X6                CLEAR IT.                             CP190
 SETOPN   BSS 
          SA1    OLDPL2+1          FETCH FET + 1
          MX6    1
          LX6    45 
          BX6    X6+X1
          SA6    A1                SET ERROR PROC BIT 
          OPEN   OLDPL2,READ,RECALL  OPEN SECONDARY OLDPL.
          SA1    OLDPL2             FETCH FET+ 0
          SA4    OLDPL2+1 
          MX6    55 
          LX6    9
          BX2    -X6*X1            EXTRACT AT FIELD 
          MX7    1
          LX7    45 
          BX6    X6*X1             CLEAR AT FIELD 
          BX7    -X7*X4            CLEAR EP BIT 
          SA6    A1 
          SA7    A4 
          ZR     X2,ATGOOD         NO ERROR FROM OPEN 
          AX2    9
          SX3    X2-23B            CHECK IF LONG BLOCK ERROR
          ZR     X3,ATGOOD
          EQ     SETOPN            TRY AGAIN WITHOUT EP 
 ATGOOD   BSS 
          CLEAR  OLDPL2,READ       SET IN AND OUT TO FIRST. 
          SA2    SRANIX            GET 1ST WORD OF RANDOM INDEX.         CP190
          MX4    48                CREATE MASK.                          CP190
          SA1    OLDPL2+1          PREPARE TO CHECK R BIT IN FET.        CP190
          LX2    12                                                      CP190
          BX3    -X4*X2            MASK OFF 7000 OF RANDOM INDEX.        CP190
          SB2    B1+B1                                                   CP190
          LX1    59-47             PUT R BIT IN POS 59.                  CP190
          SB4    X3-7000B                                                CP190
          PL     X1,NOTRAN         IF NOT RANDOM DEVICE.                 CP190
          NZ     B4,NOTRAN         IF NOT RANDOM PL (7000).              CP190
          LX2    -12               SHIFT SRANIX BACK TO ORIGNAL POS.     CP190
          SA3    A2+B2             FETCH 3RD WORD OF RANDOM INDEX.       CP190
          MX0    54                                                      CP190
          BX7    -X0*X3            ISOLATE MASTER CONTROL CHAR.          CP190
          SA1    OPLMCC            FETCH OLDPL MASTER CHAR.              CP190
          AX3    18                MOVE X FIELD INTO POS (CHAR SET)      CP190
          BX4    -X0*X3            ISOLATE CHAR SET IDENTIFIER.          CP190
          SA5    OPLCSET           FETCH OLDPL CHAR SET IDENTIFIER.      CP190
          BX1    X1-X7             COMPARE MASTER CHARS.                 CP190
          NZ     X1,MERCHAR        IF MASTER CONTROL CHARS DIFFERENT.    CP190
          BX1    X5-X4             COMPARE CHAR SETS.                    CP190
          LX1    59 
          PL     X1,CSTMTCH        CLOSE ENOUGH 
          ENV    ACT,(2,3),VER3                                          CP190
          MESSAGE MESG2A                                                 CP190
          MESSAGE MESG2B                                                 CP190
VER3      ELSE                                                           CP190
          MESSAGE MESG2                                                  CP190
VER3      ENDIF                                                          CP190
CSTMTCH   MX1    30                                                      CP190
          BX6    -X1*X2            ISOLATE DECK LIST RA.                 CP190
          AX2    18                                                      CP190
          SA6    OLDPL2+6          STORE RA INTO FET.                    CP190
          BX7    -X1*X2            ISOLATE DECK LIST LGTH.               CP190
          AX7    12                                                      CP190
          SX6    X7+B1                                                   CP190
          SA6    DCKLGTH           STORE DECK LIST LGTH PLUS 1.          CP190
 LOOP     READW  OLDPL2,TEMP,2
          NZ     X1,ENDPL          IF EOR READ.                          CP190
          SB2    B1+B1                                                   CP190
          SA4    DCKLGTH                                                 CP190
          SX6    X4-2              DECREMENT DECL LIST LGTH CTR.         CP190
          NG     X6,LGTHERR        IF ERROR IN DECK LIST LGTH.           CP190A 
          SA6    A4                STORE DECK LIST LGTH CTR.             CP190
          SA3    TEMP              GET 1ST OF 2 WORDS READ.              CP190
          LX3    59-3              POSITION DECK BIT.                    CP190
          NG     X3,LOOP           IF DECK BIT IS SET.                   CP190
          ALLOC  CDKTBL,B2
          SA4    TEMP                                                    CP190
          IX0    X2+X3             POINT TO END OF TABLE.                CP190
          MX2    54                                                      CP190
          SB2    B1+B1                                                   CP190
          SA1    A4+B1             GET SECOND WORD OF 2 READ.            CP190
          SB4    -B2                                                     CP190
          SA5    INDX              GET PL ADDRESS.                       CP190
          BX6    X4*X2                                                   CP190
          SX5    X5                                                      CP190
          SA6    X0+B4             STORE DECK NAME IN COMDK TABLE.       CP190
          LX5    30                                                      CP190
          BX7    X5+X1             FORM 2ND WORD OF COMDK TBL ENTRY.     CP190
          SA7    A6+B1             STORE 2ND WORD OF TABLE ENTRY.        CP190
          EQ     LOOP                                                    CP190
                                                                         CP190
ENDPL     SA1    SRANIX+1          ACCESS RANDOM INDEX FROM SECONDARY.   CP190B 
          MX2    30                                                      CP190B 
          BX6    -X2*X1            MASK OFF DIRECTORY RANDOM ADDRESS.    CP190B 
          SA6    OLDPL2+6          STORE IT INTO FET.                    CP190B 
          AX1    18                SHIFT OVER DIRECTORY LENGTH.          CP190B 
          BX6    -X2*X1            MASK IT OFF.                          CP190B 
          AX6    12                                                      CP190B 
          SA6    OFFSET            STORE LENGTH TEMPORARILY.             CP190B 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          ALLOC  DIRECT,X6
S2LCM     ELSE
          SX1    X6 
          RJ     MANAGL 
S2LCM     ENDIF 
          SPACE  1
          CLEAR  OLDPL2,READ
          SA2    DIRLTH            FETCH LENGTH OF PRIMARY DIRECTORY.    UPDA168
          SA3    F.DIRECT          OBTAIN ORIGIN OF DIRECTORY 
          IX2    X2+X3             COMPUTE END OF TABLE.                 UPDA168
          SA3    OFFSET            OBTAIN LENGTH OF DIRECTORY.           CP190B 
          ENV    NOT,(2,3),S2LCM
          READW  OLDPL2,X2,X3 
S2LCM     ELSE
          RBINL  OLDPL2,X2,X3 
S2LCM     ENDIF 
          NZ     X1,READERR        IF EOR WAS READ.                      CP190B 
          SA1    DCKLGTH                                                 CP190B 
          SB2    -B1                                                     CP190
          SX1    X1+B2                                                   CP190
          NZ     X1,LGTHERR        IF ERROR IN DECK LIST LENGTH.         CP190
 ENDPL1   RECALL OLDPL2            FINISH I/O ON THIS PL
          SA2    SCNUM             FETCH NO. OF SECONDARY PLS 
          SA3    INDX              FETCH POINTER INTO PL TABLE.          CP190
          SB2    X2                                                      CP190
          UX3,B4                   UNPACK POINTER INTO B4.               CP190
          SB4    B4+B1             INCREMENT TABLE POINTER.              CP190
          EQ     B4,B2,CONT        IF END OF TABLE, THEN CONT.           CP190
          PX6    X3,B4                                                   CP190
          SA6    INDX                                                    CP190
          EQ     BEGIN                                                   CP190
                                                                         CP190
NOTRAN    BSS    0                                                       CP190
          ENV    ACT,(2,3),VER2                                          CP190
          MESSAGE MESG1A                                                 CP190
          MESSAGE MESG1B                                                 CP190
VER2      ELSE                                                           CP190
          MESSAGE  MESG1
VER2      ENDIF                                                          CP190
          SA1    ERRMODE                                                 CP190
          NZ     X1,ENDPL1                                               CP190
          EQ     ABORT                                                   CP190
                                                                         CP190
LGTHERR   BSS    0                                                       CP190
          MESSAGE MESG3                                                  CP190
          SA1    ERRMODE                                                 CP190
          NZ     X1,ENDPL1                                               CP190
          EQ     ABORT                                                   CP190
                                                                         CP190
          SPACE  1
CONT      BSS    0                                                       CP190
G         IF     DEF,PMODKEY
          SA1    L.PMODS
          ZR     X1,NOPMODS 
  
          ENV    ACT,(2,3),VER2 
          CLOSE  INPUT
VER2      ELSE
          RECALL INPUT
VER2      ENDIF 
  
          SA1    =7LUPDTPMD 
  
          ENV    ACT,(2,3),VER2 
          SX0    3
VER2      ELSE
          SX0    B1 
VER2      ENDIF 
  
          BX7    X0+X1
          SA7    PTEMP             SET UP PTEMP FILE
  
          ENV    ACT,(11),VER2
          OPEN   PTEMP,ALTER
VER2      ENDIF 
  
  
          ENV    ACT,(2,3),VER2 
          OPEN   PTEMP,ALTER
VER2      ELSE
          EVICT  PTEMP
VER2      ENDIF 
  
          CLEAR  PTEMP,WRITE
          ADDWRD MODKEY,X1
NOPMODS   BSS    0
G         ENDIF 
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
          STORE  SRCE76,RLW=12
          OPEN   SOURCE,WRITENR 
VER2      ENDIF 
  
          SA1    FASTFLG
          ZR     X1,NOTQMODE
          MX6    0
          SA6    FMODE
NOTQMODE  SA1    ORGLGTH           FETCH ORIGINAL LENGTH.                CED
          BX6    X1          SET DIRECTORY LENGTH TO ORIGINAL VALUE FOR 
          SA2    L.DIRECT     THIS CALL TO *SETNEWPL*.  SAVE CURRENT
          LX7    X2            VALUE FOR *SETNEWPL* TO RESTORE IF AND 
          SA6    A2             WHEN NECESSARY (I.E., WHEN CALLED HERE) 
          SA7    SETPLXA     THIS TEMP BELONGS TO *SETNEWPL*
          RJ     SETNEWPL                                                CED
          SA1    SETPLXA     RESTORE ACTUAL DIRECTORY LENGTH AND CLEAR
          MX7    0            THE TEMP IN *SETNEWPL*
          BX6    X1 
          SA6    L.DIRECT 
          SA7    A1 
          SA1    SEQFLAG
          ZR     X1,NOSETP
          SA1    L.DIRECT 
          SA2    F.DIRECT 
          SX0    20B
          SB7    X1 
SETPURGE  EQ     B7,B1,NOSETP      SET ALL RESEQUENCED IDENT NAMES
          SB7    B7-B1             PURGE BIT ON TO AVOID EXTRANEOUS 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA3    X2+B7             CARDS IN THESE IDENTS. 
S2LCM     ELSE
          SX7    X2+B7             COMPUTE ADDRESS. 
          RX3    X7                FETCH ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          LX3    56 
          PL     X3,SETPURGE
          LX3    4
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          BX7    X3+X0
          SA7    A3 
S2LCM     ELSE
          BX3    X3+X0             SET BIT. 
          WX3    X7                RESTORE ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          EQ     SETPURGE 
          SPACE  1
NOSETP    SA1    LPCNT
          SX6    X1+12
          SA2    JPS
          IX0    X6-X2
          SA2    =7LYANK$$$ 
          SA1    =10H YANK$$$ 
          BX7    X2 
          LX6    X1 
          SA7    IDFLG
          SA6    DNAME
          MX7    0
          SA7    GETLIMT+1
          PL     X0,ECOR0A         JUMP IF NEW PAGE NEEDED
          PRINT  =8L0,1 
          PRINT  TITLE+2,4
          PRINT  =8L,1
          EQ     ECOR0B 
          SPACE  1
 ECOR0A   SX6    EJECT
          SA6    LPCNT
ECOR0B    MX6    0
          SA6    LCHBTAB
          SPACE  1
E         IF     DEF,AUDITKEY 
          SA1    AUDIT
          ZR     X1,ENAUDIT 
          CLEAR  AUDITFL
          SX6    3
          SA6    LINCOUNT          1ST TITLE NOT ON AUDITFL 
          SA2    TEMPAUD
          BX6    X2 
          SA6    A1 
          SPACE  1
  
          ENV    ACT,(11),VER2
          OPEN   AUDITFL,ALTER
VER2      ENDIF 
  
  
          ENV    ACT,(2,3),VER2 
          STORE  ADTFL76,RLW=20 
          OPEN   AUDITFL,ALTER
VER2      ELSE
          EVICT  AUDITFL
VER2      ENDIF 
          CLEAR  AUDITFL,WRITE
  
          SA1    L.DIRECT 
          LX1    1                 AUDCNT IS TWICE THE SIZE OF DIRECT 
          ALLOC  AUDCNT,X1
          MX6    0
          SB3    X3-1 
ECLCNTR   SA6    X2+B3
          SB3    B3-B1
          PL     B3,ECLCNTR 
ENAUDIT   BSS    0
E         ENDIF 
          SPACE  1
          SA1    FASTFLG
          SA2    L.DKLIS
          SA3    RANDOPL
          ZR     X1,ECOR01
          BX6    X2 
          ZR     X3,ECOR02
          NG     X1,ECOR02
          SPACE  1
ECOR01    SA2    L.DECKS           SET WORKLGTH TO THE NUMBER OF DECKS
          SX6    X2-2              TO BE PROCESSED. 
ECOR02    SA6    WORKLGTH 
          MX6    1
          SA6    CARDSTAT 
          EQ     CHKPURY
          SPACE  1
EPASS1    BSS    0
          SPACE  1
          HERE
          SPACE  1
KEY       SET    0
PASS      SET    2
          SPACE  1
          SPACE  4
*    ALL PASS 1 ERROR MESSAGES SHOULD APPEAR HERE.  NO PASS 1 CODE     *
*    SHOULD BE PLACED AFTER THIS POINT.                                *
          SPACE  2
UNLAB     DIS    2,1UNLABELED OLDPL 
P1BADGFL  DATA   C+G AND O FILES CANNOT HAVE SAME FILENAME.+
P1BDPAR2  DATA   C+IMPROPER UPDATE PARAMETER.+
 P1BADPAR DATA   C+0 UPDATE CONTROL STATEMENT ERROR(S) +
P1BADLIN  DIS    8, 
          DATA   0                                                      0007   7
ESCARGOT  VFD    30/P1BADLIN,30/0 
P1BADINP  DATA   C+NO INPUT FILE, Q MODE, UPDATE ABORTED.+
P1READM   DATA   C+READING INPUT+ 
 P1PGDCDS DATA   C+0*** THE ABOVE LISTED DIRECTIVES CANNOT EXIST IN THE 
,YANK DECK AND HAVE BEEN PURGED DURING EDIT ***+
P1CHGD1   DATA   C+ *** LISTED BELOW ARE ALL IDENT NAMES WHICH WERE CHAN
,GED DURING THE MERGE ***+
 P1CHGD2  DATA   C+0*** ALL YANK, SELYANK, YANKDECK AND CALL DIRECTIVES 
,AFFECTED HAVE BEEN CHANGED ***+
P1BADORD  DATA   C+0*** IDENTIFIERS SEPARATED BY PERIOD IN WRONG ORDER *
,**+
 P1DCLER1 DATA   C+0*** THE ABOVE DIRECTIVE IS ILLEGAL AFTER A DECK HAS 
,BEEN DECLARED ***+ 
          ENV    ACT,(2,3),VER3                                          CP190
MESG4A    DATA   C+ TOO MANY SECONDARY OLDPLS SPECIFIED.+                CP190
MESG4B    DATA   C+ USE NO MORE THAN 7 SECONDARY OLDPLS.+                CP190
MESG5A    DATA   C+ DUPLICATE SECONDARY OLDPL IGNORED.+                  CP190
MESG5B    DATA   C+ MAKE SECONDARY OLDPL NAMES UNIQUE.+                  CP190
VER3      ELSE                                                           CP190
MESG4     DATA   C+ TOO MANY SECONDARY OLDPLS SPECIFIED.    USE NO MORE  CP190
,THAN 7 SECONDARY OLDPLS.+                                               CP190
MESG5     DATA   C+ DUPLICATE SECONDARY OLDPL IGNORED.      MAKE SECONDA CP190
,RY OLDPL NAMES UNIQUE.+                                                 CP190
VER3      ENDIF                                                          CP190
MESG6     DATA   C+ BAD FILE NAME.+                                      CP190
MESG8     DATA   C+ IDENT           WILL NOT BE PROCESSED+
 P1DCLER2 DATA   C+0*** DECK NAME ON THE ABOVE LINE NOT LAST DECLARED DE
,CK ***+
 P1ADDER1 DATA   C+0*** ADDFILE DIRECTIVE INVALID ON REMOTE FILE ***+ 
 P1ADDER2 DATA   C+0*** ADDFILE FIRST LINE MUST BE DECK OR COMDECK ***+ 
P1ADDER3  DATA   C+0*** NULL ADDFILE ***+ 
P1ADDER4  DATA   C+0*** DUPLICATE IDENT NAME IN ADDFILE ***+
 P1ADDER5 DATA   C+0*** ILLEGAL CONTROL STATEMENT IN ADDFILE ***+ 
 P1ADDER6 DATA   C+0*** NO DECK NAME ON DECK DIRECTIVE ***+ 
 P1CHGER  DATA   C+0*** NEW IDENT ON CHANGE DIRECTIVE IS ALREADY KNOWN *
,**+
 P1CPYER1 DATA   C+0*** THE TERMINAL LINE OF THE COPY RANGE WAS NOT FOUN
,D. COPY ENDS AT END OF SPECIFIED DECK. ***+
 P1CPYER2 DATA   C+0*** NO ACTIVE LINES WERE FOUND WITHIN THE COPY RANGE
,. NULL COPY. ***+
 P1CPYER3 DATA   C+0*** THE INITIAL LINE OF THE COPY RANGE WAS NOT FOUND
,. NULL COPY. ***+
P1CPYER4  DATA   C+0*** COPY TO EXTERNAL FILE NOT ALLOWED WHEN READING F
,ROM ALTERNATE INPUT UNIT ***+
 P1MVERR  DATA   C+0*** DECK SPECIFIED ON MOVE OR COPY DIRECTIVE NOT ON 
,OLDPL. DIRECTIVE WILL BE IGNORED. ***+ 
P1SPERR   DATA   C+0*** NULL IDENT ***+ 
 P1GLERR  DATA   C+0*** LINE NUMBER OUT OF RANGE OR CONTAINS INVALID CHA
,RACTER ***+
P1IDERR   DATA   C+0*** DUPLICATE IDENT NAME ***+ 
 P1CCERR  DATA   C+0*** DIRECTIVE INVALID OR MISSING ***+ 
P1ROSN    DATA   C+0*** WARNING, SEQUENCE NUMBERS ON NEXT CARD NOT IN AS0007  25
,CENDING ORDER ***+                                                     0007  26
P1YKERR   DATA   C+0*** THE ABOVE OPERATION IS NOT LEGAL WHEN REFERENCIN
,G THE YANK DECK ***+ 
P1AOERR   DATA   C+A OPTION INVALID WITH RANDOM OLDPL OR SEQUENTIAL NEWP
,L+ 
P1BOERR   DATA   C+B OPTION INVALID WITH SEQUENTIAL OLDPL+
P1PLERR   DATA   C+NO OLDPL, NOT CREATION RUN, UPDATE ABORT+
P1GHERR   DATA   C+GARBAGE IN OLDPL HEADER, UPDATE ABORTED+ 
P1DFIDT   DATA   C+0*** IDENT CARD MISSING, NO NEWPL REQUESTED, DEFAULT 
,IDENTIFIER OF .NO.ID. USED ***+
COMCHG    DIS    3,MODIFICATIONS / CONTROL CARDS
CPMSG     DIS    2,COPYING
          DATA   0                                                      0779   7
NAMEMESS  DIS    5,0***                IS NOT A VALID DECK NAME *** 
UIDMESS   DIS    4,0*** UNKNOWN IDENTIFIER NAME 
          DATA   8L *** 
          SPACE  1
CLEAR     BSS    0
COPYRITE  DATA   H*CONTROL DATA PROPRIETARY PRODUCT.* 
          DATA   H*COPYRIGHT CONTROL DATA CORP. 1971, 1972, 1973, 1974, 
, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982.*
          EJECT 
**        PASS2 DEFINES THE LOCATION OF THE FIRST WORD BEYOND ANY 
*         PERMANENT CODE.  BUFFERS, SQUEEZED LINE STORAGE, CHB STORAGE
*         ARE DEFINED BEGINNING AT PASS2.  BUCKET DEFINES THE END OF ALL
*         BUFFERS AND OTHER STORAGE AND THEREFORE THE BEGINNING OF SPACE
*         AVAILABLE FOR DYNAMIC TABLES. 
* 
  
BUFM      EQU    PASS2
TBUFS     MAX    BUFM+LBUFM,ECREATE THIS TWO STEP PROCESS IS NECESSARY
BUFS      EQU    TBUFS             SO THAT BUFS CAN BE REFERENCED EARLY 
BUFC      EQU    BUFS+LBUFS 
BUFD      EQU    BUFC+LBUFC 
  
          ENV    NOT,(2,3),S2LCM
TBUFI     MAX    BUFD+LBUFD,CLEAR  THIS TWO STEP PROCESS IS NECESSARY 
BUFI      EQU    TBUFI             SO THAT BUFI CAN BE REFERENCED EARLY 
BUFO      EQU    BUFI+LBUFI 
BUFP      EQU    BUFO+LBUFO 
BUFL      EQU    BUFP+LBUFP                                              CP190
BUFN      EQU    BUFL+LBUFL                                              CP190
BUFR      EQU    BUFN+LBUFN 
BUFF      EQU    BUFR+LBUFR 
RANIDX    EQU    BUFN              RANDOM INDEX AREA WILL BE IN BUFN
  
          ELSE
  
BUFI      EQU    100B              (BUFI THRU BUFR IN LCM)
BUFO      EQU    BUFI+LBUFI 
BUFP      EQU    BUFO+LBUFO 
BUFL      EQU    BUFP+LBUFP                                              CP190
BUFN      EQU    BUFL+LBUFL                                              CP190
BUFR      EQU    BUFN+LBUFN 
TLCML     EQU    BUFR+LBUFR+777B
LCML      EQU    TLCML/1000B*1000B LCML=LCM FL NEEDED TO NEAREST 1000B
RANIDX    EQU    CLEAR             SET UP SMALL RANDOM INDEX AREA 
BUFF      EQU    RANIDX+LRANIDX    (RANIDX THROUGH BUCKET IN SCM) 
S2LCM     ENDIF 
  
FPAGE     EQU    BUFF 
 CHBTAB   EQU    BUFF+LBUFF 
 BUCKET   EQU    CHBTAB+L.CHB 
 MEML     EQU    BUCKET 
  
*   CODE IN OVERLAY BLOCK MUST NOT LAP OVER INTO I BUFFER 
          SPACE  1
*     SEARCH FOR INSERTIONS 
          SPACE  1
          USE    *
**        PASS TWO PROCESSING                                           01257284
*                                                                       01257285
*         THE PASS 2 MAIN LOOP IS ENTERED AT ECOR1 SO THAT THE FIRST    01257286
*         ACTION WILL BE TO PROCESS ENTRIES ALREADY IN TDICT.  THESE    01257287
*         ENTRIES WILL BE THE NEW YANK, ETC. CARDS.  THE FOLLOWING      01257288
*         DISCUSSION ASSUMES THAT THE PASS 2 LOOP BEGINS AT SETUP       01257289
*         WHERE A NEW CARD IS AVAILABLE FOR PROCESSING.  THIS CARD MAY  01257290
*         HAVE BEEN READ FROM THE OLDPL, RETRIEVED FROM SVCRD TABLE, OR 01257291
*         READ FROM THE INPUT TEXT KEPT ON UPDTEXT.  UPTEXT DOES NOT    01257292
*         EXIST AS A FILE UNLESS THE ACCUMULATED TEXT OVERFLOWS THE     01257293
*         UPDTEXT BUFFER CALLED FPAGE.  AT SETUP A CALL IS MADE TO      01257294
*         TO CHECK FOR CONTROL CARDS.  IF THE CURRENT CARD IS A CONTROL 01257295
*         CARD WHICH IS RECOGNIZABLE AT THIS LEVEL, THE CELL, CURCARD,  01257296
*         WILL CONTAIN A ONE BIT CODE INDICATING THE CARD TYPE, ON      01257297
*         RETURN FROM CLASSIFY, OTHERWISE, CURCARD WILL BE ZERO.  DECK- 01257298
*         FLAG IS SET TO -0 TO INDICATE AN INACTIVE DECK CARD.  THE     01257299
*         CARD IS THEN TESTED TO DETERMINE WHETHER OR NOT IT IS A DECK  01257300
*         OR COMDECK CARD.  IF IT IS ONE OF THESE, SOME SPECIAL         01257301
*         PROCESSING IS DONE TO SET UP THE FLAGS WHICH CONCERN          01257302
*         DECK BEGINNINGS.  THIS IS DONE AT SETUPA.  DECKFLAG IS SET TO 01257303
*         PLUS TO INDICATE A DECK CARD.  IF THE CARD IS INACTIVE,       01257304
*         DECKFLAG BECOMES MINUS NON-ZERO, UNLESS IT IS INACTIVE AS THE 01257305
*         RESULT OF A YANKDECK.  ACTIVE OR YANKDECKED DECK CARDS CAUSE A01257306
*         JUMP TO SETUP1 WHERE A CHECK IS MADE TO DETERMINE WHETHER OR  01257307
*         NOT THIS DECK IS TO BE PROCESSED.  NORMAL PROCESSING WILL     01257308
*         OCCUR IN ALL CASES EXCEPT IN Q MODE WITH A SEQUENTIAL OLDPL   01257309
*         IN WHICH CASE THIS DECK MAY BE SKIPPED.  ALL ACTIVE COMDECK   01257310
*         CARDS WHICH REACH SETUPA WILL BE PROCESSED SO THE ABOVE TESTS 01257311
*         ARE SKIPPED FOR COMDECK CARDS.  ANY DECK OR COMDECK CARD TO BE01257312
*         PROCESSED PASSES THROUGH SETUP3 WHERE THE NEW DECK NAME IS    01257313
*         PLACED IN IDFLG AND DNAME.  THE PREVIOUS NAME IS STORED IN    01257314
*         GETLIMT AND GETLIMT+1 IN CASE THE CURRENT CARD MUST BE        01257315
*         PLACED IN SVCRO AS THE RESULT OF AN ADDFILE OR BEFORE CARD.   01257316
*         ALL CARDS EVENTUALLY REACH SEARCHD WHERE A SEARCH IS MADE OF  01257317
*         DICT AND ALL ENTRIES IN DICT WHICH APPLY TO THE CURRENT CARD  01257318
*         ARE MOVED TO TDICT.  WHEN DICT WAS BUILT, BIT 2 IN DIRECT     01257319
*         IS SET ON FOR EVERY IDENT WHICH IS MENTIONED ON THE CARDS     01257320
*         WHICH GENERATE THE DICT ENTRIES.  NOW AT SEARCHD BEFORE DICT  01257321
*         IS SEARCHED, BIT 2 IS CHECKED FOR THE APPROPRIATE ENTRY FOR   01257322
*         EACH CARD PROCESSED AND DICT IS NOT SEARCHED IF BIT 2 IS OFF. 01257323
*         IF ENTRIES WERE INTRODUCED UNDER THE INFLUENCE OF A DECLARE   01257324
*         CARD, THEY ARE NOW CHECKED TO INSURE THAT THE CORRECTIONS     01257325
*         APPLY WITHIN THE DECLARED DECK.  WHEN THE DICT TABLE HAS BEEN 01257326
*         FULLY SEARCHED, PROCESSING PROCEEDS TO ECORB WHERE TDICT IS   01257327
*         SEARCHED FOR BEFORE ENTRIES.  AT ECORB WHEN A BEFORE ENTRY IS 01257328
*         FOUND IN TDICT, WORD 1 OF THAT TDICT ENTRY IS SET TO ZERO TO  01257329
*         INDICATE TO THE APPROPRIATE SUBROUTINES THAT THIS ENTRY IS    01257330
*         NOW READY TO BE PROCESSED FOR INSERTIONS.  ALL CURRENTLY      01257331
*         ACTIVE ENTRIES (IN WHICH WORD ONE IS ZERO) ARE TEMPORARILY    01257332
*         TURNED OFF.  SAVECARD IS CALLED TO STORE THE CURRENT CARD IN  01257333
*         SVCRD, AND PROCINS IS CALLED TO PROCESS INSERTIONS.  IF       01257334
*         CONTROL RETURNS FROM PROCINS VIA THE RETURN JUMP, A JUMP      01257335
*         IS MADE BACK TO ECORROPL TO READ THE NEXT CARD (WHICH WILL BE 01257336
*         THE ONE SAVECARD JUST STORED).  IF PROCINS FINDS A CARD TO    01257337
*         INSERT, A JUMP IS MADE TO SETUP AND THE PROCESS STARTS ALL    01257338
*         OVER.  IF ECORB FINDS NO BEFORE ENTRY, IT EXITS TO ECOR10.    01257339
*                                                                       01257340
          SPACE  1
ECOR1     SA1    SQRESFLG          RESET SEQUENCING IF NECESSARY
          NZ     X1,ECOR1A
ECOR1B    SB4    0                 START INDEX AT ZERO
          SA3    L.TDICT           B4 HOLDS THE RELATIVE ADDRESS WITHIN 
          ZR     X3,ECORROPL       TDICT WHERE WE ARE TO START A SEARCH.
          SB3    3
          SA1    F.TDICT           IF TDICT IS EMPTY JUMP TO ECORROPL 
          SB5    X3                TO READ A CARD FROM THE LIBRARY. 
          MX0    44                OTHERWISE FORM A MASK OF WHAT THE
          SA3    CHBTAB            FIRST WORD OF ANY INSERT WHICH 
          SA5    SEQNUM            APPLIES TO THE CURRENT CARD WILL 
          MX7    1                 LOOK LIKE. NOW SEARCH -TIDCT-FOR 
          BX3    -X0*X3            ANY INSERTS TO BE PROCESSED. WHEN
          LX7    59                THE SEARCH IS DONE B6 WILL BE NON- 
          LX5    18                ZERO IF ANY WERE FOUND. IF ANY WERE
          SB6    B0                FOUND SET THE POINTERS TO POINT TO 
          BX5    X5+X7             THE LAST ONE AND JUMP TO -PROCINS- 
          SB7    -B3
          BX5    X5+X3             TO PROCESS IT. 
INSLOOP   SA4    X1+B4
          BX6    X4-X5
          SB4    B4+3 
          ZR     X6,TURNON         NEW INSERT FOUND.
          ZR     X4,ACTIVINS       ACTIVE INSERT FOUND. 
INSLOOP2  LT     B4,B5,INSLOOP     LOOP TILL DONE.
          ZR     B6,ECORROPL       NONE FOUND.
INSLOOP1  SB7    B7+B3
          SA4    X1+B7
          NZ     X4,INSLOOP1
          SB4    B7 
          SB2    B1+B1
          RJ     PROCINS
          EQ     ECOR1
          SPACE  1
ECOR1A    SX7    X1 
          AX1    30 
          SA7    SEQNUM            RESTORE PREVIOUS SEQUENCING
          SX7    X1                SO THAT INSERTS WONT BE CONFUSED 
          MX6    0
          SA7    CHBTAB 
          SA6    SQRESFLG 
          EQ     ECOR1B 
          SPACE  1
TURNON    MX6    0
          SA6    A4 
          SPACE  1
ACTIVINS  SB6    B1                AN ACTIVE INSERT HAS WORD 1 = 0. 
          EQ     INSLOOP2 
          SPACE  2
          SPACE  1
ECOR6     AX2    18 
          BX0    X2 
          RJ     GETTXT            FETCH THIS PARE OF TEXT FILE 
          SA2    F.TDICT
          SX1    X2+B4             TDICT ENTRY LOCATION 
          SA4    X1+B2             TDICT ENTRY WORD 3 
          SA1    X0+FPAGE          FETCH LENGTH WORD
          SX7    X4+200000B        CREATE MASTER CHB
          PL     X1,ECOR6A
          SB4    SQLGN8            8-BIT IMAGE
          BX1    -X1
          SX6    B0 
          SA6    SQLGN
          SB3    X1 
          EQ     ECOR6B 
 ECOR6A   SX6    B0                6-BIT IMAGE
          SB3    X1 
          SA6    SQLGN8 
          SB4    SQLGN
 ECOR6B   BSS    0
          SA6    CARD              CLEAR IMAGE BUFFERS
          SA6    CARD8
          SA6    PRINTED
          SX6    B1 
          SX3    X1+B1
          LX3    36 
          SA6    LCHBTAB           SET CHBTAB LENGTH = 1
          SA7    CHBTAB            STORE MASTER CHB 
          LX6    18 
          IX4    X4+X3             INCREMENT LOCATION 
          SA3    F.COUNT
          IX6    X4-X6             DECREMENT CARD COUNT 
          AX1    18                SHIFT TO COUNT INDEX 
          SA6    A4                STORE UPDATED WORD 3 OF ENTRY
          IX3    X3+X1             FIND COUNTER FOR THIS IDENT
          BX7    X3 
          SA3    X3 
          SA7    TCROPL            SAVE SEQ NUMBER ADDRESS
          SX6    X3+B1             INCREMENT SEQUENCE NUMBER
          NG     X6,SEQERR         JUMP IF SEQUENCE NUMBER IS TOO BIG 
          SA6    SEQNUM 
          SX7    B3 
          SA6    A3 
          SA7    B4 
          SA2    CARDSTAT 
          SA3    CURSTAT
          SPACE  1
F         IF     DEF,EXTOVLP
          NG     X2,NOOVLP
          NG     X3,NOOVLP
          SA4    PFLAG             FETCH FLAG.
          NG     X4,NOOVLP         IF FLAG IS SET.
          SX6    4           TYPE 4 OVERLAP 
          SA6    OVLFLG 
NOOVLP    BSS    0
F         ENDIF 
          SPACE  1
          SX6    B0                SET STATUS PREVIOUSLY OFF
          SA6    A2 
          MX6    1                 SET CURRENT STATUS ON
          SA6    A3 
          MOVE   B3,A1+B1,A7+B1 
          EQ     SETUP
          SPACE  1
**                                                                      01257344
*         AT ECOR10, IF THE CURRENT CARD IS AN ACTIVE (OR YANKDECKED)   01257345
*         DECK OR COMDECK CARD A DETOUR IS TAKEN THROUGH CHKPURY WHERE  01257346
*         ADDFILES ARE PROCESSED, THE PURYAN TABLE IS SEARCHED BOTH TO  01257347
*         RESET PRIOR ENTRIES AND TO FIND APPLICABLE SELYANK AND        01257348
*         SELPURGE ENTRIES, AND APPROPRIATE FLAGS ARE SET FOR PURDECK,  01257349
*         YANKDECK AND SEQUENCE.  AT ECOR10B, WHERE CHKPURY RETURNS,    01257350
*         TDICT IS SEARCHED FOR RESTORE AND DELETE ENTRIES.  THESE      01257351
*         ENTRIES RESULT IN AN ADDITIONAL CHB BEING ADDED TO THE CHB    01257352
*         STRING IS SCANNED TO REMOVE ANY CHBS WHICH SHOULD NO LONGER   01257353
*         EXIST AND TO DETERMINE THE NEW STATUS OF THE CURRENT CARD.  IF01257354
*         THE CURRENT CARD IS A DECK OR COMDECK CARD AND ITS STATUS     01257355
*         HAS CHANGED FROM THE TIME IT WAS READ (EITHER FROM THE OLDPL  01257356
*         OR AS AN INSERTION) SOME MANIPULATION OF FLAGS AND DECK NAMES 01257357
*         MUST BE DONE.  WHEN ALL OF THIS IS DONE AND THE CARD STILL    01257358
*         EXISTS (HAS NOT BEEN PURGED), CONTROL WILL ARRIVE AT ECOR25A. 01257359
*         HERE, SEVERAL SPECIAL PROCESSORS ARE CALLED IF THEY ARE       01257360
*         NEEDED.  RESEQ IS CALLED TO PERFORM SEQUENCE PROCESSING.      01257361
*         PRAUDIT IS CALLED TO PERFORM AUDIT PROCESSING.  WRNPL IS      01257362
*         CALLED TO WRITE THE NEWPL AND UPDATE THE NEWDKS TABLE.  IF    01257363
*         THE CURRENT CARD IS INACTIVE, NO FURTHER PROCESSING NEED BE   01257364
*         DONE AND THE LOOP RETURNS TO ECOR1 TO LOOK FOR INSERTIONS.  IF01257365
*         THE CURRENT CARD IS ACTIVE, SEVERAL SPECIAL CARDS MUST BE     01257366
*         DETECTED AND PROCESSED.  THESE ARE:  TEXT, WHICH SETS TXTFLAG 01257367
*         ON; ENDTEXT WHICH SETS TSTFLAG OFF; YANK WHICH SETS BIT 5 OF  01257368
*         THE APPROPRIATE DIRECTORY ENTRY ON; SELYANK WHICH CREATES     01257369
*         ENTRIES IN THE PURYAN TABLE; YANKDECK WHICH SETS BIT 5 OF THE 01257370
*         APPROPRIATE DECKS ENTRY ON; DEFINE WHICH CREATES DEFTAB       01257371
*         ENTRIES; DO WHICH SETS BIT 5 OF THE APPROPRIATE DIRECTORY     01257372
*         OFF, AND DONT WHICH ACTS THE SAME AS A YANK CARD.  IF THE     01257373
*         CURRENT CARD IS NOT ONE OF THESE, THE SOURCE AND COMPILE      01257374
*         FILES ARE PROCESSED BY WRSOU AND WRCOM AND CONTROL PASSES TO  01257375
*         ECOR1.                                                        01257376
*                                                                       01257377
          SPACE  1
ECOR10    SA1    DECKFLAG 
          PL     X1,CHKPURY        JUMP TO CHKPURY IF THIS IS A DECK
 ECOR10B  BSS    0                 CARD.
          SB4    B0 
          SA1    L.TDICT           SKIP FOLLOWING CODE IF TDICT IS
          ZR     X1,ECOR20         EMPTY. 
          SB2    4                 B2 HOLDS SHIFT COUNT TO R/D BIT
          SA2    F.TDICT
          SB5    X1                B5 HOLDS LENGTH OF TDICT 
          SA0    X2                A0 HOLDS ORIGIN OF TDICT 
          SA5    CHBTAB            FORM A MASK IN X5 CONSISTING OF
          SA3    SEQNUM            SEQUENCE NUMBER AND ORDINAL IN THE 
          MX0    44                SAME MANNER IN WHICH THEY ARE KEPT 
          LX3    18                IN THE DICTIONARY ENTRIES. 
          BX5    -X0*X5            GET RID OF ON/OFF BIT
          SB3    B2-B1             INDEX HOLDING LENGTH OF EACH ENTRY 
          MX0    24 
          BX5    X5+X3
ECOR10A   GE     B4,B5,ECOR20      DONE WHEN TDICT IS SCANNED 
          SA4    A0+B4             FETCH WORD ONE OF NEXT TDICT ENTRY 
          SB4    B4+B3             INCREMENT INDEX
          LX6    X4,B2             SHIFT TO DELETE/RESTORE BIT
          PL     X6,ECOR10A        NOT DELETE PR RESTORE
          BX2    -X0*X4            MASK OUT CODE BITS FROM ENTRY
          NG     X4,ECOR10C        THIS DELETE/RESTORE IS ALREADY ON
          BX2    X2-X5             COMPARE WITH PRESENT CARD
          MX1    1                 X1 HOLDS THE ON BIT
          NZ     X2,ECOR10A        NOT THE RIGHT CARD YET 
          BX6    X4+X1             ADD IN THE ON BIT
          SA6    A4                RESET ENTRY CONTAINING ON BIT
ECOR10C   LX4    3                 SHIFT TO RESTORE BIT 
          SA3    A4+B1             FETCH WORD TWO OF ENTRY
 D        IF     DEF,EXTOVLP
          BX1    -X0*X6            CLEAR UPPER 24 BITS OF TDICT 
          MX7    0
          BX2    X1-X5             COMPARE WITH PRESENT LINE
          ZR     X2,ECOR10D        TREAT 1ST LINE AS SINGLE DELETE
          BX2    -X0*X3            CLEAR UPPER 24 BITS OF TDICT+1 
          BX1    X2-X1             COMPARE TDICT WITH TDICT+1 
          ZR     X1,ECOR10D        IF SINGLE DELETE 
          MX7    1
 ECOR10D  BSS    0
          SA7    RANGDEL           SAVE TYPE
 D        ENDIF 
          SA1    LCHBTAB           LENGTH OF CHB TABLE AT PRESENT 
          SA2    A3+B1             WORD THREE OF ENTRY
          SX6    X2                MOVE ORDINAL TO X6 FOR NEW CHB 
+         PL     X4,*+1            SKIP ADDING RESTORE BIT OF DELETE
          SX6    X6+200000B        ADD IN RESTORE (ACTIVATE) BIT
          SX7    X1+B1             INCREMENT CHB TABLE LENGTH 
          SA6    X1+CHBTAB         STORE NEW CHB
          SA7    A1                STORE NEW LENGTH OF CHB TABLE
          BX1    -X0*X3            MASK OUT JUNK FROM WORD TWO ENTRY
          BX1    X1-X5             COMPARE WITH PRESENT CARD
          NZ     X1,ECOR12         JUMP IF NOT AT TERMINAL VALUE YET
          EQ     B4,B3,ECOR14      JUMP IF THIS ENTRY IS FIRST ON TDICT 
          SA2    A2                FETCH WORD THREE OF ENTRY
          SB6    B4-B3             NUMBER OF WORDS TO BE MOVED UP 
ECOR13    SA4    A4-B1             NOW MOVE ALL OTHER ENTRIES OUT 
          SB6    B6-B1             AND PLACE THE PRESENT ENTRY FIRST IN 
          BX7    X4                THE TABLE. 
          SA7    A4+B3
          NZ     B6,ECOR13         LOOP UNTIL ALL IS MOVED
          BX7    X2                NOW SET WORD THREE OF THE
          SA7    A7-B1             PRESENT ENTRY AND PLACE A ZERO WORD
ECOR14    MX7    0                 IN THE FIRST TWO WORDS INDICATING AN 
          SA7    A4                ACTIVE INSERT AT THIS POINT
          IF     DEF,EXTOVLP,1
          SA7    RANGDEL           TREAT AS SINGLE DELETE 
ECOR12    BSS 
  
F         IF     DEF,EXTOVLP
          MX4    44 
          SA3    A6-B1             FETCH PREVIOUS CHB AND COMPARE 
 ECOR12C  BSS    0
          BX7    X3-X6             WITH NEW ONE TO CHECK FOR OVERLAP. 
          BX4    -X4*X7 
          SX7    B1 
          ZR     X4,ECOR12A  IF TYPE 1 OVERLAP
          LX6    59-16
          LX3    59-16
          BX3    X6-X3
          LX7    1
          NG     X3,ECOR10A        NO OVERLAP 
          NG     X6,ECOR12A  IF TYPE 2 OVERLAP
          SX7    X7+1        ELSE, TYPE 3 OVERLAP 
          SA3    A3                FETCH PREVIOUS CHB.
          MX4    44                FORM MASK FOR LOWER 16 BITS. 
          BX3    -X4*X3            ISOLATE DIRECTORY ORDINAL. 
          SA1    F.DIRECT          FETCH DIRECTORY ORIGIN 
          SB6    X1                PUT ORIGIN INTO B6.
          ENV    NOT,(2,3),S2LCM
          SA4    B6+X3             FETCH DIRECTORY ENTRY FOR IDENT
 S2LCM    ELSE
          SX4    B6+X3       COMPUTE ADDRESS
          RX4    X4          FETCH DIRECTORY ENTRY
 S2LCM    ENDIF 
          LX4    59-5              SHIFT YANK BIT TO THE TOP
          NG     X4,ECOR12B        IF THE IDENT HAS BEEN YANKED 
          LX4    1                 SHIFT THE PURGE BIT TO THE TOP 
          NG     X4,ECOR12B        IF THE IDENT HAS BEEN PURGED 
          SA4    RANGDEL           FETCH DELETE TYPE-SINGLE/RANGE 
          NG     X4,ECOR10A        IF RANGE DELETE
ECOR12A   SA7    OVLFLG 
F         ENDIF 
  
          EQ     ECOR10A
  
G         IF     DEF,EXTOVLP
 ECOR12B  BSS    0
          SA3    A3-B1             BACK UP TO PREVIOUS CHB
          SX7    A3-CHBTAB-1       DON-T WANT TO LOOK AT MASTER CHB 
          LX6    60+16-59          STRAIGHTEN UP NEW CHB ENTRY
          MX4    44 
          PL     X7,ECOR12C        IF A MORE PREVIOUS CHB, CHECK OVLP 
          SA7    PFLAG             SET PURGE/YANK FLAG NEGATIVE 
          EQ     ECOR10A
G         ENDIF 
  
ECOR20    SA1    PURGFLAG 
          NZ     X1,ECOR23D        SKIP PROCESSING CHB-S IF DECK PURGED 
          SB4    B0 
          SA5    LCHBTAB
          SB.7   X5 
          SA0    CHBTAB 
          SB6    B0 
          SB5    B0 
          SA1    F.DIRECT 
          SX0    42B
          MX4    44 
          SA5    YANKFLAG          FETCH YANKDECK FLAG
          SB2    X1 
ECOR21    SA1    A0+B6             FETCH CHBTAB ENTRY 
          BX7    -X4*X1            ISOLATE DIRECTORY ORDINAL. 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X7+B2             FETCH DIRECTORY ENTRY
S2LCM     ELSE
          SX2    X7+B2             COMPUTE ADDRESS. 
          RX2    X2                FETCH DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          BX3    X0*X2             EXTRACT YANK BIT FROM DIRECTORY
          BX6    X3 
          SA6    IYANK
          AX3    3
          SB6    B6+B1
          LX3    15 
          BX6    X3+X1             OR CHBTAB ENTRY AND YANK BIT 
          LX2    55                POSITION PURGE BIT 
          SA6    A0+B5             STORE EDITED CHBTAB ENTRY
          PL     X2,ECOR22         IF ENTRY NOT PURGED
          ZR     B5,ECOR23         IF MASTER CHB PURGED 
          SB5    B5-B1
ECOR22    SB5    B5+B1
          NE     B7,B6,ECOR21 
          SX6    B5                STORE LENGTH OF CHBS 
          SX2    X6-L.CHB 
          SA6    LCHBTAB
          PL     X2,TOOMUCH1
TMRET1    BSS    0
          SA2    CHBTAB 
ECOR24    LX2    42                CALCULATE CURRENT ACTIVITY 
          NG     X2,*+1            BY LOOKING AT LATEST CHB 
          BX6    X2                WHICH IS NOT YANKED TO SEE 
          SB5    B5-B1             IF IT TURNED THIS CARD ON
          SA2    A2+B1
          NZ     B5,ECOR24
          LX6    1
          SA3    CARDSTAT          COMPARE WITH OLD ACTIVITY
          BX6    X6*X5             .AND. STATUS AND YANKFLAG
          BX2    X6+X3
          SA1    A0                CARD IS OFF IF EITHER
          LX1    59-17             1-YANKDECK ON,  2-STATUS OFF,
          BX6    -X1*X6            3-MASTER CHB YANKED
          SA6    A3 
          BX4    X6-X3
          MI     X4,ECOR24I  IF CARDSTAT HAS CHANGED
          MI     X6,ECOR24H  IF ACTIVE CARD 
          SA3    IYANK
          LX3    59-1 
          PL     X3,ECOR24G  IF INITIAL YANK BIT IS OFF 
          SX7    3
          SA7    OVLFLG      TYPE 3 OVERLAP 
          EQ     ECOR24H
  
ECOR24G   SA3    IYANKDK
          LX3    59-1 
          PL     X3,ECOR24H  IF INITIAL YANKDECK BIT IS OFF 
          SX7    3
          SA7    OVLFLG      TYPE 3 OVERLAP 
ECOR24H   NZ     X2,ECOR25   IF NOT A DELETED INSERTION CARD
ECOR24I   SA1    DECKFLAG 
          ZR     X1,ECOR24A        JUMP IF THIS IS NOT A DECK CARD. 
          SA1    LISTHREE 
          ZR     X1,ECOR24E 
          PRINT  =8L,1
ECOR24E   SA1    DKSTRUC
          NZ     X1,ECOR24C 
          SX7    B1 
          SA7    A1 
          MESSAGE (=C+DECK STRUCTURE CHANGED+)
ECOR24C   SA1    CARDSTAT 
          PL     X1,ECOR24D 
          SX7    B1 
          SA7    TMODFLAG 
          SA1    CURSTAT
          MX0    1
          BX2    -X0*X1 
          LX1    58-54
          ZR     X2,ECOR24B        THIS IS AN INSERT
          NG     X1,ECOR24B 
          RJ     SCITEM 
          SA1    IDFLG
          SA2    DNAME
          LX6    54                SET UP NEW DECK NAME 
          SA7    A1 
          SA6    A2 
          BX7    X1 
          LX6    X2 
          SA7    GETLIMT+1
          SA6    A7-B1
          SX6    B1 
          SA6    DECKFLAG 
          EQ     ECOR24B
          SPACE  1
ECOR24A   SA1    YANKFLAG          DO NOT SET MODFLG IF CARD IS 
          SX7    B1                INACTIVE AND INSIDE YANKDECK 
          NZ     X1,ECOR24AA
          SA1    CARDSTAT 
          NG     X1,ECOR24AA
          EQ     ECOR24B
          SPACE  1
ECOR24D   SA1    YANKFLAG 
          ZR     X1,ECOR24B 
          SA1    GETLIMT
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          SA6    DNAME             RESTORE PREVIOUS DECK NAME 
          SA7    IDFLG
          MX6    60 
          SA6    DECKFLAG 
          SPACE  1
ECOR24AA  SA7    MODFLG            SET MODIFICATION FLAG
 ECOR24B  BSS    0
          SA1    =7LYANK$$$ 
          SA2    IDFLG
          IX0    X1-X2
          ZR     X0,ECOR24BB       IF ADDING TO THE YANK$$$ DECK
          CLASIFY 
          SB5    -B1
          CCJUMP ENDTEXT,ECOR24K
          SB5    B1 
          CCJUMP TEXT,ECOR24K 
          SA2    TXTFLAG
          NZ     X2,ECOR24BB       IF IN *TEXT CONTROL
          CCJUMP SELYANK,ECOR24J   ELSE IGNORE ADDITIONS OF SELYANKS, 
          CCJUMP YANKDECK,ECOR24J  YANKDECKS, 
          CCJUMP YANK,ECOR24J      AND YANKS
          CCJUMP DEFINE,ECOR24J    AND DEFINES
 ECOR24BB BSS    0
          RJ     CKM               DETERMINE MOD TYPE AND PRINT CARD
          EQ     ECOR25A
  
 ECOR24K  SA1    TXTFLAG           INCREMENT OR DECREMENT TEXT FLAG 
          SX6    X1+B5
          SA6    A1 
          PL     X6,ECOR24BB       IF NOT ERROR IN TEXT RANGE 
          RJ     TXTERR 
          EQ     ECOR24BB          CONTINUE 
          SPACE  5,10 
ECOR24J   SA1    TCROPL            PICK UP SEQ NUMBER ADDRESS 
          SA2    X1 
          SX6    X2-1              DECREMENT SEQ NUM SINCE CARD SKIPPED 
          SA6    A2 
          EQ     ECOR1B 
          SPACE  1
ECOR23    SA1    DECKFLAG 
          MX6    1
          SA6    MODFLG 
          ZR     X1,ECOR23C 
          SA1    GETLIMT           RESTORE PREVIOUS DECKNAME
          SA2    A1+B1
          BX6    X1 
          LX7    X2 
          SA6    DNAME
          SA7    IDFLG
ECOR23D   BSS    0
          SA1    DKSTRUC           JUMP TO DISPLAY THE DECK STRUCTURE 
          ZR     X1,ECOR23B        MESSAGE IF IT HAS NOT BEEN. IF 
ECOR23C   BSS    0                 LISTTHREE IS ON PRINT
          CLASIFY 
          SB5    B1 
          CCJUMP TEXT,ECOR23F      IF WE HAVE A TEXT OR ENDTEXT CARD, 
          SB5    -B1
          CCJUMP ENDTEXT,ECOR23F   DO NOT SKIP IT EVEN IF DECK PURGED 
 ECOR23E  BSS    0
          SA1    LISTHREE 
          ZR     X1,ECOR1          THE CARD.
          RJ     ADDID
          SA1    =10H       P 
          SA2    =10H 
          SA3    CARDSTAT 
          PL     X3,ECOR23A 
          SA2    =10HACTIVE 
ECOR23A   BX6    X1 
          LX7    X2 
          SA6    CARD3
          SA7    A6+B1
          PRNTCARD
          SA1    =1H
          BX6    X1 
          SA6    CARD4
          SA6    A6-B1
          EQ     ECOR1
          SPACE  1
 ECOR23B  MESSAGE (=C+DECK STRUCTURE CHANGED+)
             SX6    B1
          SA6    DKSTRUC
          EQ     ECOR23C
  
 ECOR23F  BSS    0                 A TEXT CARD IN A DECK BEING PURGED 
          SA3    CARDSTAT 
          PL     X3,ECOR23E        IF TEXT/ENDTEXT CARD IS INACTIVE 
          SA1    TXTFLAG
          SX6    X1+B5             INCREMENT OR DECREMENT TEXT FLAG 
          SA6    A1 
          PL     X6,ECOR23E        IF NO ERROR IN TEXT RANGE
          RJ     TXTERR 
          EQ     ECOR23E
  
ECOR25    SA1    OVLFLG 
          ZR     X1,ECOR25A 
          RJ     CKM         DETERMINE OVERLAP TYPE AND PRINT CARD
ECOR25A   SA3    TSEQFLG
          NZ     X3,RESEQ 
NOSEQ     BSS    0
          SPACE  1
G         IF     DEF,PMODKEY
          SA1    L.PMODS
          NZ     X1,PRPMOD
PMODEND   BSS    0
G         ENDIF 
          SPACE  1
          IF     DEF,AUDITKEY,3 
          SA1    AUDIT
          NZ     X1,PRAUDIT 
DONAUDIT  BSS    0
          CLASIFY 1                BEFORE WE WRITE THIS CARD TO THE 
          ZR     X1,DONA1          NEWPL WE MUSTBE CERTAIN THAT IT IS 
          CCJUMP ENDTEXT,DONA2     NOT AN ERRONEOUS ENDTEXT CARD. 
          EQ     DONA1
  
DONA2     SA1    TXTFLAG
          NZ     X1,DONA1    IF ACTIVE TEXT RANGE 
          SA1    CARDSTAT 
          PL     X1,DONA1    IF INACTIVE ENDTEXT CARD 
          RJ     TXTERR 
          RJ     WRSOU
          EQ     ECOR1
  
DONA1     RJ     WRNPL
          SA1    CARDSTAT 
          PL     X1,ECOR1 
          CLASIFY 1 
          ZR     X1,TRYSOU
          CCJUMP TEXT,ONTEXT
          CCJUMP ENDTEXT,OFFTEXT
          CCJUMP YANK,SETYANK 
          CCJUMP SELYANK,SETSELY
          CCJUMP YANKDECK,SETYD 
          CCJUMP DEFINE,SETDEF
          CCJUMP DO,SETDO 
          CCJUMP DONT,SETDONT 
 TRYSOU   RJ     WRSOU
          RJ     WRCOM
          EQ     ECOR1
          SPACE  1
*    THIS CODE IS FOR SKIPPING DECKS IN SEQUENTIAL Q MODE PROCESSING   *
          SPACE  1
ECOR31    BSS    0
          READPL 3
          NZ     X1,CHEKMODE
          SB4    4                                                      0081  26
          RJ     CLASSIFY 
          CLASIFY 
          ZR     X1,ECOR31         SKIP IF NOT DECK OR COMDECK
          CCJUMP TEXT,ECOR31B      JUMP IF TEXT CARD                    0081  28
          CCJUMP ENDTEXT,ECOR31C   JUMP IF ENDTEXT CARD                 0081  29
          SA5    TXTFLAG                                                0081  30
          NZ     X5,ECOR31         SKIP IF IN TEXT RANGE                0081  31
          CLASIFY                                                       0081  32
          SA2    CURSTAT
          NG     X2,ECOR31A        ACTIVE DECK OR COMDECK 
          LX2    58-54
          PL     X2,ECOR31         NOT YANKED DECK
ECOR31A   SX6    B1 
          SA6    DECKFLAG 
          CCJUMP DECK,STDKBIT7                                           CP190
          SX6    B0 
          SA6    FAST 
          EQ     SEARCHDL 
          SPACE  1                                                      0081  34
ECOR31B   SA2    TXTFLAG           SET TEXT FLAG ON                     0081  35
          SX6    X2+B1                                                  0081  36
          SA6    A2                                                     0081  37
          EQ     ECOR31            AND CONTINUE SKIPPING                0081  38
          SPACE  1                                                      0081  39
ECOR31C   SA2    TXTFLAG           TURN OFF TEXT FLAG                   0081  40
          SX6    X2-1                                                   0081  41
          SA6    A2                                                     0081  42
          PL   X6,ECOR31                                                1704  11
          RJ   TXTERR                                                   1704  12
          EQ     ECOR31            AND CONTINUE SKIPPING                0081  43
          SPACE  1
SETUP1    SA1    RANDOPL           IF WE HAVE A RANDOM OLDPL GO AHEAD 
          NZ     X1,SETUP3         AND PROCESS THIS DECK OR COMDECK 
          SA1    FASTFLG           OR IF WE ARE IN NORMAL MODE
          ZR     X1,SETUP3         PROCESS THIS DECK OR COMDECK 
          SA1    WORKLGTH          IF IN Q MODE WITH SEQUENTIAL OLDPL 
          NZ     X1,SEARCHDL       WE ARE DONE IF WORKLGTH IS ZERO
          SA1    L.TDICT           UNLESS TDICT CONTAINS ACTIVE ENTRIES.
          ZR     X1,CHEKMODE
SEARCHDL  RJ     SCITEM            FETCH DECK NAME
          SA2    L.DKLIS
          SA3    F.DKLIS
          SB7    X2 
          SA3    X3 
          SA1    WORKLGTH 
SRCHDL    BX4    X3-X7             COMPARE NAMES
          SA3    A3+B1
          AX4    6                                                      0014   6
          SB7    B7-B1
          ZR     X4,SRCHDL1 
          GT     B7,SRCHDL   LOOP 
          SA7    SKIPM+1
          CLASIFY 
          CCJUMP COMDECK,CLRDKBIT                                        CP190
          MESSAGE SKIPM,1 
          EQ       ECOR31 
                                                                         CP190
CLRDKBTA  RJ     SCITEM            FETCH COMDECK NAME.                   UPDA178
CLRDKBIT  BX2    X7                STORE CURRENT VALUE OF X7.            CP190
          MX7    0                 CLEAR DECK BIT FROM DECKFLG SO THAT   CP190
          SA7    DECKFLG           IT WONT BE SET WHEN DOING COMDECKS.   CP190
          LX7    X2                RESTORE PREVIOUS VALUE INTO X7.       CP190
          EQ     SETUP3+1                                                CP190
          SPACE  1
          SPACE  1
          SPACE  1
SRCHDL1   SA2    A3-B1             WE HAVE FOUND A MATCH. THIS DECK IS
          LX2    57 
          LX3    X2,B1             ADDFILE BIT
          SX4    B1 
          BX0    X6 
          NG     X2,SRCHDL3        DECK IS DONE 
          BX6    X4+X3
          LX6    2
          SA6    A2 
          IX6    X1-X4
          SA6    A1 
SRCHDL3   SX6    B1 
          SA6    DECKFLAG 
          BX6    X0 
          PL     X3,SETUP3+1       NOT AN ADDFILE MARKER
          MX6    0
          SA7    GETLIMT+1
          SA6    IDFLG
          SA7    FAST 
          EQ     CHKPURY
          SPACE  1
SETUP3    RJ     SCITEM            FETCH DECK OR COMDECK NAME.
          LX6    54 
          SA1    DNAME             SET UP NEW PARAMETERS
          SA2    IDFLG             AND STORE OLD ONES.
          SA6    A1 
          SA7    A2 
          BX6    X1 
          LX7    X2 
          SA6    GETLIMT
          SA7    A6+B1
          EQ     SEARCHD
  
SETUPA    SA2    CURSTAT
          SA6    A6 
          MX6    1
          PL     X2,SETUPA1  IF NOT ACTIVE DECK/COMDECK CARD
          BX1    -X6*X2 
          NZ     X1,SETUP1   IF DECK/COMDECK CARD ON OLDPL
          CLASIFY                                                        UPDA178
          CCJUMP COMDECK,CLRDKBTA  IF COMDECK THEN CLEAR DECKFLG.        UPDA178
          EQ     SETUP3 
  
SETUPA1   LX2    58-54
          SA6    A6 
          PL     X2,SEARCHD        NOT YANKDECKED 
          SX6    B1 
          SA6    A6 
          EQ     SETUP1 
          SPACE  1
ECORROPL  BSS    0
          READPL 4
          NZ     X1,CHEKMODE       CHECK FOR RANDOM MODE
SETUP     SB4    SPARLIST 
          RJ     CLASSIFY 
          SA1    CURCARD
          MX6    0
          SA6    PFLAG             SET PFLAG TO ZERO. 
          MX6    60 
          SB2    B1+B1
          SA6    DECKFLAG 
          AX0    X1,B1             SHIFT OFF BIT THAT INDICATES A DECK.  CP190
          SX6    B1 
          ZR     X1,SEARCHD        NOT DECK OR COMDECK
          ZR     X0,STDKBIT8       IF *DECK CARD JUST READ.              CP190
          AX0    X0,B1             SHIFT OFF BIT THAT INDICATES COMDECK. CP190
          ZR     X0,SETUPA         IF *COMDECK CARD JUST READ.           CP190
SEARCHD   SB4    B0                CHECKS 
          IF     DEF,DECLKEY,2
          SA1    DECKFLAG 
          PL     X1,SEARCHD7
SEARCHD0  SB4    B0 
SEARCHD1  SA3    L.DICT            ENTRIES WHICH APPLY TO THIS CARD AND 
          ZR     X3,ECORB          TRANSFERS ANY IT FINDS TO -TDICT-. 
          SB5    X3 
          SA2    F.DICT 
          SB2    B1+B1
          MX0    44 
          SB3    B2+B1
          SA5    CHBTAB 
          SA3    SEQNUM 
          BX5    -X0*X5 
          LX3    18 
          SA4    F.DIRECT          IF BIT 2 OF THE DIRECTORY ENTRY
          IX4    X4+X5             FOR THIS IDENT IS NOT ON, THERE
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA4    X4                CAN BE NO ENTRIES IN THE DICTIONARY
S2LCM     ELSE
          RX4    X4 
S2LCM     ENDIF 
          SPACE  1
          LX4    59-2              WHICH APPLY, SO SKIP THE SEARCH CODE.
          PL     X4,ECORB 
          BX5    X5+X3
          MX0    24 
          SB6    -B3
SEARCHD2  EQ     B4,B5,ECORB
          SA4    X2+B4
          SB4    B4+B3
          BX6    -X0*X4 
          BX6    X6-X5
          NZ     X6,SEARCHD2
          SX6    B4+B6
          LX3    X4,B1
          SA6    TEMP 
          SPACE  1
A         IF     DEF,DECLKEY
          SA5    L.DECTAB 
          NZ     X5,SEARCHD4
SEARCHD5  BSS    0
A         ENDIF 
          SPACE  1
          PL     X3,SEARCHD3
          ALLOC  TDICT,B3 
          MOVE   X3-3,X2,X2+3 
          SA5    F.TDICT
          SA1    TEMP 
          SA2    F.DICT 
          IX1    X2+X1
          SA1    X1 
          SA2    A1+B1
          BX6    X1 
          SA3    A2+B1
          LX7    X2 
          SA6    X5 
          SA7    A6+B1
          BX6    X3 
          SA6    A7+B1
          RJ     SQUIZOUT 
          SA1    TEMP 
          SB4    X1 
          EQ     SEARCHD1 
          SPACE  1
A         IF     DEF,DECLKEY
          SPACE  1
SEARCHD4  SA5    DECLDECK 
          SA2    A4+B1             FETCH SECOND WORD
          AX2    36 
          ZR     X2,SEARCHD5
          SA1    A4 
          BX2    X2-X5
          ZR     X2,SEARCHD5       THIS IS A GOOD ENTRY 
          SA2    LISTONE
          ZR     X2,SEARCHD6
          RJ     DECLSV      SAVE CARD IMAGE AREA 
          RJ     DETTYPE           PRINT OFFENDING CARD 
          PRINT  CARD-1,6 
          PRINT  (0*** THE ABOVE CARD AFFECTS A DECK OTHER THAN THE DECL
,ARED DECK ***) 
          RJ     DECLRS      RESTORE CARD IMAGE AREA
SEARCHD6  SA1    DTYPERR           INCREMENT ERROR COUNT
          SX6    X1+B1
          SA6    A1 
          RJ     SQUIZOUT          ELIMINATE ENTRY
          SA1    TEMP 
          SB4    X1 
          EQ     SEARCHD1 
          SPACE  1
SEARCHD7  SA1    L.DECTAB 
          ZR     X1,SEARCHD1       NO DECLARED DECK 
          SA1    IDFLG             GET CURRENT DECK NAME. 
          SA3    L.DECTAB          FETCH DECTAB LENGTN. 
          SA2    F.DECTAB          FETCH DECTAB ORIGIN. 
          SB4    X3-1 
SEARCHDB  NG     B4,SEARCHDC       IF NAME NOT IN TABLE.
          SA5    X2+B4             FETCH TABLE ENTRY. 
          SB4    B4-B1             DECREMENT POINTER. 
          BX0    X5-X1             COMPARE. 
          NZ     X0,SEARCHDB       IF NOT EQUAL.
          SB4    B4+B1             PUT POINTER BACK TO PREVIOUS VAL.
SEARCHDC  SX6    B4+B1
          SA6    DECLDECK          STORE ORDINAL IF NAME IN TABLE.
          SB4    B0 
          SA2    L.TDICT
          ZR     X2,SEARCHD1       IF NO ENTRIES IN TDICT.
          SA1    CURSTAT
          MX0    1
          BX1    -X0*X1 
          ZR     X1,SEARCHD1       DECK IS BEING INSERTED.
 SEARCHD8 SA1    F.TDICT
          SA2    L.TDICT
          SB4    X2 
          SB5    B1 
          SA1    X1 
          MX0    24 
SEARCHD9  GE     B5,B4,SEARCHD0    IF DONE SEARCHING. 
          SA2    A1+B5
          BX3    X0*X2
          SB5    B5+3 
          ZR     X3,SEARCHD9 IF DECLARE BITS OF TDICT ENTRY ARE ZERO
          SA5    DECLDECK          FETCH DECTAB ORDINAL.
          AX3    36                SHIFT 2ND WORD OF TDICT ENTRY. 
          BX3    X3-X5             COMPARE. 
          ZR     X3,SEARCHD0       IF TDICT ENTRY APPLIES TO CURRENT. 
          SA1    A2-B1
          SX6    B5-B1
          SA6    TEMP 
          SA3    LISTONE
          ZR     X3,SEARCHDD IF L=1 NOT SPECIFIED 
          RJ     DECLSV      SAVE CARD IMAGE AREA 
          RJ     DETTYPE
          PRINT  CARD-1,6 
          PRINT  (0*** THE ABOVE CARD AFFECTS A DECK OTHER THAN THE DECL
,ARED DECK ***) 
          RJ     DECLRS      RESTORE CARD IMAGE AREA
 SEARCHDD SA1    DTYPERR
          SX6    X1+B1
          SA6    A1 
          SA5    L.TDICT
          SA4    TEMP 
          SA3    F.TDICT
          IX2    X3+X4
          IX1    X5-X4
          MOVE   X1,X2,X2-3 
          SA1    L.TDICT
          SX6    X1-3 
          SA6    A1 
          NZ     X6,SEARCHD8
          SA2    F.DECTAB 
A         ENDIF 
          SPACE  1
 SEARCHD3 ALLOC  TDICT,3
          SA1    TEMP 
          SA4    F.DICT 
          SB4    X3-3 
          SX3    X2+B4
          IX2    X1+X4
          MOVE   3,X2,X3
          RJ     SQUIZOUT 
          SA1    TEMP 
          SB4    X1 
          EQ     SEARCHD1 
          SPACE  1
ECORB     SA3    L.TDICT           SEARCH TDICT FOR APPLICABLE BEFORES
          ZR     X3,ECOR10
          SB2    B1+B1
          SB4    B0 
          SA2    F.TDICT
          SB3    3
          SB5    X3 
          MX1    1                 WHEN WE FIND THE FIRST BEFORE ENTRY
          SA5    CHBTAB            LEAVE THE REST OF THE ENTRIES ALONE
          SA3    SEQNUM            EVEN IF THEY ARE BEFORES.
          MX0    44 
          LX1    58 
          BX5    -X0*X5 
          LX3    18 
          BX5    X5+X1
          BX5    X5+X3
          SB6    B0 
BEFLOOP   GE     B4,B5,ECOR10 
          SA4    X2+B4
          BX3    X4-X5
          SB4    B4+B3
          NZ     X3,BEFLOOP 
          SB4    B4-B3
          MX6    0
          SA6    A4 
          SA5    BEFFLAG
ECORB3    GE     B6,B5,ECORB5      NOW TURN OFF ALL OTHER 
          EQ     B6,B4,ECORB4      INSERTS WHICH MIGHT
          SA3    X2+B6             HAVE BEEN ON SINCE 
          SB6    B6+B3             THEY WILL NOT APPLY
          NZ     X3,ECORB3         UNTIL THE PRESENT
          SX6    X5+B1
          SA6    A3                CARD IS RESTORED TO
          EQ     ECORB3            CURRENT CARD STATUS. 
          SPACE  1
ECORB4    SB6    B6+B3
          EQ     ECORB3 
          SPACE  1
ECORB5    SX6    B4 
          SA6    TEMP 
          RJ     SAVECARD 
          SA1    TEMP 
          SA2    F.TDICT
          SB4    X1 
          SA4    X2+B4
          RJ     PROCINS
          EQ     ECORROPL 
          SPACE  2
CHEKMODE  SA1    RANDOPL           IF WE ARE USING A SEQUENTIAL OLDPL 
          ZR     X1,FCOR
          IF     DEF,EDITKEY,2
          SA1    MERGE             IF MERGE IS NON-ZERO JUMP TO PROCESS 
          NZ     X1,CHYANKS        THE SECOND YANK DECK.
          SA2    FASTFLG           IF WE ARE IN Q MODE JUMP TO CHECK
          NZ     X2,CHEKQRAN       SPECIAL PROCESSING.
          SA1    WORKLGTH          IF WORKLGTH IS ZERO
          NZ     X1,PROCNEXT
          EQ     FCOR 
          SPACE  2
 CHEKQRAN SA5    WORKLGTH 
          ZR     X5,CHEKSC2  CHECK FOR POSSIBLE SECOND SCAN 
          SA2    FASTFLG
          NG     X2,CHEKQR2  PROCESS IN DKLIS ORDER 
          SA2    F.DECKS
          SA3    L.DECKS
          IX0    X2-X5
          SX6    X5-2 
          IX0    X0+X3
          SA6    A5 
          SA2    X0+B1
          ZR     X2,CHEKQRAN  DECK NOT ON OLDPL 
          SA3    L.DKLIS           SEARCH DKLIS TO SEE IF THE DECK IS 
          SA1    F.DKLIS           TO BE PROCESSED
          SA4    A2-B1
          SB3    X3 
          SA1    X1-1 
 TRYNEXT  ZR     B3,CHEKQRAN
          SA1    A1+B1
          BX0    X4-X1
          SB3    B3-B1
          AX0    6
          NZ     X0,TRYNEXT        LOOP IF NOT SAME DECK
          SX0    B1 
          BX6    X0*X1
          ZR     X6,CHEKQRAN  DONE ALREADY
          LX0    3
          BX6    X0*X1
          NZ     X6,CHEKQRAN  DONE ON PREVIOUS SCAN 
          AX0    2
          BX6    X0*X1
          NZ     X6,FAKEOUT        ADDFILE MARKER 
 TRYNEXT1 SA3    XFLAG
          NZ     X3,TRYNEXT3
          SA4    FMODE
          PL     X4,TRYNEXT2
          SX0    10B
          BX6    X1+X0
          SA6    A1                SET DONE BIT OFF 
TRYNEXT2  BX6    X2 
          SA6    OLDPL+6           SET UP OLDPL FOR 
          LX1    57 
          PL     X1,TRYNEXT4       IF NO CHECKING NECESSARY 
          SA1    RANDOPL
          NZ     X1,TRYNEXT4
          SA1    L.TDICT
          NZ     X1,ERRS1          IF TDICT NOT EMPTY, WE HAVE ERRORS 
TRYNEXT4  BSS    0
          CLEAR  OLDPL,READ        NEXT DECK TO BE READ.
          EQ     ECORROPL 
          SPACE  2
TRYNEXT3  SX0    11B
          BX6    X1+X0
          SA6    A1 
          EQ     TRYNEXT2 
          SPACE  2
CHEKQR2   SA5    WORKLGTH 
          ZR     X5,FCOR           WE ARE DONE WHEN WORKLGTH IS ZERO
          SA2    F.DKLIS
          SA3    L.DKLIS
          IX0    X2-X5             FIND THE NEXT DECK IN THE DECK LIST
          SX6    X5-1 
          IX0    X0+X3
          SA6    A5                RECUCE WORKLGTH
          SA1    X0                FETCH THE ENTRY
          SB2    B1+B1
          SX0    B1 
          BX6    X0*X1
          ZR     X6,CHEKQRAN  DONE ALREADY
          LX0    3
          BX6    X0*X1
          NZ     X6,CHEKQRAN  DONE ON PREVIOUS SCAN 
          AX0    2
          BX2    X0*X1
          NZ     X2,FAKEOUT1       THIS IS A Q MODE ADDFILE MARKER      0169   8
          SA2    F.DECKS
          SA3    L.DECKS           NOW SEARCH DECK LIST FOR THE 
          SB3    X3                APPROPRIATE ENTRY AND GET THE
          SA2    X2-2              RANDOM ADDRESS.
          MX7    54 
TTTTTRY   ZR     B3,CHEKQR2 
          SA2    A2+B2
          BX0    X2-X1
          SB3    B3-B2
          BX0    X7*X0
          NZ     X0,TTTTTRY        LOOP UNTIL WE FIND IT. 
          SA2    A2+B1             FETCH THE RANDOM ADDRESS 
          ZR     X2,CHEKQR2 
          EQ     TRYNEXT1    AND JUMP TO PROCESS IT 
          SPACE  2
CHEKSC2   SA1    QRANDFLG 
          ZR     X1,FCOR           NO SECOND SCAN NECESSARY 
          SX6    B0 
          SA6    QUALIF            CLEAR THE IF FLAG IN CASE NO ENDIF 
          SA6    A1 
          SA2    FASTFLG
          SA3    L.DECKS
          PL     X2,CHEKSC3 
          SA3    L.DKLIS
 CHEKSC3  BX7    X3          LOOK THROUGH THE DECK LIST AGAIN 
          SA7    WORKLGTH          FOR OUT-PF-ORDER COMDECKS
          EQ     CHEKQRAN 
          SPACE  2
 PROCNEXT SA2    F.DECKS
          SA3    L.DECKS           GET NEXT DECK
          IX0    X2-X1             ADDRESS FROM 
          SX6    X1-2              DECK LIST, 
          IX0    X0+X3
          SA6    A1                DECREMENT
          SA2    X0+B1
          ZR     X2,CHEKMODE
          EQ     TRYNEXT2          GO SET UP OLDPL READ 
  
*         THE FOLLOWING ROUTINES SAVE AND RESTORE THE CONTENTS OF THE 
*         CARD IMAGE AREA, RESPECTIVELY.  THEY ARE NEEDED DURING ERROR
*         PROCESSING FOR THE *DECLARE* DIRECTIVE BECAUSE WHEN AN
*         ERRONEOUS DIRECTIVE GETS PRINTED, IT GETS MOVED INTO THIS 
*         AREA, CAUSING THE CURRENT COMPILE FILE IMAGE TO BE CLOBBERED. 
*         THIS IS ONLY A PROBLEM FOR *DECLARE*, BECAUSE ALL OTHER ERRORS
*         OF THIS TYPE ARE FATAL, AND THE COMPILE FILE GETS SUPPRESSED. 
  
 A        IF     DEF,DECLKEY
 DECLSV   EQ     *+1S17      SAVE CARD IMAGE AREA 
          SB6    B0          (PRESERVES A1, X1) 
          SB7    ALLSIZE
 DECLSV1  SA2    B6+ALLBUF
          BX6    X2 
          SA6    B6+DECLHLD 
          SB6    B6+B1
          LT     B6,B7,DECLSV1
          EQ     DECLSV 
  
 DECLRS   EQ     *+1S17      RESTORE CARD IMAGE AREA
          SB6    B0          (PRESERVES A1, X1) 
          SB7    ALLSIZE
 DECLRS1  SA2    B6+DECLHLD 
          BX6    X2 
          SA6    B6+ALLBUF
          SB6    B6+B1
          LT     B6,B7,DECLRS1
          EQ     DECLRS 
  
 DECLHLD  BSSZ   ALLSIZE
 A        ENDIF 
          SPACE  1
          SPACE  1
          TITLE  END OF UPDATE CLEANUP SECTION
          EJECT 
**        END OF UPDATE PROCESSING                                      01257389
*                                                                       01257390
*         WHENEVER AN END OF RECORD IS READ ON THE OLDPL, CHECKMODE IS  01257391
*         ENTERED TO FIND OUT WHETHER OR NOT PASS 2 PROCESSING IS       01257392
*         FINISHED.  END OF RECORD WITH A SEQUENTIAL FILE INDICATES END 01257393
*         OF PASS 2, END OF RECORD WITH A RANDOM FILE INDICATES ONLY THE01257394
*         END OF THE CURRENT DECK.  IF PASS 2 PROCESSING IS FINISHED,   01257395
*         CONTROL PASSES TO FCOR FOR END PROCESSING.  A CHECK IS MADE   01257396
*         FOR ADDFILES WHICH REFER TO THE END OF THE OLDPL.  THE CURRENT01257397
*         COMPILE FILE ACTION IS TERMINATED.  THE PURGE BIT IS REMOVED  01257398
*         FROM ANY SEQUENCED IDENTS.  IF A COMPILE FILE IS BEING        01257399
*         GENERATED, IT IS POSSIBLE THAT COMPILE FILE PROCESSING WAS    01257400
*         INTERRUPTED IN THE MIDDLE OF A DECK OR COMDECK BECAUSE OF AN  01257401
*         OUT OF ORDER COMDECK.  IN THIS CASE, PROCESSING IS NOW DONE TO01257402
*         RETURN AND COMPLETE THE INTERRUPTED ACTION.  IT IS            01257403
*         ALSO POSSIBLE THAT THERE ARE SOME DECKS WRITTEN TO UPDTSCR    01257404
*         WHICH MUST NOW BE COPIED TO COMPILE.  THIS SITUATION OCCURS   01257405
*         WHENEVER DECKS ARE PROCESSED IN PASS 2 IN AN ORDER OTHER THAN 01257406
*         THE ORDER IN WHICH THEY ARE TO APPEAR ON THE COMPILE FILE.  AT01257407
*         DONEALM THE POSSIBLE WRITING OF A NEWPL IS COMPLETED.  AT     01257408
*         ERRCHECK, A CHECK IS MADE FOR MODIFICATIONS WHICH DID NOT     01257409
*         GET PROCESSED, AND ANY SUCH MODS ARE PRINTED IN THE LISTING.  01257410
*         IF PULLMOD PROCESSING TOOK PLACE, THE PULLMOD FILE, UPDTPMD,  01257411
*         MUST BE PROCESSED AND THE ACTUAL CORRECTION SETS REGENERATED  01257412
*         ON THE APPROPRIATE FILE.  THE VARIOUS LISTS ARE PRINTED ON THE01257413
*         LIST OPTION A WAS SPECIFIED (OR ON BY DEFAULT).  IF AUDIT     01257414
*         PROCESSING TOOK PLACE, THE UPDTAUD FILE MUST BE PROCESSED     01257415
*         AND THE AUDIT INFORMATION COPIED TO THE LIST FILE.  FIELD     01257416
*         LENGTH IS RETURNED TO WHAT IT WAS BEFORE UPDATE BEGAN         01257417
*         PROCESSING AND UPDATE ENDS.                                   01257418
*                                                                       01257419
          SPACE  1
FCOR      SA1    IDFLG
          SX6    B1 
          SA6    YFLAG             SET CLEANUP FLAG 
          MX7    0
          BX6    X1 
          SA7    A1                CHECK FOR ADDFILES AT END OF LIBRARY 
          SA6    GETLIMT+1
          SA1    L.DICT 
          RJ     CHEKADF
          SA1    DEFDECK                                                1197   8
          BX6    X1                                                     1197   9
          SA6    GETLIMT+1                                              1197  10
          SA1    L.DICT                                                 1197  11
          RJ   CHEKADF                                                  1197  12
          RJ     COPYEND           END CURRENT COMPILE FILE ACTIVITY. 
          SA1    SEQFLAG
          ZR     X1,FCOR0C   IF NOTHING WAS SEQUENCED 
          SA1    L.DIRECT 
          SA2    F.DIRECT 
          SX0    20B
          SB7    X1 
FCOR0B    EQ     B7,B1,FCOR0C 
          SB7    B7-B1             CLEAR PURGE BITS FROM SEQUENCED
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA3    X2+B7             IDENTS.
S2LCM     ELSE
          SX7    X2+B7             COMPUTE ADDRESS IN LCM.
          RX3    X7                READ LCM.
S2LCM     ENDIF 
          SPACE  1
          LX3    56 
          PL     X3,FCOR0B         THIS IDENT NOT SEQUENCD
          LX3    4
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          BX7    -X0*X3 
          SA7    A3 
S2LCM     ELSE
          BX3    -X0*X3            CLEAR BIT. 
          WX3    X7                STORE DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          EQ     FCOR0B 
  
*         REMOVE ALL SELPURGE BITS FROM THE DIRECTORY 
*         WHICH REFERENCE THE LAST DECK PROCESSED 
  
FCOR0C    SA1    L.PURYAN 
          ZR     X1,FCOR0A   IF PURYAN TABLE EMPTY
          SA2    F.PURYAN 
          SB2    X1 
          MX5    1
          SA1    F.DIRECT 
          SB4    X1 
          SB3    B1+B1
FCOR0C1   ZR     B2,FCOR0A   IF PURYAN TABLE COMPLETELY SEARCHED
          SB2    B2-B3
          SA3    X2+B2
          PL     X3,FCOR0C1  IF ENTRY NOT JUST PROCESSED
          BX3    X3-X5       CLEAR BIT 59 OF PURYAN ENTRY 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X3+B4       FETCH CORRESPONDING DIRECTORY ENTRY
          AX3    18 
          BX6    -X3*X1      CLEAR PURGE BIT IN DIRECTORY 
          MX7    0
          SA6    A1 
S2LCM     ELSE
          SX6    X3+B4             COMPUTE ADDRESS. 
          RX1    X6                FETCH CORRESPONDING DIRECTORY ENTRY. 
          AX3    18 
          BX1    -X3*X1            CLEAR PURGE BIT IN DIRECTORY.
          MX7    0
          WX1    X6                STORE ENTRY IN DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
          SA7    A3 
          SA7    A7+B1
          EQ     FCOR0C1
  
FCOR0A    SA1    COMP              IF NO COMPILE FILE IS
          ZR     X1,DONEALM        DESIRED.  JUMP TO DONEALM. 
          SA4    L.COMBAK 
          ZR     X4,FCORA          WE WERE NOT STOPPED IN A COMDECK.
          RJ     POSCOM 
          SX1    FCORA             SET UP EXIT TO FCORA 
          SX6    4                 AND JUMP BACK INTO WRCALL CODE 
          LX1    30 
          LX6    54 
          BX6    X1+X6
          SA6    WRCOMPIL 
          EQ     WRCALL4
          SPACE  1
FCORA     SA1    FMODE             IF WE HAVE A FULL UPDATE 
          SA2    XFLAG             COMPILE FILE IS COMPLETE, JUMP 
          ZR     X1,FCOR00         TO DONEALM.
          ZR     X2,DONEALM 
FCOR01    SA1    L.SCRIND 
          ZR     X1,DONEALM        ALL COPIED.
          SA2    F.SCRIND 
          SX6    X1-2 
          SX7    X2+2 
          SA6    A1 
          SA7    A2 
          SA1    X2                FETCH DECK ON SCRITCH
          SA5    FMODE
          SA4    A1+B1             FETCH RANDOM ADDRESS 
          ZR     X4,FCOR01   IF NULL ADDRESS, LOOP TO PROCESS SCRIND
          NZ     X5,FCOR04
          SA2    L.DKLIS
          SA3    F.DKLIS
          SB3    X2 
FCOR02    SB3    B3-B1
          NG     B3,FCOR01
          SA2    X3+B3
          LX2    58                SEARCH DKLIS FOR EACH ENTRY
          NG     X2,FCOR02         IN SCRIND.  IF THE DECK
          LX2    1                 HAS NOT YET BEEN WRITTEN TO
          PL     X2,FCOR02         THE COMPILE FILE, COPY IT THERE. 
          LX2    1
          BX0    X2-X1
          AX0    6
          NZ     X0,FCOR02         THIS PRODUCES A COMPILE FILE IN
 FCOR04   RJ     SFN=              OLDPL ORDER. 
          LX6    54 
          SA6    DNAME
          SA6    SCRMES+1 
          BX7    X4 
          SA7    UPDTSCR+6
          ADDWRD COMPFL,X1
          MESSAGE SCRMES,1
          CLEAR  UPDTSCR,READ 
FCOR03    RJ     RDCMPSCR 
          NZ     X1,FCOR01
          RJ     WRCOMPIL 
          EQ     FCOR03 
          SPACE  1
FCOR00    SA1    ORDERFLG 
          ZR     X1,FCOR01         CREATE COMPILE IN OLDPL ORDER
FCORCC    SA1    L.DKLIS
          ZR     X1,DONEALM 
          BX6    X1 
          SA6    WORKLGTH 
RETURNA   SA3    WORKLGTH 
          ZR     X3,DONEALM        QUIT WHEN ALL COPIED 
          SA1    F.DKLIS
          SA2    L.DKLIS
          SX6    X3-1              RESET WORKLGTH 
          SA6    A3 
          IX7    X2-X3
          IX3    X7+X1
          SA1    X3 
          SA2    L.SCRIND 
          LX1    58                CREATE COMPILE FILE IN COMPILE 
          NG     X1,RETURNA        CARD ORDER.
          LX1    1
          PL     X1,RETURNA 
          LX1    1
          SB4    X2 
          MX0    54 
          BX1    X0*X1             CLEAR EXTRANEOUS BITS
          RJ     SFN= 
          LX6    54 
          SA6    DNAME
          SA6    SCRMES+1 
          SA4    A1 
          CLEAR  UPDTSCR,READ 
          SA3    F.SCRIND          LOOK UP ADDRESS OF DECK ON 
          SA3    X3                SCRATCH FILE AND COPY IT TO
          SB2    B1+B1
RETURNB   LT     B4,B1,RETURNA
          SB4    B4-B2
          BX7    X3-X4
          SA3    A3+B2
          AX7    6
          NZ     X7,RETURNB 
          SA1    A3-B1
          BX7    X1 
          SA7    UPDTSCR+6
          SX6    B1 
          BX6    -X6*X4 
          SA6    A4 
          SA1    A1-B1
          ADDWRD COMPFL,X1
          SA1    UPDTSCR+6
          ZR     X1,RETURNA        IF NULL ADDRESS, DO NEXT DECK. 
          MESSAGE SCRMES,1
COPYCF    RJ     RDCMPSCR          COPY THIS DECK TO COMPILE FILE 
          NZ     X1,RETURNA 
          RJ     WRCOMPIL 
          EQ     COPYCF 
          SPACE  1
*  PUT DECK LIST AND DIRECTORY ON RANDOM NEWPL
          SPACE  1
 DONEALM  SA1    TXTFLAG
          ZR     X1,DONEALM0        IF MISSING ENDTEXT
          PRINT  (0*** UNBALANCED TEXT/ENDTEXT DIRECTIVES ***)
          SA1    NFERROR
          SX6    X1+B1             INCREMENT NON-FATAL ERROR COUNT
          SA6    A1 
 DONEALM0 BSS 
          SA1    NEWPL
          ZR     X1,DONEALM1
          SA1    RANDNPL
          NG     X1,DONEALM1       NOT RANDOM NEWPL 
          WRITER NEWPL,RECALL 
          RJ     COPYEND
          SA1    RANDTEMP 
 DONEALM1 ADDWRD NEWDKS,X1
          SA1    SCNUM                                                   CP190
          ZR     X1,DONEALM2
          SA2    SCNDPL            FETCH 1ST ENTRY OF SECONDARY PL       CP190B 
          MX1    -16               NAME TABLE.                           CP190B 
          BX6    -X1*X2            MASK OFF OFFSET VALUE.                CP190B 
          SA6    L.DIRECT          SET L.DIRECT TO ORIGINAL LENGTH.      CP190B 
 DONEALM2 SA1    RANDNPL
          ZR     X1,ERRCHECK
          NG     X1,ERRCHECK
UPDATEA3  BSS    0
          ENV    ACT,(2,3),VER2 
          SA2    CPYTOLIB          UPDATE(A) INDICATOR
          ZR     X2,NOAERR         IF NOT A MODE, NO CHECK NEEDED 
          SA2    NEWPL+FETFIT 
          FETCH  X2,BT,X1          LOAD BLOCK TYPE INTO X1
          ZR     X1,NOAERR         IF NEWPL IS NOT BLOCKED
          MESSAGE BTERROR          PRINT ERROR TO DAYFILE 
          EQ     ABORT             NOW JUST ABORT 
  
 VER2     ENDIF 
NOAERR    MX6    0
          SA6    ID1               ZERO OUT CELLS USED FOR INDEX
          SA6    N1                ADDRESSES
          SX6    ID1
          MX7    0
          SA6    NEWPL+6           SET INDEX ADDRESS
          SA7    X6 
          SA1    F.NEWDKS 
          SA2    L.NEWDKS 
          WRITEW NEWPL,X1,X2
          WRITER NEWPL,RECALL 
          CLEAR  NEWPL,WRITE
          SX6    N1 
          SA6    NEWPL+6
          SA1    F.DIRECT 
          SA2    L.DIRECT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          WRITEW NEWPL,X1,X2       WRITE OUT DIRECTORY
S2LCM     ELSE
          WBINL  NEWPL,X1,X2
S2LCM     ENDIF 
          SPACE  1
          WRITER NEWPL,RECALL 
          MX6    3                                                      0110  48
          SA3    L.NEWDKS 
          SA1    ID1               ADDRESS OF DECK LIST 
          BX6    X6+X1             SET 7 IN INDEX FOR COMPASS           0110  50
          LX3    30 
          SA4    L.DIRECT          LENGTH OF DIRECTORY
          BX6    X6+X3             COMBINE DECK ADDRESS AND LENGTH      0110  52
          LX4    30 
          SA2    A1+B1             ADDRESS OF DIRECT
          SA6    A1 
          BX7    X2+X4             COMBINE FOR DIRECT 
          SA7    A2 
          SA1    FLGCHAR           PUT CONTROL CHARACTER IN INDEX 
          BX6    X1 
          SA2    CHARKEY
          NG     X2,KEY64 
          ZR     X2,NOKEY64 
KEY64     SX2    1RY
          LX2    6
          BX6    X6+X2
NOKEY64   SX2    3                 INDEX LENGTH 
          SA1    MODENF            CHARACTER SET KEY
          SX1    X1+1R5            RESTORE ACTUAL CHARACTER 
          LX1    18                                                     0214  64
          BX6    X6+X1             PUT IN CSET KEY                      0214  65
          SA1    CPYTOLIB 
          ZR     X1,NOLAB          JUMP IF NOT COPY B OPTION
          SX2    1RL
          LX2    12 
          BX6    X6+X2             PUT L IN FLAG WORD 
          SA1    OLDPL+9           FETCH LABEL FROM FET 
          SA2    A1+B1
          BX7    X1 
          SA7    A7+2              STORE LABEL IN INDEX 
          BX7    X2 
          SA7    A7+B1
          SX2    5                 INDEX LENGTH 
NOLAB     SX3    B1                                                      CP190
          LX3    24                                                      CP190
          BX6    X6+X3             SET DECK BIT IN HEADER.               CP190
          SA6    A6+2                                                    CP190
          SX1    ID1               ORIGIN OF INDEX
          SB7    X2 
          LX2    18 
          BX6    X1+X2
          SA6    NEWPL+7           SET INDEX ADDRESS
          SA1    CPYTOLIB 
          NZ     X1,NOEOR 
          SPACE  1
ERRCHECK  SA1    L.DICT 
          NZ     X1,ERRS1 
          SA1    L.TDICT
          ZR     X1,FCOR1 
ERRS1     BSS    0
          SA1    LISTONE
          ZR     X1,FCOR7 
          PRINT  (0*** ERROR *** NOT ALL MODS WERE PROCESSED ***) 
          SPACE  1
*    PRINT OUT UNPROCESSED DICTIONARY ENTRIES 
          SPACE  1
          SA5    =10H 
          BX6    X5 
          LX7    X5 
          SA6    DNAME
          SA7    CARD1
          SA6    CARD2
          SA7    CARD3
          SA6    CARD4
 FCOR2    PRINT  =8L,1
          SA1    L.DICT 
          ZR     X1,FCOR6 
          SX6    X1-3              DECREMENT LENGTH 
          SA6    A1 
          SA2    F.DICT            UP ORIGIN
          SX6    X2+3 
          SA6    A2 
          SA1    X2                FETCH ENTRY TO DETERMINE PROPER TYPE 
          RJ     DETTYPE
          PRNTCARD
          PRINT  =8L,1
          PRINT  (0*** THE ABOVE SPECIFIED LINE WAS NOT ENCOUNTERED ***)
          SA1    FASTFLG
          ZR     X1,FCOR2 
          PRINT  (0*** IT MAY EXIST IN A DECK NOT MENTIONED ON A COMPILE
, DIRECTIVE ***)
          EQ     FCOR2
          SPACE  1
FCOR6     SA1    L.TDICT           PRINT OUT ANY UNPROCESSED -TDICT-
          ZR     X1,FCOR7          ENTRIES. 
          SX6    X1-3 
          SA6    A1 
          SA2    F.TDICT
          SX6    X2+3 
          SA6    A2 
          SA1    X2 
          SA2    =1H
          BX6    X2 
          LX3    X1 
          SA6    DNAME
          LX3    3
          SB7    B1 
          SA5    =9RRESTORE 
          NG     X3,FCOR4 
          SA5    =9RDELETE
FCOR4     RJ     MANUCARD 
          PRNTCARD
          PRINT  =8L,1
          PRINT  (0*** THE TERMINAL LINE SPECIFIED WAS NOT ENCOUNTERED *
,**)
          SA1    FASTFLG
          ZR     X1,FCOR6A
          PRINT  (0*** IT MAY EXIST IN A DECK NOT MENTIONED ON A COMPILE
, DIRECTIVE ***)
 FCOR6A   PRINT  =8L,1
          EQ     FCOR6
          SPACE  1
FCOR7     BSS    0
          SA1    ERRORS 
          SX6    X1+B1       BUMP ERROR COUNT 
          SA6    A1 
FCOR1     SA1    NFERROR
          ZR     X1,FCOR1A
          RJ     CONDEC 
          SA6    NFERRMSG 
          MESSAGE NFERRMSG
FCOR1A    BSS    0
          SPACE  1
N         IF     DEF,DECLKEY
          SA1    DTYPERR
          ZR     X1,FCOR1B
          RJ     CONDEC 
          SA6    DERRMSG
          MESSAGE DERRMSG 
N         ENDIF 
          SPACE  1
FCOR1B    BSS    0
          SA1      ERRORS 
          ZR     X1,FCOR1C
          SA2    ERRMODE
          ZR     X2,ABORT 
          RJ     CONDEC 
          SA6    FERMES 
          MESSAGE FERMES
FCOR1C    BSS    0
          SA1    OVMFLG            ANY OVERLAPPING CORRECTIONS
          ZR     X1,FCOR1D         NO, GO ON
          RJ     CONDEC 
          SA6    OVLPMSG           SET COUNT INTO MESSAGE 
          MESSAGE OVLPMSG    ISSUE OVERLAP MESSAGE
FCOR1D    BSS    0
E         IF     DEF,AUDITKEY 
          SA1    AUDIT
          ZR     X1,NOAUDIT2       IS AUDIT FLAG SET
          SA1    LISTSIX
          ZR   X1,NOAUD6           SKIP TOTALS IF NO LIST 6 
          RJ     TOTALS            PROCESS LAST TOTAL 
NOAUD6    WRITER AUDITFL
          REWIND AUDITFL
NOAUDIT2  BSS    0
E         ENDIF 
          WRITER SOURCE 
          SA1    COMP 
          ZR     X1,NOEOR 
          LX1    59-4              POSITION TO TEST EOR BIT 
          PL     X1,WRTEOR         IF END OF RECORD NOT YET WRITTEN 
          SA1    A1+2              ELSE GET IN POINTER
          SA2    A1+B1             GET OUT POINTER
          IX1    X2-X1
          ZR     X1,NOEOR          IF BUFFER IS EMPTY AND EOR WRITTEN 
WRTEOR    BSS    0                 ELSE WRITE EOR 
          ENV    ACT,(2,3),VER2 
          SA2    COMP+FETTYPE 
          NZ     X2,WRTEOR1        NOT W TYPE RECORD
          SA2    XMODE
          ZR     X2,WRTEOR1        NOT COMPRESSED FILE
          SA1    COMP+FETFIT
          PUTWP  X1,,0,,,,TERM     TERMINATE W CONTINUATION 
          MX7    0
          SA7    RLCMPL            RESET ACCUM PARTIAL LENGTH 
 VER2     ENDIF 
 WRTEOR1  BSS 
          WRITER COMP,R 
NOEOR     BSS    0
          RJ     FINALCPY          TERMINATE PROCESSING ON PL"S 
          SA1    CPYTOLIB 
          NZ     X1,NOAUDIT 
          SPACE  1
G         IF     DEF,PMODKEY
          SA1    L.MODKEY 
          ZR     X1,ENDPM          NO MODS PULLED 
          WRITER PTEMP
          SA1    GFILE
          MX0    42 
          BX2    X1*X0
          SA3    SOURCE 
          ZR     X3,SAME
          BX3    X3*X0
          IX3    X3-X2
          ZR     X3,SAME
          SA2    NOREWFLG 
          LX2    59-0 
          PL     X2,NORESOU 
          REWIND SOURCE 
  
          ENV    ACT,(2,3),VER2 
 NORESOU  BSS 
VER2      ELSE
 NORESOU  RECALL SOURCE 
VER2      ENDIF 
  
  
          ENV    ACT,(2,3),VER2 
 SAME     BSS 
          CLOSE  SOURCE 
VER2      ELSE
SAME      CLEAR  SOURCE 
VER2      ENDIF 
  
  
          SA1    GFILE
          SX0    B1 
          BX6    X1+X0             SET UP OUTPUT FILE 
          MX3    42 
          SA2    SOURCE 
          SA6    A2 
          BX2    X2*X3
          IX0    X1-X2
          SA2    MODEG
          MX6    0
          BX7    X2 
          SA6    NOCOMMON          FLAG FOR WRSOU TO WRITE EVERYTHING 
          SA7    MODES             SET UP MODE OF G FILE
  
          ENV    ACT,(2,3),VER2 
          OPEN   SOURCE,WRITENR 
VER2      ENDIF 
  
          ZR     X0,ENDPM1         IF S AND G FILES THE SAME. 
          SA2    NOREWFLG          CHECK -S- OPTION REWIND
          LX2    59-0 
          PL     X2,ENDPM1         IF NO REWIND FOR GFILE 
          REWIND SOURCE 
          CLEAR  SOURCE,WRITE 
ENDPM1    REWIND PTEMP
          CLEAR  PTEMP,READ 
          MX6    0
          SA6    TEMP 
          SA4    F.PMODS
          SA2    L.PMODS
          SA3    F.DIRECT 
          ZR     X2,ENDPM9         ALL MODS PROCESSED 
          SX6    X2-1 
          SB5    X3 
          SX7    X4+B1
          SA7    A4 
          SA4    X4 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X4+B5
S2LCM     ELSE
          SX1    X4+B5             COMPUTE ADDRESS. 
          RX1    X1                FETCH DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          SA6    A2 
          RJ     SFN= 
          SA2    =9RIDENT 
          SA3    FLGCHAR           DREATE IDENT CARD
          LX3    54 
          BX7    X2+X3
          SA7    CARD 
          SA6    A7+B1
          SA1    =8L
          BX7    X1 
          SA7    A6+B1
          MX6    0
          SA6    CARD8
          SA6    SQLGN
          SA6    SQLGN8 
          AX4    36 
          SX7    X4                POINTER
          SA7    TEMP1
          NZ     X7,ENDPM1A 
          RJ     WRSOU
          EQ   ENDPM1              GO PROCESS NEXT PULLMOD              0282  10
          SPACE  1                                                      0282  11
 ENDPM1A  RJ     WRSOU
 ENDPM2   SA1    F.MODKEY 
          SA2    TEMP1
          SB3    X1 
          SA1    X2+B3             FIRST MOD
          SA0    A1 
          AX1    36 
          SX7    X1 
          SA7    A2 
          AX1    18 
          ZR     X1,ENDPM3         POINTER TO A CARD IMAGE
          SA2    A1 
          SB7    B0 
          LX2    1
          SA5    =9RINSERT
          NG     X2,ENDPM4
          SB7    B1 
          LX2    2                 SHIFT TO RESTAORE BIT                0512   8
          SA5    =9RRESTORE 
          NG     X2,ENDPM4
          SA5    =9RDELETE
ENDPM4    SA1    A1 
          RJ     MANUCARD 
          RJ     WRSOU
          EQ     ENDPM5 
          SPACE  1
 ENDPM3   SA1    A0 
          MX0    36 
          SA5    TEMP 
          BX2    -X0*X1 
          IX0    X2-X5
          LX1    24                SIGN EXTEND CARD IMAGE SIZE
          AX1    48 
          BX7    X1 
          SA7    SQLGN
          ZR     X0,ENDPM3B        AT RIGHT CARD
          SX7    LBUFC
          IX2    X7-X0
          NG     X2,ENDPM3A        TOO MUCH TO READ INTO BUFFER 
          IX6    X5+X0
          SA6    A5                INCREMENT BIAS POINTER 
          ZR     X0,ENDPM3B        NOTHING TO READ
          READW  PTEMP,BUFC,X0     READ UP TO DESIRED WORD
ENDPM3B   SA1    SQLGN
          MX6    0
          SA6    CARD 
          SA6    CARD8
          SA6    SQLGN8 
          PL     X1,ENDPM3C        6-BIT CARD IMAGE 
          BX7    -X1               8-BIT CARD IMAGE 
          SA7    A6 
          SA6    A1 
          SA1    A7 
 ENDPM3C  BSS    0
          SA5    TEMP 
          IX7    X1+X5             INCREMENT BIAS 
          SA7    A5 
          ZR     X1,ENDPM3D        NULL CARD
          READW  PTEMP,A1+B1,X1 
 ENDPM3D  RJ     WRSOU
 ENDPM5   SA2    TEMP1
          ZR     X2,ENDPM1
          EQ     ENDPM2 
          SPACE  1
ENDPM3A   IX6    X7+X5                                                  0582   8
          SA6    A5                INCR PTEMP POINTER BY LBUFC          0582   9
          READW  PTEMP,BUFC,X7
          EQ     ENDPM3 
          SPACE  1
ENDPM9    WRITER SOURCE 
  
          CLOSE  PTEMP,UNLOAD      UNLOAD PULLMOD SCRATCH FILE
  
ENDPM     BSS    0
G         ENDIF 
          SPACE  1
          SA1      NOREWFLG 
          LX1    59-1 
          PL     X1,NOREW11A
  
          ENV    ACT,(2,3),VER2 
          CLOSE  COMP,REWIND
          EQ     NOREW11B 
 NOREW11A BSS 
          CLOSE  COMP 
 NOREW11B SA1    NOREWFLG 
          LX1    59 
          PL     X1,NOREW11C
          CLOSE  SOURCE,REWIND
          EQ     NOREW11
 NOREW11C BSS 
          CLOSE  SOURCE 
VER2      ELSE
          REWIND COMP 
 NOREW11A SA1    NOREWFLG 
          LX1    59-0 
          PL     X1,NOREW11 
          REWIND SOURCE 
VER2      ENDIF 
  
NOREW11   BSS      0
          SPACE  1
  
          ENV    NOT,(11),VER2
  
          SX0    B1                ERASE THE RANDOM BIT AND UNLOAD
          SA1    UPDTEXT+1         THE SCRATCH FILES. 
          LX0    47 
          SA2    UPDTSCR+1
          SA3    UPDTCDK+1
          BX6    -X0*X1 
          BX7    -X0*X2 
          SA6    A1 
          SA7    A2 
          BX6    -X0*X3 
          SA6    A3 
          CLOSE  UPDTEXT,UNLOAD 
          CLOSE  UPDTSCR,UNLOAD 
          CLOSE  UPDTCDK,UNLOAD 
  
VER2      ELSE
* 
          EVICT  UPDTEXT
          EVICT  UPDTSCR
          EVICT  UPDTCDK
VER2      ENDIF 
          SPACE  2
  
*     LIST OUT DECKS WRITTEN ONTO COMPILE FILE
          SPACE  1
          SA1    LISTA
          ZR     X1,NOLISTA        NO TABLE LIST
          SA2    L.DEFTAB 
          ZR     X2,NODEFINE
          MOVE   3,DEFTITLE,TITLE+3 
          SA4    LPCNT
          SA2    L.DEFTAB 
          SX4    X4+8 
          AX2    3
          RJ     DUMLTST
          IX4    X4+X2
          SA1    JPS
          IX7    X4-X1
          PL     X7,DEFDUMP        NEED NEW PAGE
          PRINT  =8L0,1 
          PRINT  TITLE+2,4
          PRINT  =8L,1
          EQ     DEFDUMP1 
          SPACE  1
 DEFDUMP  SX6    EJECT
          SA6    LPCNT
DEFDUMP1  SA2    L.DEFTAB 
          SA1    F.DEFTAB 
          SX6    B1 
          RJ     DUML 
NODEFINE  SA2    L.COMIND 
          ZR     X2,DONE3          JUMP IF NOT COMMON DECKS 
          MOVE   3,LTTS,TITLE+3 
          SA4    LPCNT
          SA2    L.COMIND 
          AX2    4
          RJ     DUMLTST
          SX4    X4+10
          IX4    X4+X2
          SA1    JPS
          IX7    X4-X1
          PL     X7,DONECD
          PRINT  =8L0,1 
          PRINT  TITLE+2,4
          PRINT  =8L,1
          EQ     DONECD1
          SPACE  1
 DONECD   SX6    EJECT
          SA6    LPCNT
DONECD1   SA2    L.COMIND 
          SA1    F.COMIND 
          SX6    B1+B1             TABLE INCREMENT
          RJ     DUML 
DONE3     BSS    0
          MOVE   3,LTTT,TITLE+3 
          SA2    L.COMPFL 
          ZR     X2,DONEUP4B
          SA1    F.COMPFL          CHECK FIRST ENTRY OF COMPFL
          SA3    =7LYANK$$$ 
          SA4    X1 
          IX0    X3-X4
          NZ     X0,DONE3A   IF NOT *YANK$$$* 
          SX6    X2-1 
          ZR     X6,DONEUP4B IF NO OTHER DECKS
          SX7    X1+B1
          SA6    A2 
          SA7    A1          DELETE *YANK$$$* DECKNAME
          BX2    X6 
DONE3A    SA4    LPCNT
          AX2    3
          RJ     DUMLTST
          SX4    X4+10
          IX4    X4+X2
          SA1    JPS
          IX7    X4-X1
          PL     X7,DONEUP3 
          PRINT  =8L0,1 
          PRINT  TITLE+2,4
          PRINT  =8L,1
          EQ     DONEUP4A 
          SPACE  1
 DONEUP3  SX6    EJECT
          SA6    LPCNT
 DONEUP4A SA1    F.COMPFL 
          SA2    L.COMPFL 
          SX6    B1 
          RJ     DUML 
DONEUP4B  SA1    =1H
          BX6    X1 
          LX7    X1 
          SA6    TITLE+3
          SA7    A6+B1
          SA6    A7+B1
          SA1    MAXCORE
          SX1    X1+BUCKET
          SX1    X1+77B 
          AX1    6
          LX1    6
          MX0    57 
          SA5    =6R000000
          SB5    5
DONEUP5   BX6    -X0*X1 
          LX0    6
          SB5    B5-B1
          IX5    X5+X6             CONVERT TO DISPLAY CODE
          LX1    3
          PL     B5,DONEUP5 
          NZ     X6,DONEUP6 
          LX5    6
          SX4    B1+B1
          IX5    X5+X4
          MX0    24 
          BX5    -X0*X5 
DONEUP6   SA4    =4LED
          BX6    X4+X5
          SA6    SIZMES+2 
          PRINT  =8L0,1 
          PRINT  SIZMES,5 
          SPACE  1
          ENV    ACT,(2,3),S2LCM
          SA1    SIZECORL          SET UP LCM USAGE LINE
          MX0    57 
          SA5    =6R000000
          SB5    5
ZONEUP5   BX6    -X0*X1 
          LX0    6
          SB5    B5-B1
          IX5    X5+X6             CONVERT TO DISPLAY CODE
          LX1    3
          PL     B5,ZONEUP5 
          NZ     X6,ZONEUP6 
          LX5    6
          SX4    B1+B1
          IX5    X5+X4
          MX0    24 
          BX5    -X0*X5 
ZONEUP6   SA4    =4LND
          BX6    X4+X5
          SA6    SIZMEL+2 
          PRINT  SIZMEL,5 
S2LCM     ENDIF 
          SPACE  1
NOLISTA   BSS    0
          SPACE  1
E         IF     DEF,AUDITKEY 
          SA1    AUDIT
          ZR     X1,NOAUDIT        JUMP IF NO AUDIT REQUESTED 
          MOVE   3,AUDTITLM,TITLE+3 
          CLEAR  AUDITFL,READ 
 COPYAUD0 PRINT  =1L1,1 
 COPYAUD1 READC  AUDITFL,ALLBUF,ALLSIZE  COPY AUDIT FILE TO OUTPUT
          NZ     X1,COPYAUD3       DONE 
          SA1    ALLBUF 
          SA2    =1L1 
          IX2    X1-X2
          NZ     X2,COPYAUD2       NOT TITLE LINE 
          SA1    LISTSEVN 
          ZR     X1,COPYAUD0       NO FOOTING NEEDED
          PRINT  =1L,1             FOOTING FOR SEVEN LIST 
          PRINT  FOOT1,9
          PRINT  FOOT2,9
          EQ     COPYAUD0 
  
 COPYAUD2 WRITEC OUTPUT,ALLBUF
          EQ     COPYAUD1 
          SPACE  1
 COPYAUD3 SA1    LISTSEVN 
          SA2    LINCOUNT 
          SX6    3
          IX6    X2-X6             FOOTINGS ALREADY COUNTED 
          SA6    LPCNT
          ZR     X1,COPYAUD4
          PRINT  =1L,1             FINAL FOOTING
          PRINT  FOOT1,9
          PRINT  FOOT2,9
  
 COPYAUD4 SA1    LISTSIX
          ZR     X1,NOAUDIT1       TOTALS 
          SA1    =6LTOTALS
          BX6    X1 
          SA6    DNTITLE
          PRINT  TOTITLE,6         PRINT HEADINGS 
          PRINT  TOTITLE1,5 
          PRINT  =8L,1
          SA1    L.AUDCNT 
          BX6    X1 
          SA6    TEMP 
SUMTOTLP  SA3    TEMP              SCAN -CNTR-, SKIPPING
          ZR     X3,NOAUDIT1       PURGED ENTRIES, PRINTING 
          SA1    L.AUDCNT          ALL OTHER MASTER TOTALS
          SA2    F.AUDCNT          IN THE SAME FORMAT AS OTHER
          IX0    X1-X3             TOTALS 
          SA4    F.DIRECT 
          SB4    X0 
          AX0    1
          SB3    X0 
          SA1    X2+B4             FIRST WORD OF AUDCNT ENTRY 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X4+B3
S2LCM     ELSE
          SX2    X4+B3             COMPUTE ADDRESS. 
          RX2    X2                FETCH DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          SX6    X3-2 
          MX0    54 
          SX3    1R 
          SA6    A3 
          LX2    55 
          NG     X2,SUMTOTLP
          LX2    5
          BX6    X0*X2
          LX0    6
SUMTOTL1  BX4    -X0*X6 
          LX0    6
          BX6    X6+X3
          LX3    6
          ZR     X4,SUMTOTL1
          SA6    AUDITEXT+1 
          BX7    X1 
          MX0    30 
          BX1    -X0*X1 
          RJ     CONDEC 
          SA6    AUDITEXT+4 
          BX1    X7 
          MX0    30 
          AX1    30 
          BX1    -X0*X1 
          SA5    FMODE
          NZ     X5,SUMTOTL2 IF IN FMODE CONTINUE PROCESSING DECK TOTALS
          ZR     X1,SUMTOTLP IF NOT IN FMODE ONLY THE IDENTS
*                            ENCOUNTERED DURING PROCESSING OF DECKS 
*                            SPECIFIED ON COMPILE DIRECTIVE ARE LISTED
*                            UNDER DECK TOTALS
SUMTOTL2  RJ     CONDEC 
          SA6    AUDITEXT+3 
          PRINT  AUDITEXT,6 
          SA1    LPCNT             PRINT APPROPRIATE HEADINGS ON
          SA2    JPS
          IX2    X1-X2
          NZ     X2,SUMTOTLP
          PRINT  =8L,1
          PRINT  TOTITLE,6
          PRINT  =8L,1
          PRINT  TOTITLE1,5 
          PRINT  =8L,1
          EQ     SUMTOTLP 
          SPACE  1
 NOAUDIT1 CLOSE  AUDITFL,UNLOAD 
E         ENDIF 
          SPACE  1
NOAUDIT   BSS    0
          WRITER OUTPUT 
          MESSAGE  (=C* UPDATE COMPLETE.*)
          RJ     COMPLETE          FINISH I/O ON ALL FILES
  
          SPACE  1
  
          ENV    NOT,(2,3),VER2 
W         IF     DEF,DYNAMFL
          SA1    CORESIZE 
          SA2    ORIGSIZE 
          IX0    X2-X1
          PL     X0,THEEND
          MEMORY CM,MAXMEM,R,X2 
THEEND    BSS    0
W         ENDIF 
VER2      ENDIF 
  
          ENDRUN
          PS
          TITLE  USEFUL SUBROUTINES 
          EJECT 
          EJECT 
**        ABORT  ABORTS JOB                                             01255421
*                                                                       01255422
*         CLOSES OUT FILES, PRINTS TABLES AND CALLS PP ROUTINE ABT TO   01255423
*         END JOB.                                                      01255424
*                                                                       01255425
*         CALLS  CONDEC, CALLPP, DUMDIR,I/O ROUTINES, COMPLETE, CALLPP  01255426
                                                                        01255427
ABORT     SA1    ERRORS 
          ZR     X1,ABORT1
          RJ     CONDEC 
          SA6    ABMSG
 ABORT1   MESSAGE ABMSG 
          RJ     DUMDIR 
          PRINT  ABMSG,4
          WRITER OUTPUT 
          WRITEF COMP 
          WRITEF SOURCE 
          CLOSE  UPDTEXT,UNLOAD 
          CLOSE  UPDTSCR,UNLOAD 
          CLOSE  UPDTCDK,UNLOAD 
          SA1    NOREWFLG 
          BX7    X1 
          LX7    59-3 
          PL     X7,NOREW7A 
          REWIND OLDPL
NOREW7A   LX7    1
          PL     X7,NOREW7B 
          REWIND NEWPL
NOREW7B   LX7    1
          PL     X7,NOREW7C 
          REWIND COMP 
NOREW7C   LX7    1
          PL     X7,NOREW7
          REWIND SOURCE 
NOREW7    RJ     COMPLETE          MAKE SURE ALL FILES ARE COMPLETE 
          SA1    ERRMODE
          NZ     X1,ABORT2
  
          ABORT 
 ABORT2   ENDRUN
          PS
          EJECT  4                                                      01255429
**        ADDID  ADD VISUAL IDENTIFICATION TO CARD                      01255430
*                                                                       01255431
*         FORMATS SEQUENCE INFORMATION ON A CARD TO BE WRITTEN TO       01255432
*         OUTPUT FILE.                                                  01255433
*                                                                       01255434
*         CALLS ADDIDA                                                  01255435
          SPACE  1
ADDID     PS
          SA1    CHBTAB            FETCH IDENT ORDINAL
          MX2    44 
          BX3    -X2*X1            REMOVE YANK AND ACTIV BITS 
          SA2    F.DIRECT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SB3    X3 
          SA1    X2+B3             FETCH IDENT NAME 
S2LCM     ELSE
          IX1    X2+X3             COMPUTE ADDRESS. 
          RX1    X1                FETCH IDENT NAME.
S2LCM     ENDIF 
          SPACE  1
          SA4    SEQNUM 
          SB7    L.IDW             LISTING IDENT WIDTH
          RJ     ADDIDA            FORMAT IDENTIFICATION
          RJ     ADDIDL            PLACE IN LINE IMAGE
          EQ     ADDID
          SPACE  4
**        ADDIDL MOVE IDFIELD INTO LINE IMAGE 
* 
*         MOVES IDFIELD INTO CARD1, CARD2 FOR PRINTING
  
 ADDIDL   PS     ** 
          SA1    IDFIELD           FIRST WORD OF IDENTIFIER 
          MX0    6
          SA2    A1+B1
          LX1    60-6              SHIFT RIGHT ONE CHARACTER
          SX6    1R                BLANK FOR LEFT FILL
          BX7    X0*X1             CHARACTER TO MOVE TO NEXT WORD 
          LX6    60-6              POSITION BLANK 
          BX1    -X0*X1 
          IX6    X1+X6             BLANK ADDED AT LEFT
          SA6    CARD1
          LX2    60-6              POSITION SECOND WORD 
          BX2    -X0*X2 
          IX7    X2+X7             ADD CHARACTER FROM PREVIOUS WORD 
          MX0    6*L.IDW-54 
          BX1    X0*X7             GET RID OF UNWANTED CHARACTERS AT END
          RJ     SFN=              SPACE FILL 
          SA6    CARD2
          EQ     ADDIDL 
          EJECT  4                                                      01255437
**        ADDIDA FORMATS CARD IDENTIFICATIONS                           01255438
*                                                                       01255439
*         FORMATS IDS FOR LISTING AND COMPILE FILES.
*         ENTRY  X1 - ZERO PADDED IDENT 
*                X4 - BINARY SEQUENCE NUMBER
*                B7 - WIDTH OF IDENT FIELD (0 .LE. B7 .LE. 20)
* 
*         CALLS  SFN=, CONDEC 
  
 ADDIDA   PS
          ZR     B7,ADDIDA         ZERO WIDTH 
          MX0    54 
          BX1    X0*X1
          RJ     SFN= 
          BX1    X4 
          LX7    X6                X7 = IDENT.....
          RJ     CONDEC            X6 = ....NNNNNN,  B2 = 6*DIGITS
          SX4    B7-10-1
          NG     X4,ADDID1         NO SECOND WORD 
          SX4    X4+B1             NUMBER OF CHARACTERS IN SECOND WORD
          LX4    1                 *2 
          LX5    X4,B1             *4 
          IX4    X4+X5             *6 = NUMBER OF BITS
          BX4    -X4
          SB4    X4                -NUMBER OF BITS
          SB5    60+X4             SHIFT COUNT
          LX6    B5                POSITION ADJUST SEQUENCE NUMBER
          SA6    IDFIELD+1
          SB2    B4+B2             NUMBER OF BITS TO SPILL INTO WORD 1
          LE     B2,B0,ADDID2      NONE 
          SB7    10 
 ADDID1   SB5    B2-B1
          MX0    1
          AX0    B5 
          LX0    B2                CHARACTER MASK 
          SX4    B7+B7
          BX6    X0*X6
          LX5    X4,B1
          IX4    X4+X5             NUMBER OF BITS IN WORD 1 
          BX4    -X4
          SB5    60+X4             SHIFT COUNT
          LX0    B5 
          LX6    B5 
          BX7    -X0*X7            MASK ROOM FOR NUMBER 
          IX7    X6+X7             INSERT NUMBER
 ADDID2   SA7    IDFIELD
          EQ     ADDIDA 
          SPACE  4
          ENV    ACT,(2,3),S2LCM
          EJECT  4
**        ADDWRDL - ADD WORD TO DIRECT
* 
*         ENTRY  (X1) = DATA WORD TO BE ADDED TO DIRECT 
* 
*         EXIT   (X2) = LCM ORIGIN OF DIRECT (O.DIRECT) 
*                (X3) = LENGTH OF DIRECT (L.DIRECT) 
          SPACE  1
ADDWRDL   DATA   0
          SA2    F.DIRECT          FETCH ORIGIN.
          SA3    L.DIRECT          FETCH LENGTH.
          SX6    X3+B1             ADD ONE TO LENGTH AND
          SA6    A3                STORE IT IN L.DIRECT.
          IX6    X2+X3             ADDRESS OF WHERE TO STORE. 
          SA4    SIZECORL          FETCH CURRENT LCM SIZE.
          IX7    X6-X4             CURRENT MINUS LAST.
          NG     X7,ADWL10         JUMP IF ROOM LEFT
          SX7    X4+1000B          NEW FLL REQUIRED 
          LX7    30                FORM REQUEST.
          SA7    A4 
          MEMORY LCM,SIZECORL 
          LX7    30 
          SA7    A7 
ADWL10    BSS 
          WX1    X6                WRITE ENTRY TO DIRECT. 
          SA3    A3                PUT L.DIRECT INTO X3.
          EQ     ADDWRDL
S2LCM     ENDIF 
  
**        CHEKADF CHECKS FOR ADDFILES                                   01255510
*                                                                       01255511
*         CHEKADF IS CALLED FROM CHKPURY EACH TIME AN                   01255512
*         ACTIVE DECK OR COMDECK CARD IS ENCOUNTERED AND                01255513
*         ONCE FROM FCOR AT THE END OF PASS 2 PROCESSING.               01255514
*         THE DICTIONARY IS SEARCHED FOR ADDFILE ENTRIES                01255515
*         WHICH PERTAIN TO THE LAST DECK PROCESSED.                     01255516
*         GETLIM+1 MUST CONTAIN THE ZERO-FILLED NAME OF                 01255517
*         THE DECK JUST PROCESSED.  IF ADDFILE ENTRIES                  01255518
*         ARE FOUND WHICH APPLY TO THE LAST DECK, THEY                  01255519
*         ARE MOVED FROM DICT TO THE FRONT OF TDICT AND                 01255520
*         ARE ACTIVATED BY HAVING WORD 1 SET TO ZERO.                   01255521
*         THE CURRENT DECK OR COMDECK CARD IS SAVED BY                  01255522
*         SAVECARD AND FROM THIS POINT THE ADDFILE ENTRIES              01255523
*         ARE TREATED IN THE SAME WAY AS ARE INSERTS.                   01255524
*         WHEN CHEKADF IS CALLED FROM FCOR, NO CURRENT                  01255525
*         CARD EXISTS, SO SAVECARD IS NOT CALLED.  THE                  01255526
*         CALL FROM FCOR IS FLAGGED BY HAVING IDFLG SET                 01255527
*         TO ZERO.  AFTER SAVECARD HAS BEEN CALLED, IDFLG               01255528
*         IS RESET TO THE PREVIOUS DECK NAME AND SEQNUM                 01255529
*         IS SET TO AN IMPOSSIBLE SEQUENCE NUMBER (-0)                  01255530
*         SO THAT NO POSSIBLILITY OF CONFLICT CAN OCCUR.                01255531
*                                                                       01255532
*         CALLS  SQUIZOUT, SAVECARD, MANAGER, MOVEIT                    01255533
                                                                        01255534
CHEKADF   PS
          MX6    0
          SA6    TEMP1
          MX1    0                 INITIALIZE TABLE OFFSET
CHEKADF1  BSS    0
          SA2    L.DICT 
          SA3    F.DICT 
          SX1    X1-3              INSURES RECHECKING CURRENT ENTRY 
          SB4    X3                BEGINNING OF DICT
          SB3    3                 TABLE ENTRY SIZE 
CHKPURY5  BSS    0
          SX1    X1+B3             INCREMENT TABLE POINTER
          IX7    X1-X2
          PL     X7,CHKPURY4       IF DICT TABLE EXHAUSTED
          SA4    B4+X1             FETCH NEXT TABLE ENTRY 
          LX4    5
          PL     X4,CHKPURY5       NOT AN ADDFILE 
          SA3    GETLIMT+1         FETCH OLD DECK NAME
          LX4    1
          BX7    X4-X3
          AX7    1
          NZ     X7,CHKPURY5       NOT SAME DECK
          SX6    X1 
          SA6    TEMP 
          SA1    TEMP1
          NZ     X1,CHKPURX2
          SA5    BEFFLAG
          SA1    F.TDICT
          SA2    L.TDICT
          SX6    X5+B1             TURN OFF ALL CURRENTLY ACTIVE
          SB4    X2                INSERTS
          SB3    3
CHKPURX1  SB4    B4-B3
          NG     B4,CHKPURX2
          SA2    X1+B4
          NZ     X2,CHKPURX1
          SA6    A2 
          EQ     CHKPURX1 
          SPACE  1
CHKPURX2  BSS    0
          ALLOC  TDICT,3
          MOVE X3-3,X2,X2+3 
          SA1    TEMP 
          SA2    F.DICT 
          SB3    B1+B1
          SB2    X1+B3
          SA1    X2+B2
          BX7    X1 
          SA7    TEMP1
          SA3    F.TDICT
          SA7    X3+B3
          MX6    0
          SA6    A7-B1
          SA6    A6-B1
          RJ     SQUIZOUT 
          SA1    TEMP 
          EQ     CHEKADF1 
          SPACE  1
CHKPURY4  SA1    TEMP1
          ZR     X1,CHEKADF 
          SA1    IDFLG
          ZR     X1,ECOR1 
          RJ     SAVECARD 
          MX7    60 
          SA7    SEQNUM 
          EQ     ECOR1
          EJECT  4                                                      01255536
**        CHKDCKS SEARCHES DECK TABLE FOR DECK                          01255537
*                                                                       01255538
*         ENTRY  X7 - NAME OF DECK TO BE SEARCHED FOR, ZERO FILLED      01255539
*                                                                       01255540
*         EXIT   X0 - 0 IF MATCH FOUND                                  01255541
*                     NON ZERO IF NO MATCH                              01255542
* 
*                A2 - ADDRESS OF DECK TABLE ENTRY IF FOUND. 
          SPACE  1
          SPACE  1
CHKDCKS   PS
          SA3    F.DECKS
          SA4    L.DECKS
          MX5    54 
          SB2    B1+B1
          SB5    X4 
          SB6    B0 
LOOPSA    SA2    X3+B6
          SB6    B6+B2
          BX0    X2-X7
          BX0    X0*X5
          ZR     X0,CHKDCKS 
          LT     B6,B5,LOOPSA          LOOP 
          EQ     CHKDCKS               EXIT 
          SPACE  4
**        CHKFILE CHECKS FOR DUPLICATE FILES                            01255544
*                                                                       01255545
*         CHKFILE ABORTS IF THIS FILE NAME IS LONGER                    01255546
*         THAN SEVEN CHARACTERS OR IS A DUPLICATE OF A FILE             01255547
*         NAME IN ANOTHER OF UPDATE"S FETS.                             01255548
*                                                                       01255549
*         ENTRY  X1 - FILE NAME                                         01255550
*                A1 - FWA OF FET                                        01255551
*                                                                       01255552
*         REGISTERS SAVED - A0, A1, A3-A7, X4-X6, B1,B3                 01255553
*                                                                       01255554
*         CALLS  PAD, CALLPP, PRINT                                     01255555
          SPACE  1
CHKFILE   PS
          ZR     X1,CHKFILE        EXIT IF NO NAME
          MX0    42                7 CHARACTER MASK 
          BX6    -X0*X1 
          BX1    X0*X1
          AX6    6                                                      1365   5
          NZ     X6,TOOLONG 
  
          ENV    ACT,(2,3),VER2 
          SB2    LFET 
          SB4    FILES-LFET 
VER2      ELSE
          SB2    13                LENGTH OF FET
          SB4    FILES-13 
VER2      ENDIF 
  
          SB7    NFILES 
          SB5    A1 
          SB6    B0 
LOOPS     SA2    B4+B2             FETCH A FILE 
          SB6    B6+B1             INCREMENT NUMBER PROCESSED 
          BX2    X0*X2             MASK JUNK
          SB4    B4+B2
          EQ     B4,B5,LOOPS       LOOP IF THIS FILE
          BX3    X2-X1             COMPARE NAME 
          ZR     X3,DUPE           JUMP IF DUPLICATE FOUND
          LT     B6,B7,LOOPS
          EQ     CHKFILE
          SPACE  1
TOOLONG   SA2    LISTONE
          ZR     X2,DFMESS1 
          LX6    6
          BX1    X1+X6
          RJ     SFN= 
          SA6    LONG+2 
          PRINT LONG,6
DFMESS1   MESSAGE MESG6                                                  CP190
          SA1    ERRMODE
          NZ     X1,CHKFILE 
          EQ     ABORT
          SPACE  1
DUPE      SA2    LISTONE
          ZR   X2,DFMESS                                                0602  12
          RJ     SFN= 
          SA6    DUPM+3 
          PRINT  DUPM,6 
 DFMESS   MESSAGE (=C+DUPLICATE FILE NAME+) 
          SA1    ERRMODE
          NZ     X1,CHKFILE 
          EQ     ABORT
          EJECT  4                                                      01255557
**        CHKPURY CHECKS FOR PURGES AND YANKS                           01255558
*                                                                       01255559
*         CHKPURY IS CALLED WHENEVER AN ACTIVE DECK OR                  01255560
*         COMDECK IS READ.  (DECKS READ FROM THE OLDPL                  01255561
*         WHICH WERE INACTIVE ON THE OLDPL AS A RESULT                  01255562
*         OF A YANKDECK, ARE CONSIDERED ACTIVE FOR PUR-                 01255563
*         POSES OF CHKPURY.)  CHEKADF IS CALLED TO SET                  01255564
*         UP ADDFILES.  IF THERE ARE ANY ENTRIES IN THE                 01255565
*         PURYAN TABLE (SELPURGE OR SELYANK), THAT TABLE                01255566
*         IS SEARCHED AND UPDATED.  ANY ENTRIES ACTIVE                  01255567
*         FROM THE LAST SEARCH OF PURYAN ARE DEACTIVATED                01255568
*         AND ANY ENTRIES WHICH APPLY TO THE CURRENT DECK               01255569
*         ARE PROCESSED (THE APPROPRIATE DIRECTORY BIT                  01255570
*         IS SET OR CLEARED).  IF THE CURRENT DECK IS                   01255571
*         TO BE PURDECKED (BIT 0 OF DECKS ENTRY ON) OR                  01255572
*         YANKDECKED (BIT 5 OF DECKS ENTRY ON), THE AP-                 01255573
*         PROPRIATE FLAG IS SET.  PURGFLAG IS SET NON-                  01255574
*         ZERO IF THIS DECK IS TO BE PURGED, .YANKFLAG                  01255575
*         IS SET TO ZERO IF IT IS TO BE YANKED.  IF THE                 01255576
*         CURRENT DECK IS TO BE SEQUENCED (BIT 3 OF THE                 01255577
*         CORRESPONDING DIRECTORY ENTRY), ANY IDENT WHICH               01255578
*         IS TO BE USED FOR RESEQUENCING HAS THE PURGE                  01255579
*         BIT SET ON AT ALL TIMES OTHER THAN WHILE THE                  01255580
*         CORRESPONDING DECK IS BEING PROCESSED.  THIS                  01255581
*         MUST BE DONE IN ORDER THAT NO CARDS CAN EXIST                 01255582
*         OUTSIDE OF THE RESEQUENCED DECK WHICH BELONG                  01255583
*         TO THE RESEQUENCING IDENT.                                    01255584
*                                                                       01255585
*         CALLS  CHEKADF, CHKDKS, TLUDIR, CALLPP, PRINT                 01255586
                                                                        01255587
CHKPURY   SA1    L.DICT 
          ZR     X1,CHKPURY6
          RJ     CHEKADF
CHKPURY6  SA1    L.PURYAN 
          SA2    F.PURYAN 
          MX5    1                 REMOVE BIT 
          SB2    X1                LENGTH 
          SA4    IDFLG             CURRENT DECK NAME
          SA1    F.DIRECT 
          SB4    X1 
          SB3    B1+B1
CHKPURY9  ZR     B2,CHKNEWS 
          SB2    B2-B3
          SA3    X2+B2
          PL     X3,CHKPURY9       REMOVE ALL ENTRIES FROM LAST DECK
          BX3    X3-X5
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X3+B4             FETCH DIRECTORY ENTRY
          AX3    18                SHIFT TO MASK
          BX6    -X3*X1            REMOVE BIT FROM TABLE
          MX7    0
          SA6    A1 
S2LCM     ELSE
          SX6    X3+B4             COMPUTE LCM ADDRESS. 
          RX1    X6                FETCH DIRECTORY ENTRY. 
          AX3    18                SHIFT TO MASK. 
          BX1    -X3*X1            REMOVE BIT FROM TABLE. 
          MX7    0
          WX1    X6                REWRITE DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          SA7    A3                ERASE ENTRY
          SA7    A7+B1
          EQ     CHKPURY9 
          SPACE    1
CHKNEWS   SA1    L.PURYAN 
          SB2    X1 
CHKPURY8  ZR     B2,CHKPURY1
          SB2    B2-B3
          SA3    X2+B2
          ZR     X3,CHKPURY8
          SA1    A3+B1
          IX7    X1-X4
          NZ     X7,CHKPURY8
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X3+B4             FETCH DIRECTORY ENTRY
          AX3    18                SHIFT TO PICK UP MASK
          BX7    X1+X3             AND ENTER APPROPRIATE
          SA7    A1                BIT INTO DIRECTORY 
S2LCM     ELSE
          SX7    X3+B4             COMPUTE LCM ADDRESS. 
          RX1    X7                FETCH DIRECTORY ENTRY. 
          AX3    18                SHIFT TO PICK UP MASK. 
          BX1    X1+X3             ENTER APPROPRIATE
          WX1    X7                BIT INTO DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
          SA3    A3                ADD THE REMOVE BIT 
          BX6    X3+X5             SO THAT THE NEXT TRIP
          SA6    A3                WILL ERASE THIS ENTRY
          EQ     CHKPURY8 
          SPACE  1
CHKPURY1  MX6    1
          SA6    YANKFLAG 
          MX6    0
          SA6    PURGFLAG 
          SB4    B0 
          BX7    X4 
          SB3    B0 
          RJ     CHKDCKS
          NZ     X0,CHKPURYZ       NO ENTRY--USE DEFAULT VALUES 
          SB7    A2 
          BX1    X2                SAVE FIRST ENTRY 
          LX2    59 
          PL     X2,CHKPURYA  IF DECK NOT TO BE PURDECKED 
          SB4    B1 
CHKPURYA  LX2    59-4 
          PL     X2,CHKPURYB  IF DECK NOT TO BE YANKDECKED
          SB3    B1 
          LX2    4
          PL     X2,CHKPURYB  IF NOT INITIAL YANKING OF THIS DECK 
          SB3    -B1
CHKPURYB  SA6    A2 
          RJ     CHKDCKS           LOOK FOR SECOND ENTRY
          NZ     X0,CHKPURYE  IF NO SECOND ENTRY
          SA4    CARDSTAT 
          ZR     X4,CHKPURYU       DECK IS BEING INSERTED 
          LX2    59 
          PL     X2,CHKPURYC  IF DECK NOT TO BE PURDECKED 
          SB4    B1 
CHKPURYC  LX2    59-4 
          PL     X2,CHKPURYE  ID DECK NOT TO BE YANKDECKED
          NZ     B3,CHKPURYD  IF YANKFLAG STATUS NOT PREVIOUSLY SET 
          SB3    B1 
CHKPURYD  LX2    4
          PL     X2,CHKPURYE  IF NOT INITIAL YANKING OF THIS DECK 
          SB3    -B1
CHKPURYE  ZR     B3,CHKPURYF  IF NOT YANKDECKED 
          SA6    YANKFLAG 
          GT     B3,B0,CHKPURYF  IF NOT INITIAL YANKING OF THIS DECK
          SX6    2
CHKPURYF  SA6    IYANKDK
          ZR     B4,CHKPURYU  IF NOT PURDECKED
          SA7    PURGFLAG 
CHKPURYU  BX6    X1 
          SA6    B7                RESTORE CLEARED ENTRY
CHKPURYZ  SA2    SEQFLAG
          ZR     X2,CHKPURY0       NO SEQUENCING
          SX1    20B
          BX7    X7+X1
          SB3    X2 
          RJ     TLUDIR 
          MX7    0
          ZR     X2,CHKPURY3       NOT AN IDENT.
          LX2    56 
          PL     X2,CHKPURY3       NOT SEQUENCED. 
          SA6    SEQFLAG
          LX2    4                 REMOVE PURGE BIT 
          BX7    -X1*X2 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA7    A2 
S2LCM     ELSE
          WX7    X3                STORE DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          SX7    B1 
CHKPURY3  SA2    TSEQFLG
          SA7    A2 
          ZR     X2,CHKPURY0       PREVIOUS DECK NOT SEQUENCED. 
          SA2    F.DIRECT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X2+B3
          BX7    X2+X1             RESET PURGE BIT
          SA7    A2 
S2LCM     ELSE
          SX7    X2+B3             COMPUTE LCM ADDRESS. 
          RX2    X7                FETCH DIRECTORY ENTRY. 
          BX2    X2+X1             RESET PURGE BIT
          WX2    X7                AND WRITE IT TO THE DIRECTORY. 
S2LCM     ENDIF 
          SPACE  1
CHKPURY0  SA1    LCHBTAB
          ZR     X1,ECOR1          EXIT IF FIRST TIME THROUGH 
          MESSAGE WRCMS,1          DISPLAY UPDATING XXX MESSAGE 
          SA1    DPRINT 
          ZR     X1,ECOR10B 
          SA1    LISTHREE 
          ZR     X1,ECOR10B 
          PRINT  =8L0,1 
          MX6    0
          SA6    DPRINT 
          EQ     ECOR10B
          EJECT  4                                                      01255600
**        CHYANKS COMBINES YANK$$$ DECKS OF MERGED PLS                  01255601
*                                                                       01255602
*         WHEN TWO PLS ARE MERGED, THE FIRST STEP IS TO                 01255603
*         CREATE ONE RANDOM OLDPL CALLED UPDTTPL.  SINCE                01255604
*         THE FIRST PL IS READ COMPLETELY BEFORE THE SECOND             01255605
*         PL IS REFERENCED, UPDTTPL ENDS UP WITH 2 YANK***              01255606
*         DECKS, ONE OF WHICH IS REFERENCED BY THE DECK                 01255607
*         NAME (...   ...).  WHEN NORMAL PROCESSING BEGINS              01255608
*         USING UPDATTPL AS THE OLDPL, THESE TWO DECKS                  01255609
*         MUST BE COMBINED INTO ONE.  CHYANKS IS CALLED                 01255610
*         TO FIND THE DECK NAMES (...   ...) IN THE DECK                01255611
*         LIST AND READ IT UP IMMEDIATELY FOLLOWING THE                 01255612
*         FIRST YANK$$$ DECK.  THE MERGE FLAG IS CLEARED                01255613
*         AT THIS TIME.                                                 01255614
*                                                                       01255615
*         CALLS  MOVEIT, CPCLEAR                                        01255616
                                                                        01255617
C         IF     DEF,EDITKEY
CHYANKS   SA1    =10H...   ...A 
          SA2    F.DECKS           WE HAVE FINISHED PROCESSING THE FIRST
          SA4    L.DECKS           YANK DECK OF THE MERGE, NOW PROCESS
          SB2    B1+B1             THE SECOND. THIS ROUTINE FINDS THE 
          SA5    X2                SECOND YANK DECK, WHICH IS IDENTIFIED
CHYANKS1  SA5    A5+B2             BY ...   ... AND PLACE THE RANDOM
          BX0    X5-X1             ADDRESS IN THE OLDPL FET. THEN SQUEEZ
          NZ     X0,CHYANKS1       THE ENTRY OUT, REDUCE WORKLGTH, AND
          SX7    X4-2              SET -MERGE- TO ZERO SO THAT WE WON-T 
          SX3    A5                COME HERE AGAIN
          SA5    A5+B1
          SA1    WORKLGTH 
          SA7    A4 
          BX6    X5 
          SA6    OLDPL+6
          IX2    X3-X2
          SX6    X1-2 
          IX1    X7-X2
          SA6    A1 
          MOVE   X1,X3+2,X3 
          CLEAR  OLDPL,READ 
          MX6    0
          SA6    MERGE
          EQ     ECORROPL 
C         ENDIF 
          SPACE  4,8
**        CKM - CHECK MODIFICATION TO CARD
* 
*         CKM HAS TWO PURPOSES.  FIRST, IF AN OVERLAPPING 
*         CORRECTION HAS OCCURED, CKM DETERMINES THE
*         TYPE OF OVERLAP AND FLAGS THIS CARD WITH THE
*         APPROPRIATE MESSAGE.  SECOND, CKM DETERMINES
*         THE ACTIVITY STATUS (D,A,I) OF THIS CARD AND
*         ADDS THE APPROPRIATE ACTIVITY FLAG.  CKM THEN 
*         CALLS PRINT TO PRINT THE CARD IMAGE AND ITS 
*         APPENDED FLAGS.  FINALLY, CKM CLEARS THE CELLS
*         WHERE THE FLAGS WERE STORED FOR THE PRINT 
*         ROUTINE.
* 
*         CALLS  PRINT
* 
CKM       PS                 ENTRY/EXIT 
          SA1    OVLFLG 
          ZR     X1,CKM1     IF NO OVERLAPPING CORRECTIONS
          MX6    0
          SA6    A1          CLEAR OVERLAP FLAG 
  
F         IF     DEF,EXTOVLP
          SA2    OVMFLG 
          SX7    X2+B1
          SA7    A2 
F         ENDIF 
  
CKM1      SA3    LISTHREE 
          ZR     X3,CKM      IF L=3 NOT SPECIFIED, RETURN 
F         IF     DEF,EXTOVLP
          ZR     X1,CKM1A    IF NO OVERLAPPING CORRECTIONS
          SA2    =10HTP. 0 OVLP 
          LX1    30          PUT OVLP INDICATOR IN PRINT LINE (OPTION 3)
          IX6    X1+X2
          SA6    CARD4
CKM1A     BSS    0
F         ENDIF 
          RJ     ADDID
          SA3    CARDSTAT 
          SA4    CURSTAT
          SA1    =10H     D 
          PL     X3,CKM2     IF CARD WAS DELETED
          LX4    1
          SA1    =10H A 
          AX4    1
          NZ     X4,CKM2     IF CARD WAS RESTORED 
          SA1    =10H   I          ELSE, CARD WAS INSERTED
CKM2      BX6    X1 
          SA6    CARD3
          PRNTCARD
          SA1    =1H
          BX6    X1 
          SA6    CARD3
          SA6    CARD4
          EQ     CKM         RETURN 
          EJECT  4                                                      01255619
**        CLASSIFY CLASSIFY CARD TYPE                                   01255620
*                                                                       01255621
*         ON ENTRY, THE SQUEEZED IMAGE OF THE CURRENT                   01255622
*         CARD MUST BE IN SQIMAGE, THE NUMBER OF WORDS                  01255623
*         IN SQIMAGE WHICH IT OCCUPIES MUST BE IN SQLGN,                01255624
*         FLGCHAR MUST CONTAIN THE CONTROL CHARACTER TO                 01255625
*         BE SEARCHED FOR (BITS 0-5).  THE IMAGE IN SQIMAGE             01255626
*         IS CHECKED TO DETERMINE WHETHER OR NOT IT IS                  01255627
*         A CONTROL CARD, AND THE FLAG WORD CURCARD IS                  01255628
*         SET ACCORDING TO THE TYPE OF CARD FOUND.  THE                 01255629
*         FIRST TEST USED IS WHETHER OR NOT THE CHARACTER               01255630
*         IN COLUMN 1 MATCHES THE CONTROL CHARACTER IN                  01255631
*         FLGCHAR.  IF THIS TEST IS PASSED, THE CARD IMAGE              01255632
*         IS CHECKED TO DETERMINE WHETHER OR NOT THE CONTROL            01255633
*         CHARACTER IS IMMEDIATELY FOLLOWED BY A NAME AND               01255634
*         A DELIMITER (ANY CHARACTER WITH DISPLAY CODE                  01255635
*         VALUE OF 55 OR MORE).  IF THIS SECOND CONDITION               01255636
*         IS TRUE, THE CARD MAY BE A CONTROL CARD.  IF                  01255637
*         RXTFLAG IS NON-ZERO, A TEXT CARD IS IN EFFECT                 01255638
*         AND THE ONLY CARD WHICH WILL BE RECOGNIZED AS                 01255639
*         A CONTROL CARD IS AN ENDTEXT CARD.  THE LIST                  01255640
*         OF PARAMETER WORDS IN PARMLIST IS SEARCHED STARTING           01255641
*         AT THE ADDRESS IN A1 FOR THE LENGTH SPECIFIED                 01255642
*         BY B4.  ON ENTRY TO CLASSIFY, B4 SHOULD CONTAIN               01255643
*         A NUMBER INDICATING HOW DEEP THE PARAMETER LIST               01255644
*         IS TO BE SEARCHED.  IF A MATCH IS FOUND, THE                  01255645
*         APPROPRIATE BIT IN CURCARD, IS SET ON TO INDICATE             01255646
*         THE TYPE.  IF NO MATCH IF FOUND, THE SECOND                   01255647
*         CHARACTER IS CHECKED AGAINST CONCHAR TO DETERMINE             01255648
*         WHETHER OR NOT THE CARD IS A COMMENT CARD.  IF                01255649
*         THE CARD IS NOT A CONTROL CARD, CURCARD IS SET                01255650
*         TO ZERO.                                                      01255651
*                                                                       01255652
*         ENTRY  B4 - LENGTH OF LIST TO BE SEARCHED                     01255653
*                                                                       01255654
*         CALLS  GETCH, SCITEML                                         01255655
          SPACE  1
 CLASSIFX MX6    0
          SA6    CURCARD           CLEAR CURCARD AND X6 
CLASSIFY
          SA1    SQLGN
          ZR     X1,CLASSIFX       NO 6-BIT CARD IMAGE
          SA1    SQIMAGE           FIRST WORD 
          SA3    FLGCHAR           CONTROL CHARACTER
          MX0    6
          LX3    54 
          BX6    X0*X1
          IX6    X6-X3
          NZ     X6,CLASSIFX       NOT CONTROL CHARACTER COLUMN 1 
          SB7    6
          PX7    X6,B7             PRESET FOR COLUMN 2
          SA7    COLUMN 
          RJ     GETCH
          ZR     X7,CLASSIFX       DELIMITER IN COLUMN 2
          RJ     SCITEML           GET POSSIBLE CONTROL WORD
          SB2    6
          SA1    CHAR 
          SB7    X1-1R
          NG     B7,CLASSIFX       CHAR FOLLOWING IS NOT DELIMITER
          SA1    PARMLIST 
          SA2    TXTFLAG
          SX6    B1 
          ZR     X2,PARMLOOP
          SA1    ENDOTEXT 
          SB4    B1+B1                                                  0081  45
PARMLOOP  SB4    B4-B1             SEARCH PARAMETER LIST
          BX5    X1-X7             FOR MATCH
          SA1    A1+B1
          AX0    X5,B2             SHIFT OFF SHIFT COUNT
          ZR     X0,FOUNDPAR       FOUND AN UPDATE PARAMETER
          ZR     B4,CHECKCOM
          EQ     PARMLOOP 
          SPACE  1
FOUNDPAR  SB3    X5 
          LX6    X6,B3             FORM CODE IN CURCARD 
          SA6    CURCARD
          MX7    0
          SA7    CARD8             CONTROL CARDS ARE FORCED TO 6-BIT
          SA7    SQLGN8 
SKIPTOML  RJ     GETCH             SKIP PAST BLANKS AND/OR OTHER
          SB7    X6-1R             DELIMITERS TO PARAMETER
          ZR     X7,CLASSIFY       END OF CARD
          ZR     B7,SKIPTOML
          EQ     CLASSIFY 
          SPACE  1
CHECKCOM  SA1    TXTFLAG
          NZ     X1,CLASSIFX
          SA1    COMCHAR
          LX1    54 
          BX6    X1-X7
          NZ     X6,CLASSIFX
          SX5    SLASH
          SX6    B1 
          EQ     FOUNDPAR 
          SPACE  4                                                      01255657
**        COMPLETE  INSURE ALL FILES COMPLETE                           01255658
*                                                                       01255659
*         COMPLETE IS CALLED AT THE END OF UPDATE TO INSURE             01255660
*         THAT NONE OF UPDATE FILES HAS AN OPERATION                    01255661
*         OUTSTANDING.                                                  01255662
*                                                                       01255663
*         CALLS  WAIT                                                   01255664
                                                                        01255665
COMPLETE  BSS    1                 COMPLETE INSURES THAT ALL FILE 
  
          ENV    ACT,(2,3),VER2 
          CLOSE  OUTPUT 
          CLOSE  INPUT
          CLOSE  SOURCE 
          CLOSE  OLDPL
          CLOSE  NEWPL
          CLOSE  COMP 
          UNLOAD UPDTSCR
          UNLOAD UPDTCDK
          CLOSE  READFIL
          UNLOAD UPDTEXT
          UNLOAD AUDITFL
          SA1    TEMPIN76 
          ZR     X1,COMPLET5
          FETCH  TEMPIN76,OC,X3 
          SX3    X3-#OPEN#
          NZ     X3,COMPLET5
          CLOSEM TEMPIN76,U 
 COMPLET5 BSS 
W         IF     DEF,DYNAMFL
          SA1    CORESIZE 
          SA2    ORIGSIZE 
          BX0    X1-X2
          LX2    30 
          ZR     X0,COMPLET1
          BX6    X2 
          SA6    A2 
          MEMORY  SCM,ORIGSIZE
W         ENDIF 
COMPLET1  SA1    FLL
          MX0    30 
          BX6    X0*X1
          SA6    A1 
          MEMORY LCM,FLL           REDUCE LCM TO ORIGINAL 
VER2      ELSE
          SB2    NFILES            ACTIVITY HAS BEEN COMPLETED
          SB3    LFET 
          SA2    FILES
 COMPLET1 ZR     X2,COMPLET2
          RECALL A2 
 COMPLET2 SB2    B2-B1
          SA2    A2+B3
          NZ     B2,COMPLET1
VER2      ENDIF 
  
          EQ     COMPLETE 
          EJECT  4                                                      01255667
**        CONDEC CONVERT TO DECIMAL                                     01255668
*                                                                       01255669
*         CONDEC ACCEPTS A BINARY INTEGER IN X1 AND PRO-                01255670
*         DUCES A DISPLAY CODE NUMBER WITH LEADING BLANKS               01255671
*         IN X6.  ON EXIT, B2 CONTAINS THE NUMBER OF BITS               01255672
*         OCCUPIED BY THE NUMBER.                                       01255673
*                                                                       01255674
*         ENTRY  X1 - INTEGER TO BE CONVERTED                           01255675
*                                                                       01255676
*         EXIT   X6 - DECIMAL FORM WITH LEADING BLANKS                  01255677
*                B2 - NUMBER OF BITS OCCUPIED BY NUMBER                 01255678
*                                                                       01255679
*         REGISTER NOT USED - B3                                        01255680
                                                                        01255681
CONDEC1   DX4    X1*X2
          FX1    X1*X2
          SB4    X1 
          LX6    54 
          SB2    B2+B6
          FX5    X4*X3
          SX0    X5+B5
          IX6    X0+X6
          NZ     B4,CONDEC1 
          LX6    54 
          LX6    X6,B2
CONDEC    PS
          SA2    =0.1000000001P48 
          SA3    =10.P
          SA4    =1H
          SB6    6
          SB5    -22B 
          SB2    B0 
          PX1    X1 
          BX6    X4 
          EQ     CONDEC1
          EJECT  4                                                      01255683
X         IF     DEF,CHAR64 
          SPACE 1 
**        CONVLINE  SUPPORT FOR 64 CHAR SET                             01255685
*                                                                       01255686
*         WHEN THE KEY CHAR64 IS DEFINED, UPDATE WILL RE-               01255687
*         COGNIZE ON INPUT AND PRODUCE ON ALL OUTPUT THE                01255688
*         00B (COLON) CHARACTER.  SINCE UPDATE CAN READ                 01255689
*         OLDPLS WHICH DO NOT CONTAIN OR SUPPORT THIS CHAR-             01255690
*         ACTER, THE SUBROUTINE CONULINE IS PROVIDED TO                 01255691
*         MAKE THE NECESSARY MODIFICATIONS TO CARD IMAGES               01255692
*         READ FROM THE OLDPL.  ON PLS WHICH DO NOT SUPPORT             01255693
*         33B, THE SQUEEZED REPRESENTATION FOR 2 CONTIGUOUS             01255694
*         BLANKS IS 0001B.  SINCE THIS COMBINATION REPRESENTS           01255695
*         THE 00B CHARACTER ON NEW PLS, ALL SUCH ENTRIES                01255696
*         MUST BE ALTERED TO THEIR ORIGINAL FROM (5555B).               01255697
                                                                        01255698
CONVLINE  PS
          SB4    10 
          SA1    SQLGN
          ZR     X1,CONVLINE
          SB7    X1 
          SB6    B0 
          MX0    54 
          SX3    B1 
CONVLN1   ZR     B6,CONVLN2        GET NEW WORD IF NECESSARY
          LX1    6                 SHIFT TO NEXT CHARACTER
          SB6    B6-B1             DECREMENT CHARACTER COUNT
          BX2    -X0*X1            ISOLATE CHARACTER
          NZ     X2,CONVLN1        CONTINUE IF NOT ZERO CHARACTER 
          RJ     GETNEXC           GET CHARACTER COUNT
          ZR     X2,CONVLN3        END OF CARD
          NZ     X4,CONVLN1        NOT 0001B (DOUBLE BLANK) 
          SB5    B4-B1
          EQ     B5,B6,CONVLN4     FIRST PART OF BYTE IS IN LAST WORD 
          SA4    A1                FETCH WORD 
          SX7    B6 
          LX6    X7,B1             CREATE SHIFT COUNT FOR BLANKS
          LX7    X6,B1
          IX7    X6+X7
          SX6    2R 
          SB5    X7 
          LX6    X6,B5             SHIFT TO APPROPRIATE POSITION
          BX6    X6+X4             ADD BLANKS TO WORD 
          SA6    A4                STORE EDITED WORD
          EQ     CONVLN1           LOOP FOR NEXT CHARACTER
          SPACE  1
CONVLN4   SA4    A1-B1             FETCH PREVIOUS WORD
          SX7    1R 
          BX6    X7+X4             ADD IN ONE BLANK 
          SA6    A4                STORE EDITED WORD
          SA4    A1 
          LX7    54                MOVE BALNK TO TOP OF WORD
          BX6    X7+X4             ADD IN SECOND BALNK
          SA6    A4                STORE WORD 
          EQ     CONVLN1
          SPACE  1
CONVLN2   SB7    B7-B1             DECREMENT WORD COUNT 
          NG     B7,CONVLN3        END OF LINE
          SA1    A1+B1             FETCH NEXT WORD
          SB6    B4                RESET COUNTER
          EQ     CONVLN1
          SPACE  1
CONVLN3   MX1    0
          EQ    CONVLINE
X         ENDIF 
          SPACE  4,8
**        CONV63  FOR TOTAL SUPPORT OF 63 AND 64 CHARACTER SET
* 
*         CONV63 IS CALLED TO CONVERT A SQUEEZED LINE DETERMINED
*         BY SQLGN (LENGTH) AND LOCATED IN SQIMAGE
*         63 TO 64 CONVERSION, 63B BECOMES 0001B
*         64 TO 63 CONVERSION, 63B BECOMES 55B AND 0001B BECOMES 63B
*         SQLGN IS MODIFIED AS NECESSARY
*         THE CONVERTED LINE IS PLACED INTO A SCRATCH AREA (SRALINE)
*         AND MOVED BACK AT THE END INTO SQIMAGE
* 
*         CALLS  GETNEXC,PUTNEXC,MOVEIT 
  
  
CONV63    PS
          SB4    10          WORD LENGTH
          SA1    SQLGN       LINE LENGTH
          ZR     X1,CONV63
          SB7    X1 
          SB6    B0          CHARACTER COUNT
          MX0    54          CHARACTER MASK 
          SA1    SQIMAGE-1
          SB5    B4          CHARACTER COUNT
          MX7    1
          SA2    SRALINE-1
          BX6    X2 
          SA6    A2 
          MX6    0
          SX5    B1 
          SX3    63B
  
CONV63A   RJ     GETNEXC
          NG     B7,CONV63Z  EXIT, NO MORE TO CONVERT 
  
CA        IFNE   IP.CSET,IP.C63 
          NZ     X4,CONV63C  NOT A 63B, STORE IT
          ZR     X7,CONV63C  IF PREVIOUS CHAR IS ZERO DO NOT CONVERT
          MX2    0           63B TO 0001B 
          RJ     PUTNEXC
          SX2    B1 
CA        ELSE
          NZ     X4,CONV63B 
          SX2    55B         63B TO 55B 
CA        ENDIF 
  
CONV63C   RJ     PUTNEXC
  
          IFNE   IP.CSET,IP.C63,1 
          BX7    X2 
  
          EQ     CONV63A
  
CB        IFEQ   IP.CSET,IP.C63 
CONV63B   NZ     X2,CONV63C 
  
*         PERHAPS IT IS A COLON 
  
          RJ     GETNEXC
          NG     B7,CONV63Z  END OF LINE
          IX4    X2-X5       TEST FOR ONE 
          ZR     X4,CONV63D  CONVERT 0001B TO 63B 
          BX7    X2 
          SX2    B0 
          RJ     PUTNEXC
          BX2    X7 
          EQ     CONV63C
CONV63D   SX2    X3 
          EQ     CONV63C
CB        ENDIF 
  
 CONV63Z  ZR     B5,CONV63L        TEST FOR PARTIAL WORD
CONV63X   LX6    6
          SB5    B5-B1
          NZ     B5,CONV63X 
 CONV63L  SA6    A6+B1
          SX7    A6+1-SRALINE 
          SA7    SQLGN       STORE NEW LINE LENGTH
          MOVE   X7,SRALINE,SQIMAGE  MOVE LINE INTO PLACE 
          EQ     CONV63      EXIT 
          SPACE  4                                                      01255700
          SPACE  4,8
**        CHGHDER  CHANGE OLDPL HEADER
* 
*         CHGHDER IS CALLED WHEN THE H PARAMETER IS SPECIFIED ON THE
*         UPDATE CONTROL CARD 
*         CHGHDER CHANGES THE OLDPL HEADER SO THAT IT CORRECTLY STATES
*         THE CHARACTER SET OF THE OLDPL
* 
*         ENTRY  X2 - CONTAINS THE THIRD WORD OF THE INDEX IF THE OLDPL 
*                     IS RANDOM OR CONTAINS THE FIRST WORD OF THE INDEX 
*                     IF THE OLDPL IS SEQUENTIAL
*                X5 - CONTAINS (HEADER) WHICH IS THE VALUE OF THE 
*                     *H* PARAMETER 
* 
*         EXIT   X2 - CONTAINS THE CORRECTED THIRD WORD OF THE INDEX IF 
*                     THE OLDPL IS RANDOM OR CONTAINS THE CORRECTED FIRST 
*                     WORD OF THE INDEX IF THE OLDPL IS SEQUENTIAL
  
  
CHGHDER   PS
          LX2    59-23
          MX0    6
          BX6    -X0*X2      SEGREGATE CHARACTER SET TYPE 
          BX6    X5+X6       PUT CORRECT CHARACTER SET TYPE INTO HEADER 
          LX6    23-59
          BX2    X6          CORRECTED HEADER 
          EQ     CHGHDER
          SPACE  4,8
**        COPYEND  TERMINATION PROCEDURES AT END OF DECK                01255701
*                                                                       01255702
*         COPYEND IS CALLED BY THE COMPILE FILE PROCESSOR               01255703
*         WRCOM EACH TIME IT ENCOUNTERS A DECK OR COMDECK               01255704
*         CARD.  IF THE DECK JUST FINISHED WAS A COMDECK                01255705
*         THE RECORD ON UPDTCDK FOR THAT DECK MUST BE ENDED             01255706
*         AND APPROPRIATE ENTRIES MADE IN COMIND, THE INDEX             01255707
*         TO UPDTCDK.  IF THE LAST DECK WAS A DECK AND WAS              01255708
*         WRITTEN TO UPDTSCR (WRSCRACH NON-ZERO), THE RE-               01255709
*         CORD MUST BE ENDED AND SCRIND UPDATED.  IF UPDATE             01255710
*         IS IN NORMAL MODE (NOT Q OR F), AND THE DECK WAS              01255711
*         ALTERED IN ANY WAY DURING THIS RUN (MODFLG NON-               01255712
*         ZERO), THE NAME OF THE DECK IS ADDED TO DKLIS                 01255713
*         SO THAT IT WILL LATER BE COPIED TO COMPILE.                   01255714
*         IF THE CURRENT DECK CARD HAS BEEN ACTIVATED,                  01255715
*         TMODFLAG WILL BE NON-ZERO.  THE CONTENTS OF                   01255716
*         TMODFLAG ARE PLACED IN MODFLG TO INDICATE THAT                01255717
*         THE NEW DECK HAS BEEN ALTERED.                                01255718
*                                                                       01255719
*         CALLS  ADDWORD, CRDKLIS, CALLIO                               01255720
          SPACE  2
COPYEND   PS
          SA2    COMFLG            COMFLG IS NON-ZERO WHEN THE DECK 
          ZR     X2,COPYEND1       WE ARE WORKING ON IS A COMMON DECK.
          WRITER UPDTCDK,RECALL    END THE RECORD.
          SA1    MODFLG            MODFLG IS NON-ZERO IF THE DECK JUST
          ZR     X1,COPYEND2       ENDED WAS MODIFIED.
          SA1    NOPROP            DO NOT MARK AS MODIFIED IF THE DECK
          ZR     X1,COPYEND2       IS OF THE NON-PROPOGATING VARIETY, 
          SA1    F.COMIND          AS INDICATED BY NOPROP = 0.
          SA2    COMFLG            COMFLG CONTAINS THE INDEX WITHIN 
          IX0    X1+X2             THE TABLE -COMINO-OF THE NAME OF 
          SA1    X0-1              THE CURRENT COMMON DECK. SET BIT 
          SX2    B1+B1             1 ON TO INDICATE THAT THIS COMDECK 
          IX6    X1+X2             HAS BEEN MODIFIED. 
          SA6    A1 
COPYEND2  SA1    COMLOC            ADD THE RANDOM INDEX TO THE
          ADDWRD COMIND,X1         TABLE -COMIND- 
COPYEND3  MX6    0
          SX7    B0                RESET VARIOUS POINTERS AND 
          SA6    WRSCRACH          FLAGS TO ZERO. 
          SA7    COMFLG 
          SA1    TMODFLAG          SET MODFLG AND ZERO
          BX6    X1                TMODFLAG.  THIS IS NECESSARY IF DECK 
          SA7    A1                CARDS ARE MODIFIED.
          SA6    MODFLG 
          EQ     COPYEND
          SPACE  4
COPYEND1  SA1    WRSCRACH          WRSCRACH IS NON-ZERO WHEN WE HAVE
          ZR     X1,COPYEND3       BEEN COPYING A DECK TO THE SCRATCH 
          WRITER UPDTSCR,RECALL    FILE -UPDTSCR-.
          CLEAR  UPDTSCR,WRITE
          SA1    ORDERFLG                                               0014  38
          NZ     X1,COPYEND4                                            0014  39
          SX6    B1                                                     0014  40
          SA6    XFLAG                                                  0014  41
COPYEND4  SA1    SCRLOC            ADD THE RANDOM INDEX TO THE TABLE    0014  42
          ADDWRD SCRIND,X1         -SCRIND- 
          SA1    FASTFLG           FASTFLG IS NON-ZERO IN Q MODE. 
          NZ     X1,COPYEND3
          SA1    MODFLG            IF DECK HAS NOT BEEN MODIFIED
          ZR     X1,COPYEND3       DO NOT PUT DECK NAME IN DKLIS. 
          SA1    WRSCRACH          FORGET ABOUT IT. OTHERWISE 
          RJ     CRDKLIS           ADD IT TO THE END OF THE LIST. 
          EQ     COPYEND3 
          EJECT  4                                                      01255722
**        CPCLEAR  RESETS FILE FET                                      01255723
*                                                                       01257458
*         DELAY ON FILE QUIET, RESET IN AND OUT TO FIRST, REMOVE EOR    01257459
*         BIT FROM FET WORD 1.                                          01257460
*                                                                       01255725
*         ENTRY  X2 - FET FIRST WORD ADDRESS
*                X5 - OPCODE TO PRESET INTO FET 
* 
*         REGISTERS SAVED - A0,A3,A4,X3,X4,B1-B7
*                                                                       01255730
*         CALLS  WAIT                                                   01255731
          SPACE  1
CPCLEAR   PS
          SA1    X2 
          ZR     X1,CPCLEAR        FILE NOT IN USE
  
          ENV    NOT,(2,3),VER2 
          SX1    X1 
          ZR     X1,CPCLEAR1       FILE NOT INITIALIZED 
          RECALL X2 
VER2      ENDIF 
  
 CPCLEAR1 SA1    X2                GET FET WORD 1 
          SA2    A1+B1             FETCH FIRST
          MX0    44                FORM MASK TO PICK UP FILENAME
          SX6    X2 
          LX0    2                 ALSO PRESERVE FET WORD 1 BITS 0-1
          SA6    A2+B1             IN SET TO FIRST
          BX7    X1*X0
          SA6    A6+B1             OUT SET TO FIRST 
          BX7    X7+X5
          SX2    A1+0        RESTORE X2 = FET ADDRESS 
          SA7    A1 
          EQ     CPCLEAR
          SPACE  4
**        CRDKLIS  CREATE ENTRIES IN DKLIS                              01255733
*                                                                       01255734
*         THIS SUBROUTINE IS CALLED TO CREATE AN ENTRY                  01255735
*         IN DKLIS.  BIT 0 OF EACH ENTRY IS SET ON.  A                  01255736
*         SEARCH IS MADE OF EXISTING TABLE ENTRIES.  DU-                01255737
*         PLICATE ENTRIES ARE NOT MADE, BUT IF THE EXISTING             01255738
*         ENTRY IS A FAKE ENTRY (BIT 1 ON), THE NEW ENTRY               01255739
*         IS SUBSTITUTED.                                               01255740
* 
*         ENTRY  (X1) = DECK NAME.
*                                                                       01255741
*         CALLS ADDWORD                                                 01255742
                                                                        01255743
CRDKLIS   BSS    1
          SX0    B1 
          BX1    X0+X1             ADD NOT-YET-WRITTEN BIT
          SA3    L.DKLIS
          ZR     X3,ADDIT 
          SA2    F.DKLIS
          SB7    X3 
          SA2    X2 
DKLOOP    BX6    X1-X2
          SB7    B7-B1
          AX6    6
          SA2    A2+B1
          ZR     X6,GOODFIND       FOUND THIS DECK
          NZ     B7,DKLOOP
 ADDIT    ADDWRD DKLIS,X1          ADD TO END OF DKLIS
          SA2    A6          SET UP A2 IN CASE CALLED FROM WRCOMDK
          MX2    0
          EQ     CRDKLIS
          SPACE  1
GOODFIND  SA2    A2-B1             REFETCH ENTRY
          LX2    58 
          PL     X2,CRDKLIS        ALREADY A GOOD ENTRY FOR THIS
          BX6    X1 
          SA6    A2                REPLACE FAKE ENTRY 
          EQ     CRDKLIS
          SPACE  4                                                      01255745
**        DETTYPE  GENERATE CORRECTION CARDS                            01255746
*                                                                       01255747
*         DETTYPE IS CALLED TO GENERATE CORRECTION CARDS                01255748
*         FROM DICT TABLE ENTRIES.  IT IS CALLED TO PRE-                01255749
*         PARE ENTRIES FOR PRINTING WHICH WERE NOT PRO-                 01255750
*         CESSED (FROM FCOR) AND TO GENERATE CARDS FROM                 01255751
*         ENTRIES IN MODKEY WHICH WERE GENERATED AS THE                 01255752
*         RESULT OF PULLMOD ENTRIES.  ON ENTRY, X1 MUST                 01255753
*         CONTAIN THE FIRST WORD OF THE TABLE ENTRY TO                  01255754
*         BE PROCESSED, A1 ITS ADDRESS.  MANUCARD IS CALLED             01255755
*         TO GENERATE THE IDENT.SEQNUM PORTIONS OF THE                  01255756
*         CARD.                                                         01255757
*                                                                       01255758
*         ENTRY  X1 - FIRST WORD OF TABLE ENTRY TO BE PROCESSED         01255759
*                A1 - ADDRESS OF FIRST WORD                             01255760
*                                                                       01255761
*         CALLS  MANUCARD                                               01255762
                                                                        01255763
DETTYPE   PS
          SA2    =1H
          SB7    B0 
          BX6    X2 
          SA6    CARD-1      IN LIEU OF DNAME FOR MANUFACTURED CARDS
          SA5    =9RINSERT
          LX1    1
          NG     X1,DETTYPE1
          LX1    1
          SA5    =9RBEFORE
          NG     X1,DETTYPE1
          LX1    1
          SB7    B1 
          SA5    =9RRESTORE 
          NG     X1,DETTYPE1
          LX1    1
          SA5    =9RDELETE
          NG     X1,DETTYPE1
          SB7    -B1
          SA5    =9RADDFILE 
DETTYPE1  SA1    A1 
          RJ     MANUCARD 
          EQ     DETTYPE
          EJECT  4                                                      01255765
**        DUMDIR  DUMP LISTS                                            01255766
*                                                                       01255767
*         DUMDIR IS CALLED TO PRINT OUT THE DIRECTORY,                  01255768
*         THE NEWDKS LIST, AND THE DECKS LIST.  DECKS                   01255769
*         IS PRINTED ONLY IF THE UPDATE IS Q MODE OR IF                 01255770
*         ERRORS WERE FOUND.                                            01255771
*                                                                       01255772
*         CALLS  DUMLIST, PRINT, DUML, MOVEIT                           01255773
                                                                        01255774
DUMDIR    PS
          SA1    LISTA
          ZR     X1,DUMDIR
          MOVE   3,DIRCOM1,TITLE+3
          SA1    LPCNT
          SA2    L.DIRECT 
          SX1    X1+7 
          AX2    3
          RJ     DUMLTST
          IX1    X1+X2
          SA2    JPS
          IX0    X1-X2
          NG     X0,DUMDIRX1
          SX6    EJECT
          SA6    A1 
          EQ     DUMDIRX2 
          SPACE  1
DUMDIRX1  PRINT  =8L0,1 
DUMDIRX2  BSS    0
          PRINT  (0               CORRECTION IDENTS ARE LISTED IN CHRONO
,LOGICAL ORDER OF INSERTION)
          PRINT  =8L,1
          SA1    F.DIRECT 
          SA2    L.DIRECT 
          SPACE  1
          ENV    ACT,(2,3),S2LCM
          MX6    1                 SET LCM TABLE FLAG 
          BX1    X1+X6
S2LCM     ENDIF 
          SPACE  1
          SX6    B1                THIS IS THE INCREMENT FOR DUML 
          RJ     DUML              LIST OUT DIRECTORY 
          MOVE   3,DIRCOM2,TITLE+3
          SA1    ERRORS 
          SA2    FASTFLG
          BX1    X1+X2
          ZR     X1,DUMDIRY3
          SA1    LPCNT
          SA2    L.DECKS
          SX1    X1+7 
          ZR     X2,DUMDIRY3
          AX2    4
          RJ     DUMLTST
          IX1    X1+X2
          SA2    JPS
          IX0    X1-X2
          NG     X0,DUMDIRY1
          SX6    EJECT
          SA6    A1 
          EQ     DUMDIRY2 
          SPACE  1
DUMDIRY1  PRINT  =8L0,1 
DUMDIRY2  BSS    0                                                      0697  10
          PRINT  (0          DECK LIST AS READ FROM OLDPL PLUS ADDED NEW0697  11
, DECKS)                                                                0697  12
          PRINT  =8L,1                                                  0697  13
          SA1    F.DECKS
          SA2    L.DECKS
          SX6    B1+B1
          RJ     DUML 
DUMDIRY3  MOVE   3,DIRCOM3,TITLE+3
          SA1    LPCNT
          SA2    L.NEWDKS 
          SX1    X1+7 
          AX2    4
          RJ     DUMLTST
          IX1    X1+X2
          SA2    JPS
          IX0    X1-X2
          NG     X0,DUMDIRX3
          SX6    EJECT
          SA6    A1 
          EQ     DUMDIRX4 
          SPACE  1
DUMDIRX3  PRINT  =8L0,1 
DUMDIRX4  BSS    0
          SA5    L.NEWDKS          IF NEWPL DECK LIST IS EMPTY, 
          SX5    X5-1 
          ZR     X5,DUMDIRZ1
          PRINT  (0DECKS ARE LISTED IN THE ORDER OF THEIR OCCURRENCE ON 
,A NEW PROGRAM LIBRARY IF ONE IS CREATED BY THIS UPDATE)
          PRINT  =8L,1
          SA1    F.NEWDKS 
          SA2    L.NEWDKS 
          SX6    B1+B1
          RJ     DUML 
          SPACE  1
DUMDIRZ1  SA1    RANDNPL
          PL     X1,DUMDIR         IF NEWPL IS RANDOM OR NONEXISTENT. 
          SA1    LPCNT             FETCH PAGE LINE COUNT. 
          SA2    L.DECKS           FETCH LENGTH OF DECKS. 
          SX1    X1+7              ADJUST PAGE LINE COUNT.
          ZR     X2,DUMDIR         JUMP OUT IF NO DECKS.
          AX2    4                 DIVIDE BY 16. (TWO WORD ENTRIES) 
          RJ     DUMLTST
          IX1    X1+X2             COMPUTE LPCNT AFTER PRINT. 
          SA2    JPS
          IX0    X1-X2
          NG     X0,DUMDIRZ2                                 THEN JUMP. 
          SX6    EJECT
          SA6    A1 
          EQ     DUMDIRZ3 
          SPACE  1
DUMDIRZ2  PRINT  =8L0,1 
DUMDIRZ3  PRINT  (0   DECK LIST AS WRITTEN TO SEQUENTIAL NEWPL) 
          PRINT  =8L,1
          SA1    F.DECKS           FETCH ORIGIN OF DECK LIST. 
          SA2    L.DECKS           FETCH LENGTH OF DECK LIST. 
          SX6    B1+B1             SET X6 EQUAL TO 2. 
          RJ     DUML              PRINT TABLE. 
          EQ     DUMDIR 
          EJECT  4                                                      01255776
**        DUML   FORMATS AND PRINTS TABLES                              01255778
*                                                                       01255779
*         THE OUTPUT IS FORMATTED IN CARD AND CONSISTS OF               01255780
*         THE FIRST WORD OF EACH TABLE ENTRY, WITH BITS                 01255781
*         0-5 MASKED AND BLANKS FILLED TO THE RIGHT.  THE               01255782
*         NUMBER OF ENTRIES PER LINE IS DETERMINED BY THE               01255783
*         ASSEMBLY PARAMETER ENTLINE.  THE NUMBER OF                    01255784
*         ENTRIES IN THE TABLE WITH BIT 4 ON IS COUNTED                 01255785
*         AND THESE ENTRIES AS WELL AS ENTRIES WITH BIT                 01255786
*         0 SET ON ARE NOT PRINTED                                      01255787
*                                                                       01255788
*         ENTRY  X1 - TABLE ORIGIN                                      01255789
*                    (FOR SCOPE 2, BIT 59 SET IF TABLE IN LCM)
*                X2 - TABLE LENGTH                                      01255790
*                X6 - NUMBER OF WORDS PER TABLE ENTRY                   01255791
*                                                                       01255792
*         CALLS  PRINT, CONDEC                                          01255793
  
 DUML3    SX7    B7 
          SB7    B6+ENTLINE 
          ZR     B7,DUML31
          SA7    PURGCNT           STORE PURGED IDENT COUNT 
          PRINT  CARD,B6+ENTLINE+1
DUML31    BSS    0
          MX6    0
          SA6    CARD 
          SA1    PURGCNT
          ZR     X1,DUML     JUMP IF NO PURGED IDENTS FOUND 
          RJ     CONDEC      CONVERT NUM TO DECIMAL DISPLAY 
          SA6    PRCNTLN+1
          PRINT  PRCNTLN,5
DUML      PS
          SA6    DUMLTEMP          STORE INCREMENT
          SX7    B0 
          SA7    PURGCNT      ZERO OUT COUNT OF PURGED IDENTS 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SX6    X1 
S2LCM     ELSE
          BX6    X1 
S2LCM     ENDIF 
          SPACE  1
          BX7    X2 
          SA6    A6+B1             STORE TABLE PARAMETERS 
          SA7    A6+B1
          ZR     X2,DUML
DUML1     SA2    =1H
          BX6    X2 
          LX7    X2 
          SA6    CARD 
          SB6    10 
DUMLOOP   SA7    A6+B1
          SA6    A7+B1
          SB6    B6-2 
          NZ     B6,DUMLOOP 
          SB6    -ENTLINE 
          MX0    54 
          SA3    DUMLTEMP          FETCH INCREMENT
          SB5    X3 
          SA1    A3+B1             FETCH TABLE ORIGIN 
          SA2    A1+B1             AND LENGTH 
          SB3    -B5               SET DECREMENT
          SA5    PURGCNT
          SB7    X5                B7 HOLDS COUNT OF PURGED IDENTS
          SB4    X2 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
 DUML2    SA5    X1                IDENT FROM TABLE 
          SX1    X1+B5             INCREMENT ORIGIN 
S2LCM     ELSE
DUML2     PL     X1,DUML2A         JUMP IF SCM TABLE
          ZR     B4,DUML3          DO NOT READ PAST END OF TABLE
          RX5    X1                IDENT FROM TABLE 
          SX6    B5 
          IX1    X1+X6             INCREMENT ORIGIN 
          JP     DUML2B 
 DUML2A   SA5    X1                IDENT FROM TABLE 
          SX1    X1+B5             INCREMENT ORIGIN 
DUML2B    BSS 
S2LCM     ENDIF 
          SPACE  1
          SB4    B4+B3             DECREMENT LENGTH 
          BX6    X0*X5             MASK OUT MISC BITS 
          NG     B4,DUML3 
          LX5    59 
          MX2    54 
          NG     X5,DUML2          SKIP IF DELETED DECK 
          BX2    X1                SAVE X1
          LX1    X6 
          RJ     SFN= 
          BX1    X2                RESTORE X1 
  
 DUML5    LX5    56 
          PL     X5,DUML4 
          MX0    54 
          SB7    B7+B1
          EQ     DUML2
          SPACE  1
 DUML4    SA6    CARD+ENTLINE+1+B6
          MX0    54 
          SB6    B6+B1
          NG     B6,DUML2          LOOP IF NOT FULL LINE
          SX7    B7 
          SA7    PURGCNT           STORE PURGED COUNT 
          BX6    X1                STORE
          SX7    B4                TABLE
          SA6    DUMLTEMP+1        PARAMETERS 
          SA7    A6+B1
          PRINT  CARD,ENTLINE+1 
          EQ     DUML1             LOOP FOR NEXT
          SPACE  3
* 
*    DUMLTST     TESTS TO INSURE THAT NUMBER OF LINES TO BE 
*                ALLOCATED IS NON-ZERO
* 
DUMLTST   PS
          NZ     X2,DUMLTST 
          SX2    B1 
          EQ     DUMLTST
          EJECT  4                                                      01255795
**        DUMPLIST  DUMPS TABLES TO OLDPL                               01255796
*                                                                       01255797
*         DUMPLIST IS THE SUBROUITNE WHICH WRITES THE                   01255798
*         KEYWORDS AND TABLES AT THE HEAD OF A SEQUENTIAL               01255799
*         NEWPL.  THE FIRST WORD WRITTEN CONTAINS THE KEY               01255800
*         WORD CHECK (IN DISPLAY CODE) IN BITS 30-59, THE               01255801
*         CHARACTER 3 OR 4 IN BITS 12-17 TO REPRESENT THE               0214  67
*         CHARACTER SET IN WHICH THE PL WAS MADE.  THE                  0214  68
*         CHARACTER Y IN BITS 6-11 IF THE NEWPL SUPPORTS                01255802
*         THE 00B CHARACTER, AND THE CONTROL CHARACTER                  01255803
*         WITH WHICH THE NEWPL WAS MADE IN BITS  0-5.  THE              01255804
*         SECOND WORD WRITTEN CONTAINS THE LENGTH OF THE                01255805
*         DIRECTORY WHICH FOLLOWS IN BITS 18-35 AND THE                 01255806
*         LENGTH OF THE DECK LIST WHICH FOLLOWS THE DIREC-              01255807
*         TORY IN BITS 0-17.  DECK LIST ENTRIES WHICH HAVE              01255808
*         BIT 0 ON, ARE NOT WRITTEN OUT.  THE DECK LIST                 01255809
*         IS COMPRESSED FROM 2 WORDS/ENTRY TO 1 WORD/ENTRY              01255810
*         BEFORE IT IS WRITTEN OUT.                                     01255811
*                                                                       01255812
*         CALLS  WBINC, CPCLEAR                                         01255813
                                                                        01255814
DUMPLIST  PS
          SA1    FLGCHAR
          SA2    =5LCHECK 
          SA3    CHARKEY
          NG     X3,DUMPLIS0
          ZR     X3,DUMPLIS3
DUMPLIS0  SX3    1RY
          LX3    6
          BX1    X1+X3
DUMPLIS3  BX6    X1+X2
          SA3    MODENF            NEWPL CHARACTER SET MODE 
          SX3    X3+1R5            CONVERT BACK TO CHARACTER
          LX3    18                                                     0214  75
          BX6    X6+X3             SET CSET CHARACTER                   0214  76
          SX4    B1                                                      CP190
          LX4    24                SET MODIFICATION                      CP190
          BX6    X6+X4             BIT IN HEADER WORD.                   CP190
DUMPLIS4  SA6    A2                                                      CP190
          WRITEWC  NEWPL,A2,B1
          SA3    L.DECKS           SEARCH THE DECK LIST 
          SA2    F.DECKS
          SB3    X3-2              ANY ENTRIES WHICH WILL BE PURGED 
          SB2    -2                FROM THE LIST WHEN IT IS WRITTEN 
DUMPLIS1  ZR     B3,DUMPLIS2       TO THE NEWPL SO THAT THE LENGTH
          SA4    X2+B3             IN THE KEY WORD AGREES WITH THE
          LX4    59                LENGTH OF THE DECK LIST. 
          SB3    B3+B2
          PL     X4,DUMPLIS1
          SX3    X3+B2
          EQ     DUMPLIS1 
          SPACE  1
DUMPLIS2  SA2    L.DIRECT 
          SB6    -B1               SKIP THE FIRST ENTRY 
          SX6    X2+B6             IN BOTH LISTS
          AX3    1
          SX3    X3+B6
          LX6    18 
          IX6    X3+X6             THIS IS THE CONTROL WORD 
          SA6    TCRBIN4
          WRITEWC  NEWPL,A6,B1
          SA4    L.DIRECT 
          SA5    F.DIRECT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          WRITEWC  NEWPL,X5+B1,X4-1 
S2LCM     ELSE
          WBINCL NEWPL,X5+B1,X4-1 
S2LCM     ENDIF 
          SPACE  1
          SA1    F.DECKS
          SA2    L.DECKS
          SB4    B1+B1
          IX4    X1+X2
          SB3    X1+B4
          SB2    X4 
 OUTLOOP  SX0    ALLBUF            BEGINNING OF TEMPORARY STORAGE 
          SB6    ALLSIZE           LENGTH OF USABLE STORAGE 
SHLOOP    SA2    B3                FETCH LIST ENTRY 
          SB3    B3+B4
          BX6    X2                MOVE ENTRY TO STORE REGISTER 
          LT     B2,B3,OUTT 
          LX2    59                FLAG BIT TO TOP
          SB6    B6-B1             DECREMENT STORE INDEX
          NG    X2,SHLOOP 
          SA6    X0                STORE IN TEMP STORAGE
          SX0    X0+B1             INCREMENT STORE ADDRESS
          PL     B6,SHLOOP         LOOP IF MORE ROOM IN TEMP
 OUTT     SX5    B3                SAVE B3 ACROSS WRITE 
          WRITEWC  NEWPL,ALLBUF,X0-ALLBUF 
          SB3    X5 
          SB4    B1+B1
          SPACE  1
          SA1    F.DECKS
          SA2    L.DECKS
          IX4    X1+X2
          SB2    X4                RESTORE B2, DESTROYED BY SC2 WBINC 
          SPACE  1
          GE     B2,B3,OUTLOOP
          EQ     DUMPLIST 
          EJECT 
**        EIGHT BIT ROUTINES
* 
*         FOLLOWING ARE THE SUBROUTINES THAT SUPPORT THE ASCII
*         HANDLING FEATURE IN UPDATE. 
* 
*         CONV6TO8
*         CARD6TO8           CONVERT UNAPCKED DISPLAY CODE TO ASCII 
* 
*         CONV8TO6           CONVERT PACKED ASCII TO PACKED DISPLAY 
* 
*         GET8               FETCH A PACKED ASCII CHARACTER 
* 
*         GET8OF12           FETCH AN UNAPCKED ASCII CHARACTER
* 
*         PUT6               STORE A 6-BIT CHARACTER
* 
*         PUT8               STORE A PACKED 8-BIT CHARACTER 
* 
*         SQUEEZ8            SQUEEZE AN ASCII CARD IMAGE
* 
*         UCARD8             UNPACK AN ASCII CARD IMAGE 
* 
          SPACE  4
**        TABLES
* 
*         TRANSLATION TABLES BETWEEN ASCII AND DISPLAY CODE ARE 
*         ORGANIZED AS ONE CHARACTER PER WORD, RIGHT ADJUSTED,
*         FOR SPEED.
* 
*         TO SAVE SPACE, CASE FOLDING MUST BE PERFORMED IN THE
*         PROGRAM PRIOR TO TRANSLATING FROM ASCII TO DISPLAY CODE.
* 
 SIXTAB   BSS    0           DISPLAY CODE TO ASCII (64 ENTRIES) 
 X        EQU    40B
          CODE   A
          IFNE   IP.CSET,IP.C63 
          CON    X+32B,X+1RA,X+1RB,X+1RC,X+1RD,X+1RE,X+1RF,X+1RG
          ELSE
          CON    X+00B,X+1RA,X+1RB,X+1RC,X+1RD,X+1RE,X+1RF,X+1RG
          ENDIF 
          CON    X+1RH,X+1RI,X+1RJ,X+1RK,X+1RL,X+1RM,X+1RN,X+1RO
          CON    X+1RP,X+1RQ,X+1RR,X+1RS,X+1RT,X+1RU,X+1RV,X+1RW
          CON    X+1RX,X+1RY,X+1RZ,X+1R0,X+1R1,X+1R2,X+1R3,X+1R4
          CON    X+1R5,X+1R6,X+1R7,X+1R8,X+1R9,X+1R+,X+1R-,X+1R*
          CON    X+1R/,X+1R(,X+1R),X+1R$,X+1R=,X+1R ,X+1R,,X+1R.
          IFNE   IP.CSET,IP.C63 
          CON    X+1R#,X+1R[,X+1R],X+1R%,X+02B,X+77B,X+1R!,X+1R&
          ELSE
          CON    X+1R#,X+1R[,X+1R],X+32B,X+02B,X+77B,X+1R!,X+1R&
          ENDIF 
          CON    X+07B,X+37B,X+1R<,X+1R>,X+1R@,X+1R\,X+76B,X+1R;
          CODE   *
* 
 ASCTAB   BSS    0           ASCII TO DISPLAY CODE (63 ENTRIES) 
          IFNE   IP.CSET,IP.C63 
          CON        1R!,1R",1R#,1R$,1R%,1R&,70B
          ELSE
          CON    1R!,1R",1R#,1R$,55B,1R&,70B
          ENDIF 
          CON    1R(,1R),1R*,1R+,1R,,1R-,1R.,1R/
          CON    1R0,1R1,1R2,1R3,1R4,1R5,1R6,1R7
          IFNE   IP.CSET,IP.C63 
          CON    1R8,1R9,00B,1R;,1R<,1R=,1R>,71B
          ELSE
          CON    1R8,1R9,63B,1R;,1R<,1R=,1R>,71B
          ENDIF 
          CON    1R@,1RA,1RB,1RC,1RD,1RE,1RF,1RG
          CON    1RH,1RI,1RJ,1RK,1RL,1RM,1RN,1RO
          CON    1RP,1RQ,1RR,1RS,1RT,1RU,1RV,1RW
          CON    1RX,1RY,1RZ,1R[,1R\,1R],76B,65B
* 
          SPACE  4
**        CONV6TO8           CONVERT FROM DISPLAY CODE TO ASCII 
* 
*                INPUT       A5,X5 = FIRST WORD TO CONVERT
*                            B6    = FIRST STORE ADDRESS
*                            B2    = LWA+1 TO STORE 
* 
*                REGISTERS USED..  A4,A5,A7,X0,X4,X5,X7,B5,B6,B7
* 
          SPACE  2
 CARD6TO8 PS     **                SPECIAL ENTRY FOR CARD TO CARD8
          SA1    CARD8
          NZ     X1,CARD6TO8
          SA5    CARD 
          SB6    CARD8
          SB2    CARD8+CARDSZE8 
          RJ     CONV6TO8 
          EQ     CARD6TO8 
          SPACE  2
 CONV6TO8 PS    **                 GENERAL CONVERSION ROUTINE 
          SB5    B1+B1             2*5 CHARS IN 6-BIT WORDS 
          MX0    60-6              MASK 
 CONV6.1  SB7    5                 5 CHARS PER 8-BIT WORD (8 IN 12) 
          MX7    0                 FIRST OUTPUT WORD
* 
 CONV6.L  LX5    6                 GET NEXT 6-BIT CHARACTER 
          BX4    -X0*X5            ISOLATE IT 
          ZR     X4,CONV6.3        POSSIBLE END-OF-LINE 
 CONV6.2  SA4    X4+SIXTAB         GET 8-BIT TRANSLATION
          LX7    12 
          SB7    B7-B1
          BX5    X0*X5
          BX7    X4+X7             INSERT CHARACTER INTO OUTPUT WORD
          NZ     B7,CONV6.L        LOOP ON OUTPUT WORD
* 
          SA7    B6                STORE OUTPUT WORD
          SB5    B5-B1             WHAT HALF OF INPUT WORD
          SB6    B6+B1             NEXT STORE ADDRESS 
          EQ     B6,B2,CONV6TO8    DONE 
          NZ     B5,CONV6.1        NO INPUT WORD CHANGE YET 
          SA5    A5+B1             GET NEXT INPUT WORD
          SB5    B1+B1             WORD HALF COUNTER
          EQ     CONV6.1           DO ANOTHER OUTPUT WORD 
* 
 CONV6.3  NZ     X5,CONV6.2        COLON
          GT     B7,B1,CONV6.4     NOT CHARACTER 9
          GT     B5,B1,CONV6.4     NOT CHARACTER 9
          SA4    A5+B1             LOOK AHEAD 
          ZR     X4,CONV6.4 
          MX4    0                 COLON IN POSITION 9 OF A WORD
          EQ     CONV6.2
* 
 CONV6.4  LX7    12                FILL OUT OUTPUT WORD TO EOL
          SB7    B7-B1
          NZ     B7,CONV6.4 
          SA7    B6 
          MX7    0
          SA7    A7+B1
          EQ     CONV6TO8 
          SPACE  4
**        CONV8TO6           CONVERT SQUEEZED-8 TO SQUEEZED-6 
* 
*                INPUT       PACKED CARD IN SQIMAGE8
* 
*                OUTPUT      PACKED CARD IN SQIMAGE 
* 
 CONV8TO6 PS     ** 
          SA1    SQLGN
          NZ     X1,CONV8TO6
          SA3    SQLGN8            LENGTH OF PACKED SOURCE
          ZR     X3,CONV8TO6       NULL CARD
          SA5    SQIMAGE8          FIRST WORD OF PACKED CARD
          SB5    60-8              FIRST SHIFT FOR GET8 
          MX0    -8                MASK FOR GET8
          BX6    X6-X6             CLEAR OUTPUT WORD
          SB6    SQIMAGE           FIRST OUTPUT ADDRESS FOR PUT6
          SB7    60-6              FIRST SHIFT FOR PUT6 
          SB4    X3                SOURCE WORD COUNT
          MX1    -7                7-BIT MASK TO TRUNCATE ASCII TO 128 OF 256 
          SB3    -B1               BLANK COUNT (PRESET TO -1) 
* 
 CV8.L    RJ     GET8              LOOP, GET CHARACTER
          GT     B2,CV8.CH         REAL CHARACTER 
          LT     B2,CV8.1          BLANK COUNT OR END OF CARD 
          RJ     GET8              GET CHARACTER FOLLOWING ESCAPE 
          LE     B2,CV8.CHB        SPECIAL CHARACTER, BLANK IT
          SX4    X4-1              BLANK COUNT IS X4
 CV8.1    SB3    B3+B1             BLANK COUNT IS X4+1
          SB3    X4+B3
          NZ     X4,CV8.L          WAS NOT END OF CARD
          SX7    B6+1-SQIMAGE      LENGTH OF RESULTANT CARD 
          SA7    SQLGN             STORE LENGTH 
          SA6    B6                STORE LAST WORD
          MX6    0                 ENSURE ZERO BYTE TERMINATOR
          SA6    A6+B1
          EQ     CONV8TO6          EXIT 
* 
 CV8.CH   BX2    -X1*X4            TRUNCATE 8-BIT TO 7-BIT FOR TRANSLATE
          SB2    X2-40B            LOOK FOR SPECIALS OR BLANK (0-40B) 
          LE     B2,CV8.CHB        YES, CONVERT TO BLANK
          SX2    X2-140B           LOOK FOR LOWER CASE
          NG     X2,CV8.2          NO 
          SB2    B2-40B            YES, CONVERT TO UPPER
          SX2    B2-77B            SPECIAL CHECK FOR (DEL)
          ZR     X2,CV8.CHB        YES, CONVERT TO SPACE
 CV8.2    SA2    B2+ASCTAB-1       TRANSLATE
* 
          NG     B3,CV8.P          NO PRECEEDING BLANKS 
 CV8.3    LE     B3,B1,CV8.B       1 OR 2 HARD BLANKS 
          SB2    B3-100B
          PL     B2,CV8.4          COUNT WILL BE MORE THAN 77B
          MX4    0                 FLAG 
          RJ     PUT6 
          SX4    B3                COUNT-1
          RJ     PUT6 
          EQ     CV8.P             NOW PUT CHARACTER
* 
 CV8.4    MX4    0                 LARGE COUNT
          SB3    B2                NEW COUNT (=OLD COUNT - 64)
            RJ     PUT6 
          SX4    77B               MAXIMUM COUNT
          RJ     PUT6 
          EQ     CV8.3             TRY AGAIN WITH 64 LESS BLANKS
* 
 CV8.B    SX4    1R                HARD BLANKS
          RJ     PUT6 
          SB3    B3-B1
          GE     B3,CV8.B 
* 
 CV8.P    BSS    0
*         ASSEMBLY-TIME CHECK FOR COLON GOES HERE **
          SB3    -B1               RESET BLANK COUNTER
          BX4    X2 
          RJ     PUT6              PUT CHARACTER
          NZ     X2,CV8.L          WAS NOT COLON
          SX4    B1                COLON IS 0001
          RJ     PUT6 
          EQ     CV8.L             CONTINUE LOOP
* 
 CV8.CHB  SB3    B3+B1             IF TRANSLATED CHARACTER IS BLANK 
          EQ     CV8.L              JUST ADD 1 TO BLANK COUNT 
* 
          SPACE  4
**        GET8               GET PACKED 8-BIT CHARACTER 
* 
*                INPUT       X0 = (60-8) BIT MASK (PRESET)
*                            A5,X5 = CURRENT WORD BEING FETCHED FROM
*                            B4 = NUMBER OF WORDS TO GET
*                            B5 = SHIFT COUNT (PRESET TO 60-8)
* 
*                OUTPUT      A5,X5,B4,B5  UPDATED 
*                            X4 = CHARACTER  (ZERO AT END)
*                            B2 = CHARACTER - 37B (ESCAPE)
* 
 GET8.0   SX5    0                 OVERRUN, RETURN ZERO 
          SB5    0
 GET8.1   AX4    X5,B5             GET CHARACTER
          NO
          SB5    B5-8              UPDATE SHIFT COUNT 
 GET8.2   BX4    -X0*X4            ISOLATE CHARACTER
          NO
          SB2    X4-37B            DO COMPARISON
* 
 GET8     PS     ** 
          PL     B5,GET8.1         WHOLE CHARACTER AVAILABLE
          SB4    B4-B1             COUNT DOWN REMAINING WORDS 
          BX4    -X0*X5            SAVE BOTTOM OF CURRENT WORD
          LE     B4,GET8.0         OUT OF DATA, FLAG END-OF-CARD
          SA5    A5+1              GET NEXT WORD
          SB5    B5+60-8           RESET SHIFT COUNT
          BX0    X0*X5             ISOLATE HIGH PART OF NEW WORD
          IX4    X0+X4             MERGE HIGH PART OF NEW WORD WITH OLD LOW 
          LX4    60-8              PRE-SHIFT RIGHT CIRCULAR 
          MX0    -8                RESTORE MASK IN X0 
          AX4    X4,B5             REMAINDER OF SHIFT TO GET CHARACTER
          EQ     GET8.2            FINISH UP
* 
          SPACE  4
**        GET8OF12           FETCH 8-BIT UNSQUEEZED BYTE
* 
*                INPUT       X0 = (60-8)  BIT MASK (PRESET) 
*                            X1 = (60-12) BIT MASK (PRESET) 
*                            A5,X5 = CURRENT WORD BEING WORKED ON 
*                            B4 = NUMBER OF WORDS LEFT TO GET 
*                            B5 = BYTE NUMBER (PRESET TO -1)
* 
*                OUTPUT      A5,X5,B4,B5  UPDATED  X5=0 AT END-OF-LINE
*                            X4 = CHARACTER (MASKED TO 8 BITS)
*                            B2 = CHARACTER - 40B (ASCII BLANK) 
* 
*                NOTE. AT FIRST ENTRY, A5 MUST BE (FWA-1) 
* 
 G812.1   LX5    12                SHIFT TO GET NEXT CHARACTER
          BX4    -X0*X5            ISOLATE CHARACTER
          SB5    B5-B1             DECREMENT BYTE COUNT 
          SB2    X4-40B            COMPARE CHARACTER WITH BLANK 
* 
 GET8OF12 PS     ** 
          BX5    X1*X5             CLEAR LAST CHARACTER 
          GT     B5,G812.1         CONTINUE FROM CURRENT WORD 
          SB4    B4-B1             COUNT DOWN REMAINING WORDS 
          MX5    0
          NG     B4,GET8OF12       OUT OF WORDS, RETURN END OF LINE 
          SA5    A5+B1             GET NEXT WORD
          SB5    5                 RESET BYTE COUNT 
          EQ     G812.1 
* 
          SPACE  4
**        PUT6               BUILD 6-BIT OUTPUT WORDS 
* 
*                INPUT       X4 = CHARACTER TO PUT
*                            X6 = WORD BEING BUILT  (PRESET TO 0) 
*                            B7 = SHIFT REQUIRED    (PRESET TO 54)
*                            B6 = NEXT WORD STORE ADDRESS 
* 
*                OUTPUT      X6,B6,B7  UPDATED
*                            X6 STORED IF FULL AT ENTRY 
* 
 PUT6.1   LX4    B7                SHIFT TO POSITION CHARACTER
          SB7    B7-6              UPDATE SHIFT COUNT 
          BX6    X6+X4             MERGE CHARACTER INTO WORD BEING BUILT
 PUT6     PS     ** 
          PL     B7,PUT6.1         JUMP IF CURRENT WORD NOT YET FULL
          SA6    B6                STORE FULL WORD
          SB7    54                RESET B7 
          SB6    B6+B1             INCREMENT STORE ADDRESS
          MX6    0                 CLEAR FOR NEXT WORD
          EQ     PUT6.1 
* 
          SPACE  4
**        PUT8               STORE PACKED 8-BIT CHARACTERS
* 
*                INPUT       X4 = 8-BIT CHARACTER TO STORE
*                            X6 = WORKING OUTPUT WORD (PRESET TO 0) 
*                            B6 = NEXT STORE ADDRESS
*                            B7 = SHIFT COUNT (PRESET TO 52)
* 
*                OUTPUT      A6,X6,B6,B7  UPDATED 
*                            X2 USED (TEMP) 
*                            X6 STORED IF FULL AT ENTRY 
*                            X4 PRESERVED - LOWER 4 BITS ONLY 
* 
 PUT8.1   LX2    B7,X4             POSITION CHARACTER 
          SB7    B7-8              ADJUST SHIFT COUNT 
          BX6    X2+X6             INSERT CHARACTER INTO OUTPUT WORD
 PUT8     PS     ** 
          PL     B7,PUT8.1         ALL WILL FIT IN CURRENT WORD 
          LX2    B7,X4             PUT 0 OR 4 BITS IN THIS WORD 
          BX6    X2+X6
          AX2    B7                PREPARE TO LOP OFF BITS JUST STUFFED 
          SA6    B6                STORE FULL WORD
          SB7    B7+60             RESET SHIFT COUNT
          BX4    X4-X2             REMAINDER OF X4 GOES INTO NEXT WORD
          MX6    0                 CLEAR X6 FOR NEXT WORD 
          SB6    B6+1              NEXT STORE ADDRESS 
          EQ     PUT8.1 
* 
          SPACE  4
**        SQUEEZ8            SQUEEZE AN ASCII CARD IMAGE
* 
*                INPUT       UNPACKED CARD IN CARD8 
* 
*                OUTPUT      SQUEEZED CARD IN SQIMAGE8
* 
 SQUEEZ8  PS     ** 
          SA1    SQLGN8 
          NZ     X1,SQUEEZ8 
          SA5    CARD8-1           FWA-1 OF SOURCE
          SB4    CARDSZE8          NUMBER OF WORDS OF SOURCE
          SB6    SQIMAGE8          FWA OF DESTINATION 
          MX0    -8                MASK FOR CHARACTER 
          BX6    X6-X6             CLEAR OUTPUT WORD
          SB7    60-8              OUTPUT SHIFT COUNT 
          MX1    -12               MASK FOR EOL DETECTION 
          SB5    -B1               INITIAL BYTE COUNT FOR FETCH 
          SB3    -1                PRESET BLANK COUNT FOR PACKING 
* 
 SQ8.L    RJ     GET8OF12          GET NEXT CHARACTER 
          ZR     X5,SQ8.X          EOL, DONE
          NZ     B2,SQ8.1          NOT BLANK
          SB3    B3+B1             INCREMENT BLANK COUNT
          EQ     SQ8.L              AND LOOP
* 
 SQ8.1    PL     B3,SQ8.B          IF CHARACTER PRECEEDED BY BLANKS 
          NG     B2,SQ8.2          IF CHARACTER NEEDS ESCAPE FIRST
          RJ     PUT8               ORDINARY CHARACTER (QUICK ROUTE)
          EQ     SQ8.L
* 
 SQ8.CH   PL     B2,SQ8.3          NO ESCAPE NEEDED 
 SQ8.2    SX4    37B               ESCAPE 
          RJ     PUT8 
 SQ8.3    SX4    B2+40B            CHARACTER
          RJ     PUT8 
          SB3    -B1               RESET BLANK COUNT
          EQ     SQ8.L
* 
 SQ8.B    NZ     B3,SQ8.4          BLANKS, USE COMPRESSION IF MORE THAN ONE 
          SX4    40B               SINGLE BLANK FOR 1 BLANK 
          RJ     PUT8 
          EQ     SQ8.CH 
* 
 SQ8.4    SX2    B3-37B            CHECK NUMBER OF BLANKS 
          PL     X2,SQ8.5          NEEDS ESCAPE SEQUENCE (40B-) 
          SX4    B3                GOES AS IS (COUNT-1) FOR 2-31 BLANKS 
          RJ     PUT8 
          EQ     SQ8.CH 
* 
 SQ8.5    SX4    37B               ESCAPE 
          RJ     PUT8 
          SX4    B3+B1             COUNT (EXACT) FOR 32-255 BLANKS
          RJ     PUT8 
          EQ     SQ8.CH 
* 
 SQ8.X    SX7    B6+1-SQIMAGE8  DONE, GET LENGTH OF PACKED CARD 
          SA7    SQLGN8            STORE LENGTH OF PACKED CARD
          SA6    B6                STORE LAST WORD OF PACKED CARD 
          EQ     SQUEEZ8            EXIT. 
* 
          SPACE  4
**        UCARD8             UNPACK AN 8-BIT CARD INTO ASCII BUFFER 
* 
*                INPUT       PACKED CARD IN SQIMAGE8
* 
*                OUTPUT      UNPACKED CARD IN CARD8 
* 
 UCARD8   PS     ** 
          SA4    CARD8
          NZ     X4,UCARD8         EXIT QUICKLY IF CARD ALREADY UNPACKED
          SA3    SQLGN8            LENGTH OF PACKED CARD
          SA5    SQIMAGE8          FIRST WORD OF PACKED CARD
          SB5    60-8              FIRST SHIFT FOR GET8 
          MX0    -8                MASK FOR GET8
          BX6    X4                ZERO X6 FOR BUILDING OUTPUT WORDS
          SB6    -CARDSZE8+1       FIRST STORE OFFSET 
          ZR     X5,UC8.NL         IF BLANK LINE
          SB7    60-12             FIRST SHIFT FOR STORE
          SB4    X3                SOURCE WORD COUNT
          SB3    B0                CLEAR STORE-REPEAT COUNT 
          EQ     UC8.L             ENTER LOOP 
* 
 UC8.1    SA6    B6+CARD8+CARDSZE8-1  STORE FULL WORD 
          ZR     B6,UCARD8         DONE 
          SB7    60-12             RESET SHIFT COUNT
          MX6    0                 CLEAR NEXT OUTPUT WORD 
          SB6    B6+B1             NEXT STORE OFFSET
 UC8.S    NG     B7,UC8.1          JUMP IF CURRENT WORD IS FULL 
          LX3    X4,B7             SHIFT TO POSITION CHARACTER
          SB3    B3-B1             DECREASE REPEAT COUNT
          SB7    B7-12             UPDATE SHIFT COUNT 
          BX6    X6+X3             MERGE CHARACTER INTO WORD
          GE     B3,UC8.S          CONTINUE UNTIL REPEAT IS NEGATIVE
* 
 UC8.L    RJ     GET8              GET SOURCE CHARACTER 
          GT     B2,UC8.S          LARGER THAN ESCAPE, STORE IT 
          ZR     X4,UC8.EL         END OF LINE
 UC8.2    LT     B2,UC8.3          STORE (X4+1) BLANKS
          RJ     GET8              WAS ESCAPE, CHECK NEXT 
          LE     B2,UC8.SP         SPECIAL CHARACTER
          SX4    X4-1              STORE (X4+0) BLANKS
 UC8.3    SB3    X4+0              B3 = REPEAT COUNT - 1
          SX4    40B               ASCII BLANK
          EQ     UC8.S             STORE THEM 
* 
 UC8.SP   NZ     X4,UC8.S          NOT (NUL)
          SX4    4000B             MAKE (NUL) NON-ZERO
          EQ     UC8.S
* 
 UC8.NL   BSS    0
          SX6    40B               SET ASCII BLANK
          LX6    59-11             POSITION BLANK 
* 
 UC8.EL   SA6    B6+CARD8+CARDSZE8-1
          MX6    0
          SA6    A6+B1
          EQ     UCARD8 
          SPACE  4
          EJECT  4                                                      01255816
**        FAKEOUT  FAKE ADDFILE ENTRIES                                 01255817
*                                                                       01255818
*         WHEN UPDATE DOES ADDFILES IN Q MODE WITH A RANDOM             01255819
*         OLDPL, THE NAMES OF THE DECKS AFTER WHICH ADDFILES            01255820
*         ARE TO BE MADE, ARE ADDED TO DKLIS SO THAT UPDATE             01255821
*         WILL NOT SKIP THESE DECKS.  WHEN ONE OF THESE                 01255822
*         SPECIAL ENTRIES IS FOUND DURING PASS 2 PROCESSING,            01255823
*         THE DECK IS NOT READ FROM THE OLDPL BUT FAKEOUT               01255824
*         IS CALLED TO SET UP PARAMETERS AS IF IT HAD BEEN              01255825
*         READ.                                                         01255826
*                                                                       01255827
*         CALLS  CHEKADF                                                01255828
                                                                        01255829
FAKEOUT   SA3    WORKLGTH                                               0169  10
          SX6    X3+2                                                   0169  11
          EQ     FAKEOUT2                                               0169  12
          SPACE  1                                                      0169  13
FAKEOUT1  SA3    WORKLGTH                                               0169  14
          SX6    X3+B1                                                  0169  15
FAKEOUT2  SA6    A3                                                     0169  16
          SX7    A1 
          SA7    CLDKS
          SA3    IDFLG                                                  0169  19
          BX6    X3                SET UP TO CHECK FOR PREVIOUS ADDFILE 0169  20
          MX7    0                                                      0169  21
          SA6    GETLIMT+1                                              0169  22
          SA6    TEMPID      TEMPORARILY STORE IDFLG
          SA7    A3                                                     0169  23
          SA1    L.DICT                                                 0169  24
          RJ     CHEKADF                                                0169  25
  
*         CONTROL RETURNS TO THIS POINT ONLY IF THERE 
*         ARE NO ADDFILE ENTRIES IN THE DICTIONARY WHICH
*         ADDFILE AFTER AN ADDFILE. 
  
          SA1    CLDKS
          SA1    X1 
          SX0    10B
          BX7    X1+X0       SET SCAN1 BIT OF DKLIS ENTRY 
          SA7    A1 
          MX0    54 
          SX6    B0 
          BX7    X7*X0       SEGREGATE DNAME FROM DKLIS ENTRY 
          SA6    DECKFLAG 
          SA7    GETLIMT+1
          SA3    WORKLGTH 
          SA2    FASTFLG
          NG     X2,FAKEOUT3 IF K OPTION IS ON
          SX3    X3-1 
FAKEOUT3  SX6    X3-1 
          SA6    A3 
          SA1    L.DICT 
          RJ     CHEKADF     CHECK AGAIN FOR ADDFILES 
  
*         CONTROL RETURNS TO THIS POINT ONLY IF THERE 
*         ARE NO ADDFILE ENTRIES IN THE DICTIONARY (I.E.
*         THE ADDFILES HAVE ALREADY BEEN PROCESSED).
  
          SA1    TEMPID 
          BX6    X1 
          SA6    IDFLG
          EQ     CHEKMODE    RETURN TO PASS 2 PROCESSING
          EJECT  4                                                      01255831
**        FINALCPY  TERMINAL PROCESSING ON PLS                          01255832
*                                                                       01255833
*         THIS SUBROUTINE IS CALLED TO PROVIDE TERMINAL                 01255834
*         PROCESSING ON NEWPL AND OLDPL.  IF THE TEMPORARY              01255835
*         PL UPDTTPL HAS BEEN USED, IT IS CLOSE-UNLOADED,               01255836
*         OTHERWISE, THE OLDPL IS REWOUND (IF THE PROPER
*         REWIND BIT IS SET) AND CLOSED.  DUMDIR IS CALLED
*         TO LIST OUT THE TABLES.  IF A SEQUENTIAL NEWPL
*         IS BEING WRITTEN, THE CHECKSUM IS WRITTEN AND 
*         THE NEWPL IS REWOUND (IF THE PROPER REWIND BIT
*         IS SET) AND THE FILE IS CLOSED. 
*                                                                       01255842
*         CALLS  DUMDIR, CALLIO, CPCLEAR, MANAGER, CALLPP, RBINC, WBINC 01255843
                                                                        01255844
FINALCPY  PS
          SA1    TEMPIN 
          SA2    OLDPL
          BX0    X1-X2
          AX0    18 
          NZ     X0,FINAL5
          SX0    B1 
          SA2    A2+B1
          LX0    47 
          BX6    -X0*X2 
          SA6    A2 
          CLOSE  OLDPL,UNLOAD 
FINAL7    RJ     DUMDIR 
          SA1    HOLD              DID WE USE A TEMPORARY SEQUENTIAL PL 
          NZ     X1,FINAL8         YES
          SA1    RANDNPL
          PL     X1,FINALRC        CLOSE RANDOM PL
          EQ     FINALR            CLOSE SEQUENTIAL PL
 FINAL8   BSS    0
          WRITER NEWPL
  
          ENV    ACT,(2,3),VER2 
          CLOSE  NEWPL,REWIND 
          CLOSE  OLDPL
VER2      ELSE
          REWIND NEWPL
VER2      ENDIF 
  
          RECALL NEWPL
          RECALL OLDPL
          SA1    WRCHSUM
          SA2    HOLD 
          BX6    X1 
          BX7    X2 
          SA7    NEWPL             RESTORE NEWPL NAME 
          SX7    B0 
          SA6    A2                SAVE WRCHSUM 
          SA7    A1                SET WRCHSUM TO ZERO
  
          ENV    ACT,(2,3),VER2 
          OPEN   NEWPL,WRITENR
VER2      ENDIF 
  
          SA1    L.NEWDKS 
          SX6    B0 
          SA6    L.DECKS
          ALLOC  DECKS,X1 
          SX1    X3 
          SX3    X2 
          SA2    F.NEWDKS 
          MOVE   X1,X2,X3          MOVE NEWDKS TO DECKS 
          SX6    B0 
          SA6    EDITFLAG          CLEAR EDITFLAG 
          CLEAR  NEWPL,WRITE
          RJ     DUMPLIST          SET DECKLIST, ETC. ON NEWPL
          SA1    WRCHSUM
          SA2    HOLD 
          IX6    X1+X2
          SA6    A2                SAVE TOTAL CHECKSUM
          SA1    TEMPNEW           SET TEMP FILE NAME INTO OLDPL FET
          BX6    X1 
          SA6    OLDPL
  
          ENV    ACT,(2,3),VER2 
          OPEN   OLDPL,READ 
VER2      ENDIF 
  
          CLEAR  OLDPL,READ 
          SPACE  1
 RWLOOP   READWC OLDPL,BUFC,1000B  READ FROM TEMP FILE
          NZ     X1,FINLOOP        TEST FOR EOF 
          WRITEWC  NEWPL,BUFC,1000B  WRITE ON NEWPL 
          EQ     RWLOOP            GO READ NEXT BLOCK 
          SPACE  1
FINLOOP   SB4    1000B
          SB7    B4-B7
          WRITEWC  NEWPL,BUFC,B7     WRITE LAST PART OF NEWPL 
  
          ENV    ACT,(11),VER2
          EVICT  OLDPL
VER2      ENDIF 
  
          CLOSE  OLDPL,UNLOAD 
          SA1    WRCHSUM
          SA2    HOLD 
          IX2    X2-X1             TEST IF CHECKSUM OK
          NZ     X2,CKERR          NO, JUMP 
 FINALR   WRITEW NEWPL,WRCHSUM,1
          WRITEF NEWPL
          BKSP   NEWPL,RECALL 
 FINALRC  CLOSE  NEWPL,NR,RECALL
  
          SPACE  1
          ENV    NOT,(1,7,8,9),NOS
          SA1    DIRNEWPL 
          ZR     X1,FINALR1 
          ALTER  NEWPL             SET PERMANENT EOI FOR PERM FILE
 FINALR1  BSS    0
 NOS      ENDIF 
          SPACE  1
          SA1    NOREWFLG 
          LX1    59-2 
          PL     X1,FINALCPY
          REWIND NEWPL
          EQ     FINALCPY 
          SPACE  1
FINAL5    SA1    NOREWFLG 
          LX1    59-3 
  
          ENV    ACT,(2,3),VER2 
          PL     X1,FINAL5A  IF OLDPL NOT TO BE REWOUND 
          CLOSE  OLDPL,REWIND 
          EQ     FINAL5B
FINAL5A   CLOSE  OLDPL
FINAL5B   BSS 
VER2      ELSE
          PL     X1,FINAL5C  IF OLDPL NOT TO BE REWOUND 
          REWIND OLDPL
FINAL5C   BSS 
VER2      ENDIF 
  
          EQ     FINAL7 
          SPACE 1 
 CKERR    MESSAGE (=C+*** WARNING NEWPL CHECKSUM ERROR ***+)
          SA2    NFERROR           INCREASE NONFATAL ERROR COUNT
          SX6    X2+B1
          SA6    A2 
          EQ     FINALR            RETURN AND FINISH WRITING NEWPL
          EJECT  4                                                      01255846
**        FCORX  FIND SEQUENCE NUMBER                                   01255847
*                                                                       01255848
*         ENTRY  X1 - BITS  0-17 - DIRECTORY ORDINAL                    01255849
*                     BITS 18-36 - BINARY SEQUENCE NUMBER               01255850
*                                                                       01255851
*         EXIT   X6 - LEFT JUSTIFIED DISPLAY CODE SEQUENCE NUMBER       01255852
*                X7 - RIGHT JUSTIFIED IDENT NAME FOLLOWED BY PERIOD     01255853
*                                                                       01255854
*         CALLS  CONDEC                                                 01255855
                                                                        01255856
FCORX     PS                       THIS SUBROUTINE EXPECTS X1 TO CONTAIN
          AX1    18                A WORD IN THE -DICT- FORMAT. BITS
          SX1    X1                0-17 A DIRECTORY ORDINAL, BITS 18-35 
          RJ     CONDEC            A BINARY SEQUENCE NUMBER. ON EXIT X6 
          SB6    60                WILL CONTAIN THE LEFT-JUSTIFIED
          SB5    B6-B2             DISPLAY CODE SEQUENCE NUMBER, AND X7 
          LX6    X6,B5             THE IDENTIFIER WHOSE ORDINAL WAS IN
          SA1    A1                X1.
          SX7    X1 
          SA2    F.DIRECT 
          MX0    54 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SB5    X2 
          SA2    X7+B5
S2LCM     ELSE
          IX2    X7+X2             COMPUTE LCM ADDRESS. 
          RX2    X2                FETCH DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          BX7      X0*X2
          SX2    1R 
          LX0    6
FCORX2    BX3    -X0*X7 
          BX7    X7+X2
          NZ     X3,FCORX1
          LX7    54 
          EQ     FCORX2 
          SPACE  1
FCORX1    SX2    B1+B1
          IX7    X7+X2
          EQ     FCORX
          SPACE  4                                                      01255858
**        FORMATCD  SET UP SEQUENCE FIELDS                              01255859
*                                                                       01255860
*         FORMATCD SETS UP ENTRY CONDITIONS FOR ADDIDA                  01255861
*         AND CALLS ADDIDA TO GENERATE THE SEQUENCE FIELD 
* 
*                                                                       01255864
*         CALLS  ADDIDA                                                 01255865
                                                                        01255866
FORMATCD  BSS    1                 SET UP THE SEQUENCE FIELDS,
          SA4    WII               ACTIVE IDENT WIDTH 
          ZR     X4,FORMATCD
          SB7    X4 
          RJ     FORMATCX 
          EQ     FORMATCD 
* 
 FORMATCX PS     ** 
          SA4    CARDID 
          SB2    X4 
          SA2    F.DIRECT 
          AX4    30 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X2+B2
S2LCM     ELSE
          SX1    X2+B2             COMPUTE LCM ADDRESS AND
          RX1    X1                READ DIRECTORY ENTRY.
S2LCM     ENDIF 
          SPACE  1
          RJ     ADDIDA 
          EQ     FORMATCX 
          EJECT  4                                                      01255868
**        GETC   GET NEXT CHARACTER                                     01255869
*                                                                       01255870
*         THE SQUEEZED CARD IMAGE IS IN SQIMAGE, ITS LENGTH             01255871
*         IN SQLGN.  COLUMN CONTAINS A FLAG WHICH, WHEN UN-             01255872
*         PACKED, PRODUCES IN THE X RESULT REGISTER A NUMBER            01255873
*         TO BE ADDED TO SQIMAGE TO LOCATE THE WORD BEING               01255874
*         CURRENTLY PROCESSED AND IN THE B RESULT REGISTER              01255875
*         A SHIFT COUNT WHICH WILL RESULT IN THE LAST CHAR-             01255876
*         ACTER WHICH WAS SCANNED BEING POSITIONED IN BITS              01255877
*         0-5.  THE SCAN IS TERMINATED WHEN THE LAST WORD               01255878
*         OF THE IMAGE (AS INDICATED BY SQLGN) HAS BEEN                 01255879
*         COMPLETELY SCANNED OR WHEN 0000B IS ENCOUNTERED.              01255880
*         GETC RETURNS THE NEXT CHARACTER IN X6 AND IN                  01255881
*         CHAR AND UPDATES THE POINTERS IN COLUMN.                      01255882
*                                                                       01255883
*         EXIT   X6 - NEXT CHARACTER                                    01255884
                                                                        01255885
GETCHX    PX7    X1,B7
          SA6    CHAR 
          SA7    A1 
GETC      PS
          SX5    1R 
          SA1    COLUMN 
          SA2    X1+SQIMAGE 
          SA3    SQLGN
          UX1    X1,B7
          IX3    X3-X1
          SB7    B7+6 
          ZR     X3,GETCEND 
          MX6    54 
          LX3    X2,B7
          SB6    60 
          BX6    -X6*X3 
          IX5    X5-X6
          NE     B7,B6,GETCHX 
          SX1    X1+B1
          SB7    B0 
          EQ     GETCHX 
          SPACE  1
GETCEND   BX6    X5 
          MX7    0
          SA6    CHAR 
          EQ     GETCH
          EJECT  4                                                      01255887
**        GETCH  GET CHARACTER                                          01255888
*                                                                       01255889
*         GETCH CALLS GETC TO FETCH ONE CHARACTER AT A TIME             01255890
*         FROM SQIMAGE, BUT INSTEAD OF SIMPLY RETURNING                 01255891
*         THE CHARACTER IN CHAR AND X6, GETCH EDITS THE                 01255892
*         CHARACTERS TO RETURN A DISPLAY CODE BLANK IN                  01255893
*         PLACE OF THE SQUEEZED BLANK REPRESENTATION.                   01255894
*         GETCH ALSO CHECKS THE TYPE OF OLDPL TO DETERMINE              01255895
*         WHETHER 0001B REPRESENTS 2 BLANKS OR THE 00B                  01255896
*         CHARACTER, AND RETURNS EITHER 00B OR 55B AS                   01255897
*         APPROPRATE IN CHAR AND X6.                                    01255898
*                                                                       01255899
*         EXIT   X6 - CHARACTER                                         01255900
*                                                                       01255901
*         CALLS  GETC                                                   01255902
          SPACE  1
          SPACE  1
GETCH1    BX7    X4 
          SA7    A4                RESTORE COLUMN POINTER 
          RJ     GETC 
GETCH     PS
          SA4    COLUMN 
          RJ     GETC 
          ZR     X6,GETCH0         POSSIBLE SQUEEZED BLANKS 
          NZ     X5,GETCH          GOOD CHARACTER 
          RJ     GETC 
          ZR     X5,GETCH          2 UNSQUEEZED BLANKS
          EQ     GETCH1            ONLY ONE BLANK 
          SPACE  1
GETCH0    RJ     GETC 
          BX7    X6 
          AX1    X6,B1
          IX6    X6+X5
          SA6    A6 
          ZR     X7,GETCH          END OF CARD
          NZ     X1,GETCH          SQUEEZED BLANKS
          SA5    CHARKEY
          PL     X5,GETCH          2 SQUEEZED BLANKS
          MX6    0
          SA6    A6                STORE A COLON
          EQ     GETCH
          EJECT  4                                                      01255904
**        GETNEXC  GET CHARACTER AND COMPARE                            01255905
*                                                                       01255906
*         ENTRY  X1 - WORD BEING SCANNED                                01255907
*                X0 - 54 BIT MASK                                       01255908
*                X3 - CHARACTER TO BE COMPARE WITH CHARACTER SCANNED    01255909
*                B6 - COUNT OF CHARACTERS IN X1 TO BE SCANNED           01255910
*                B7 - COUNT OF ADDITIONAL WORDS TO BE SCANNED           01255911
*                                                                       01255912
*         EXIT   X2 - NEXT CHARACTER                                    01255913
*                X4 - ZERO IF SCANNED CHARACTER SAME AS CHARACTER IN X3 01255914
*                B7 - NEGATIVE IF ALL WORDS HAVE BEEN SCANNED           01255915
                                                                        01255916
 GETNEXC  PS     ** 
          NZ     B6,GETNEXC1
          SB2    B2+B1             WORDS SCANNED SO FAR 
          SB7    B7-B1             GET NEXT WORD
          SA1    A1+B1
          NG     B7,GETNEXC        WORD COUNT EXHAUSTED 
          SB6    10 
          ENV    ACT,(2,3),VER2 
          SA5    WCW
          ZR     X5,GETNEXC1       NOT THE INPUT FILE 
          SB3    X5                WORD COUNT 
          GT     B2,B3,GETNEXC2     WORD COUNT EXHAUSTED
          LT     B2,B3,GETNEXC1    NOT LAST WORD
          AX5    18                UBC
          SX4    60 
          IX4    X4-X5             BC=60-UBC
          SA5    SIXTH
          FX4    X4*X5             CHAR=BC/6
          SB6    X4                CHARACTERS TO SCAN 
 VER2     ENDIF 
 GETNEXC1 LX1    6
          SB6    B6-B1
          BX2    -X0*X1            ISOLATE CHARACTER
          IX4    X2-X3
          BX1    X0*X1
          NZ     X2,GETNEXC 
          NZ     X1,GETNEXC        CHECK FOR END OF LINE
          ENV    ACT,(2,3),VER2 
          SA5    WCW
          NZ     X5,GETNEXC        IF W-TYPE RECORD 
 VER2     ENDIF 
          NZ     B6,GETNEXC2       DEFINITE EOL, 00-00
          SA1    A1+B1             POSSIBLE COLON OR 11-CHAR EOL
          SB7    B7-B1
          SB6    10 
          NZ     X1,GETNEXC 
 GETNEXC2 SB7    -B1               DEFINITE EOL 
          MX7    0
          SA7    WCW               CLEAR W CTL WORD 
          EQ     GETNEXC
          EJECT  4                                                      01255918
**        GETTXT  GET TEXT PAGE INTO TEXT AREA                          01255919
*                                                                       01255920
*         GETTXT INSURES THAT THE PROPER RECORD OF UPDTEXT              01255921
*         IS IN CORE.  ON ENTRY, X0 CONTAINS THE BIAS OF                01255922
*         THE CARD IMAGE DESIRED.  IF THE RECORD CONTAINING             01255923
*         THIS CARD IMAGE IS NOT THE RECORD CURRENTLY IN                01255924
*         CORE, THE PROPER RECORD IS READ FROM UPDTEXT.                 01255925
*                                                                       01255926
*         ENTRY  X0 - BIAS OF CARD IMAGE DESIRED                        01255927
*                                                                       01255928
*         CALLS  CALLIO, CPCLEAR                                        01255929
          SPACE  1
GETTXT    PS
          SA1    L.TXTLIM          IF ONLY ONE RECORD EXISTS, IT MUST 
          ZR     X1,GETTXT         BE THE ONE NOW IN CORE.
          SA4    F.TXTLIM          LOCATE OR CONFIRM PROPER PAGE OF TEXT
          SA3    CURNO
          SB2    B1+B1
          MX5    0
          SB5    B0 
          SA2    X4 
+         SA2    A2+B2             FETCH SIZE OF A PAGE 
          IX0    X0-X2
          SB5    B5+B1             BUMP RECORD NUMBER 
          IX5    X5+X2             ACCUMULATE PAGE ORIGINS
          PL     X0,*-1            KEEP GOING UNTIL BIAS IS EXCEEDED
          SB6    X3 
          IX0    X0+X2             INDEX OF THIS LINE 
          IX6    X5-X2             BIAS OF THIS LINE
          SB3    X0 
          EQ     B5,B6,GETTXT      IF PROPER PAGE ALREADY IN CORE 
          SA4    A2-1              FETCH RANDOM ADDRESS 
          SX7    B5                THS RECORD NUMBER
          SA6    TXTBIAS
          SA7    A3 
          BX6    X4 
          SA6    UPDTEXT+6
          READ   UPDTEXT
          CLEAR  UPDTEXT
          SX0    B3 
          EQ     GETTXT 
          SPACE  4
          ENV    ACT,(2,3),S2LCM
**        MANAGL - MANAGE LCM SPACE FOR DIRECT
* 
*         ENTRY  (X1) = AMOUNT TO INCREASE TABLE
* 
*         EXIT   (X2) = ORIGIN
*                (X3) = NEW LENGTH
          SPACE  1
MANAGL    DATA   0
          SA2    F.DIRECT          FETCH DIRECTORY ORIGIN.
          SA3    L.DIRECT          FETCH DIRECTORY LENGTH.
          IX6    X3+X1             NEW LENGTH 
          SA6    A3                STORE NEW LENGTH.
          SX6    X6+777B           ROUND
          AX6    9                      ING 
          LX6    9                          OFF.
          SA4    SIZECORL          AMOUNT OF LCM AVAILABLE
          IX7    X2+X6             NEW SIZE OF LCM REQUIRED 
          IX6    X7-X4             REQUIRED - ACTUAL
          NG     X6,MNGL10         JUMP IF SUFFICIENT LCM 
          LX7    30                FORM 
          SA7    A4                     REQUEST.
          MEMORY LCM,SIZECORL 
          LX7    30                STORE
          SA7    A7                      NEW SIZE.
MNGL10    BSS    0
          SA3    A3                GET NEW LENGTH.
          EQ     MANAGL 
S2LCM     ENDIF 
          EJECT  4                                                      01255991
**        ALTERFL  ALTER FIELD  ENGTH 
* 
*         ALTERFL IS ENTERED WHEN THE MEMORY MANAGER NEEDS MORE SPACE.
* 
*         ENTRY.. B5 = -(NUMBER OF WORDS REQUIRED)
*                 B6 = RETURN ADDRESS 
* 
*         EXIT..  F.TEND UPDATED TO NEW FL
          SPACE  2
 ALTERFL  SA1    CORESIZE          CURRENT FL 
 TOV      EQU    ALTERFL
          SA3    MAXMEM            MAXIMUM ALLOWED
          SX2    B5-777B-8         -(REQUEST+SPARE SPACE (1K))
          IX6    X1-X3             MAX CHECK
          MX0    60-9 
          ZR     X6,ALTERABT       NO MORE SPACE AVAILABLE
          BX2    -X2*X0            REQUEST, ROUND TO 1K 
          IX6    X1+X2             NEW CM SIZE
          IX5    X3-X6             CHECK FOR MAX
          PL     X5,ALTERF1 
          SX6    X3                USE MAX
 ALTERF1  LX6    30 
          SA6    A1                CANT BE IN REGISTER FOR SCOPE 2
          MEMORY CM,CORESIZE,RCL,,NA
  
          SA1    CORESIZE          SEE WHAT WE GOT
          BX6    X1 
          AX6    30 
          SX7    X6-8 
          SA6    A1                NEW CORESIZE 
          SA7    F.TEND            NEW TABLE END
          JP     B6                EXIT 
  
 ALTERABT BSS    0                 OUT OF SPACE 
          MESSAGE  MESG7
          MESSAGE  ABMSG
          EQ     BRF               ABORT
          EJECT  4                                                      01256008
**        MANUCARD PRODUCES A CARD                                      01256009
*                                                                       01256010
*         THE APPROPRIATE CONTROL CHARACTER                             01256011
*         (FLGCHAR) IS ADDED TO THE KEY WORD AND THE                    01256012
*         FACSIMILE OF THE ORIGINAL CARD WHICH PRODUCED                 01256013
*         THE DICT ENTRY IS BUILT IN CARD.  FCORX IS CALLED             01256014
*         ONCE OR TWICE TO DECODE THE DICT ENTRY(S).                    01256015
*                                                                       01256016
*         ENTRY  X5 - KEY WORD                                          01256017
*                X1 - DICT TYPE ENTRY                                   01256018
*                                                                       01256019
*         CALLS  FCORX, GETNEXC, PUTNEXC                                01256020
                                                                        01256021
MANUCARD  BSS    1                 THIS SUBROUTINE TAKES A DICT OR
          SA2    FLGCHAR           TDICT ENTRY (FWA IN A1) AND CREATES
          LX2    54 
          BX6    X2+X5             IN -CARD- A FACSIMILE OF THE CARD
          SA6    CARD              WHICH PRODUCED THE ENTRY. IT CALLS 
          SA5    =1H               FCORX. 
          BX6    X5 
          SA6    CARD+4 
          SA6    A6-B1
          NG     B7,MANUCD1 
          RJ     FCORX
          SA6    CARD+2 
          SA7    A6-B1
          SA1    A1+B1
          ZR     B7,FLOPDN3 
          RJ     FCORX
          SA6    CARD+4 
          SA7    A6-B1
          MX0    54 
          SB7    2
          SB5    10 
          SA1    CARD+1 
          SX3    1R 
          BX6    X1 
          SB6    B5 
          SA6    A1 
          MX6    0
          SB4    B5 
          SA1    A1+B1
          SX7    B1 
          IX1    X1+X7
FLOOP1    RJ     GETNEXC
          NG     B7,FLOPDONE       SQUEEZE THE CREATED CARD 
          ZR     X4,FLOOP1
          RJ     PUTNEXC
          EQ     FLOOP1 
          SPACE  1
 FLOPDONE ZR     B5,FLOPDN2 
 FLOPDN1  LX6    6
          SB5    B5-B1
          NZ     B5,FLOPDN1 
  
 FLOPDN2  BSS    0
          ENV    ACT,(2,3),VER2 
          BX1    X6 
          RJ     SFN=              BLANK FILL LAST WORD 
          SX7    A6-CARD+2
          SA7    UCW               SET RECORD LENGTH
 VER2     ENDIF 
          SA6    A6+B1
 FLOPDN3  MX6    0
          SA6    A6+B1
          SA6    CARD8
          SA6    SQLGN
          SA6    SQLGN8 
          SA6    PRINTED
          EQ     MANUCARD 
          SPACE  1
MANUCD1   SA2    =10H    FNAME, 
          LX1    6
          MX0    54 
          BX6    X0*X1
          LX7    X2 
          SA6    CARD+2 
          SA7    A6-B1
          EQ     FLOPDN3
          SPACE  4                                                      01256023
**        MISIDENT  PRINT MISSING IDENT ERROR MESSAGE                   01256024
*                                                                       01256025
*         CALLS  PRINT                                                  01256026
                                                                        01256027
MISIDENT  PS
          SA1    LISTONE
          ZR     X1,MISIDENA
          SA6    MISIDENM+4 
          PRINT  MISIDENM,7 
MISIDENA  SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     MISIDENT 
          SPACE  4                                                      01256029
**        ONTEXT/OFFTEXT  SET TEXT FLAGS                                01256030
*                                                                       01256031
*         THESE ROUTINES ARE CALLED WHEN A TEXT/ENDTEXT                 01256032
*         CARD IS ENCOUNTERED IN PASS 2 TO SET THE APPRO-               01256033
*         PRIATE FLAG.                                                  01256034
*                                                                       01256035
*         CALLS  WRSOU                                                  01256036
          SPACE  1
ONTEXT    RJ     LISTTEXT          DO NECESSARY LISTING 
          SA1    TXTFLAG
          SX6    X1+B1                                                  0081  48
          EQ     TEXTCOM                                                0081  49
          SPACE  1                                                      0081  50
OFFTEXT   RJ     LISTTEXT          DO NECESSARY LISTING 
          SA1    TXTFLAG
          SX6    X1-1                                                   0081  52
TEXTCOM   SA6    A1                                                     0081  53
          PL     X6,TEXTCOM2
          RJ   TXTERR                                                   1704  15
          RJ     WRSOU
          EQ     ECOR1
 TEXTCOM2 BSS    0
          RJ     WRSOU
TEXTCOM3  SA1    COMFLG            IF WE ARE PROCESSING A COMMON
          ZR     X1,ECOR1          DECK , WE MUST WRITE THE TEXT
          SA1    SQLGN8 
          ZR     X1,TEXTCM3B       NO 8-BIT CARD
          BX6    -X1
          SA6    A1                NEGATE COUNT WORD
          WRITEW UPDTCDK,A1,X1+1   8-BIT CARD 
          SA1    SQLGN8 
          BX6    -X1
          SA6    A1 
          EQ     TEXTCM3D 
  
 TEXTCM3B SA1    SQLGN
          WRITEW UPDTCDK,A1,X1+1   6-BIT CARD 
 TEXTCM3D WRITEW UPDTCDK,CARDID,1  IDENT AND SEQUENCE NUMBER
          EQ     ECOR1
                                                                        1704  18
**        TXTERR  INSURE TEXT FLAG POSITIVE                             1704  19
*                                                                       1704  20
*         TXTERR IS CALLED WHEN UNBALANCED TEXT/ENDTEXT CARDS CAUSE     1704  21
*         TXTFLAG TO BECOME NEGATIVE.  TXTFLAG IS SET TO ZERO AND A     1704  22
*         WARNING MESSAGE IS ISSUED.                                    1704  23
*                                                                       1704  24
*         CALLS  PRINT                                                  1704  25
                                                                        1704  26
TXTERR    PS                                                            1704  27
          SX6    B0                                                     1704  28
          SA2    NFERROR           INCREMENT NON FATAL ERROR COUNT      1704  29
          SX7    X2+B1                                                  1704  30
          SA6    TXTFLAG           SET TXTFLAG TO ZERO                  1704  31
          SA7    A2                                                     1704  32
          PRINT  (0*** UNBALANCED TEXT/ENDTEXT CARDS, LAST ENDTEXT CARD 1704  33
,IGNORED ***)                                                           1704  34
          EQ   TXTERR                                                   1704  35
  
**
*         LISTTEXT
*         THIS SUBROUTINE LISTS TEXT AND ENDTEXT CARDS IF NECESSARY.
* 
*         CALLS UCARD, ADDID
* 
LISTTEXT  PS
          SA2    LISTTWO
          ZR     X2,LISTTEXT       IF L=2 NOT IN EFFECT, EXIT 
          RJ     ADDID
          PRNTCARD
          EQ     LISTTEXT 
          EJECT  4                                                      01256038
          SPACE  4
**        PAD8   PAD WITH BLANKS
* 
*         PAD8 CONVERTS TRAILING BINARY ZEROS IN X1 TO ASCII BLANKS.
* 
*         ENTRY  X1 - WORD TO BE PADDED 
* 
*         EXIT   X6 - PADDED WORD 
  
PAD8      PS
          SX6    B1 
          SB3    60-12+1           SET SHIFT FOR 12 BIT CHARACTER 
          IX0    X1-X6             CHANGE TRAILING 0S TO 1S 
          SA3    MASCII            PICK UP MASK FOR ASCII 
          BX0    -X1*X0            PRESERVE JUST TRAILING ONES
          BX6    X0*X3             PRESERVE AS MANY ONES AS BLANKS NEEDED 
          LX3    X6,B3             POS MASK SO 1S ARE IN BOTTOM OF CHAR 
          IX0    X6-X3             MASK IS ALL ONES EXCEPT TOP BITS 
          BX6    X6+X0             OR IN TOP BITS - MASK COMPLETE 
          SA3    A3+B1             PICK UP WORD OF ASCII BLANKS 
          BX0    X3*X6             MASK OFF PROPER NUMBER OF BLANKS 
          IX6    X0+X1             OR BLANKS INTO WORD
          EQ     PAD8 
          EJECT  4                                                      01256063
**        POSCOM  POSITION COMMON DECK                                  01256064
*                                                                       01256065
*         WHEN ONE COMDECK CONTAINS A CALL TO ANOTHER COMDECK           01256066
*         THE CURRENT POSITION OF THE FIRST COMDECK PRO-                01256067
*         CESSING IS STORED IN THE TABLE COMBAK.  THE SECOND            01256068
*         COMDECK IS THEN PROCESSED AND AT THE END OF IT                01256069
*         POSCOM IS CALLED TO RESTORE THE CONDITIONS OF                 01256070
*         THE FIRST COMDECK PROCESSING.  THE METHOD USED                01256071
*         IS TO KEEP A COUNT OF THE NUMBER OF CARDS IN                  01256072
*         EACH COMDECK AS IT IS PROCESSED.  WHEN POSCOM                 01256073
*         IS CALLED THE NUMBER OF CARDS WHICH HAD BEEN                  01256074
*         PROCESSED WHEN THE CALL CARD WAS ENCOUNTERED                  01256075
*         ARE SKIPPED AND THE ENTRY IN COMBAK IS DISCARDED.             01256076
*                                                                       01256077
*         CALLS  CPCLEAR, RBIN                                          01256078
                                                                        01256079
POSCOM    PS
          CLEAR  UPDTCDK,READ 
          SA3    F.COMBAK 
          SX6    X4-2 
          IX0    X6+X3
          SA3    X0 
          LX7    X3 
          SA6    A4 
          SX5    X3 
          AX3    30 
          SA7    COMCOUNT 
          MX4    30                                                     0886   5
          BX6    -X4*X3                                                 0886   6
          SA4    A3+B1
          BX7    X4 
          SA6    UPDTCDK+6
          SA7    DNAME
 POSCOM1  ZR     X5,POSCOM         EXIT WHEN POSITIONED CORRECTLY 
          READW  UPDTCDK,SQLGN8,1 
          SA4    SQLGN8 
          MX6    0
          SA6    A4 
          PL     X4,POSCOM1A
          BX4    -X4               CORRECT FOR 8-BIT CARD 
 POSCOM1A ZR     X4,POSCOM1B       NULL CARD
          READW  UPDTCDK,A4+B1,X4 
 POSCOM1B READW  UPDTCDK,CARDID,1 
          SX5    X5-1 
          EQ     POSCOM1
          EJECT  4                                                      01256081
E         IF     DEF,AUDITKEY 
**        PRAUDIT  PROCESS AUDIT                                        01256083
*                                                                       01256084
*         AUDIT PROCESSING INVOLVES THE COLLECTION ON THE               01256085
*         FILE UPDTAUD (REFERENCED INTERNALLY AS AUDITFL)               01256086
*         OF ALL INFORMATION FOR TYPES 5-9 LISTINGS.  UPDTAUD           01256087
*         IS IN THE SAME FORMAT AS THE NORMAL LIST FILE.                01256088
*         CARDS WHICH BELONG TO A CATEGORY WHICH IS TO BE               01256089
*         LISTED ARE WRITTEN TO UPDTAUD.  IF CORRECTION                 01256090
*         HISTORY IS REQUESTED, THE CORRECTION HISTORY BYTES            01256091
*         FOR ALL CARDS TO BE WRITTEN OUT ARE CONVERTED                 01256092
*         TO IDENT NAMES.  CORRECTION HISTORY IS NOT PRINTED            01256093
*         IF ONLY THE MASTER CHB OCCURS.  THE COUNT OF CARDS            01256094
*         BELONGING TO EACH IDENT IS KEPT IN THE TABLE                  01256095
*         AUDCNT IF THIS LIST OPTION IS SELECTED (OPTION 6).            01256096
*         AT THE END OF EACH DECK THE VALUES ACCUMULATED                01256097
*         IN AUDCNT FOR EACH IDENT ARE PRINTED AND ADDED                01256098
*         TO THE TOTALS FOR THE ENTIRE LIBRARY.  THIS ACTION            01256099
*         IS PERFORMED BY TOTALS.  IF F MODE ALL DECKS                  01256100
*         ARE PROCESSED FOR AUDIT, IN OTHER MODES ONLY                  01256101
*         DECKS SPECIFIED ON COMPILE CARDS ARE PROCESSED.               01256102
*         ACTUAUDIT IS A FLAG WHICH IS NON-ZERO WHEN THE                01256103
*         CURRENT DECK IS BEING AUDITED.                                01256104
*                                                                       01256105
*         CALLS  CLASSIFY, UCARD, ADDID, WBIN, WDEC, TOTALS             01256106
                                                                        01256107
PRAUDIT   SA1    CARDSTAT          BYPASS ANY INACTIVE DECK OR
          PL     X1,AUDIT2         COMDECK CARDS
          CLASIFY 
          ZR     X1,AUDIT2         JUMP IF NOT DECK OR COMDECK
          CCJUMP DECK,AUDIT3
          CCJUMP COMDECK,AUDIT3 
AUDIT2    SA1    ACTAUDIT          JUMP IF NOT IN A DECK TO BE
          ZR     X1,AUDIT6         AUDITED. 
AUDIT1    SA1    CARDSTAT 
          PL     X1,AUDIT5         JUMP IF PRESENT CARD IS INACTIVE 
          SA1    LISTSEVN          LISTSEVN IS NON-ZERO IF A LIST OF
          ZR     X1,AUDIT4         ACTIVE CARDS IS DESIRED. 
          SA1    =8L  A 
          BX6    X1 
AUDIT8    SA6    TCWDEC2
          RJ     ADDID             ADD IDENTIFICATION FIELD 
          SA1    TCWDEC2           AFTER WE FIRST 
          BX6    X1 
          SA6    CARD3             STORE PROPER CODE
          PRNTCARD  AUDITFL 
AUDIT7    SA1    LISTNINE          LISTNINE IS NON-ZERO IF CORRECTION 
          ZR     X1,AUDIT6         HISTORY IS DESIRED 
          MX6    0                 SET UP TEMP1 AND X3 TO START AT
          BX3    X6                ZERO WITH RESPECT TO RHE CHBS
          SA6    TEMP1             TEMP1 WILL BE USED IF WE HAVE MORE 
PROCCHB0  SA1    LCHBTAB           THAN ONE LINE TO PRINT.
          SA5    F.DIRECT          SET UP REGISTERS TO USE AS 
          IX1    X1-X3             INDEX. INCREMENT X1 BY X3
          SB5    X1                B5 WILL CONTAIN NUMBER OF CHBS 
          SB3    B0                TO BE PROCESSED.  B3 WILL CONTAIN
          GE     B1,B5,AUDIT6      THE NUMBER OF CHBS IN THE CURRENT
          SB4    X5                PRINT CYCLE. PRINT 10 TO A LINE. 
          SA1    CHBTAB+1+X3       THIS IS THE NEXT CHB.
          SB7    10                THIS IS THE LIMITING VALUE/LINE. 
PROCCHB1  EQ     B1,B5,PROCCHB5    EXIT WHEN WE ARE THROUGH.
          MX0    44                MASK TO GET RID OF ON/OFF BIT
          BX4    -X0*X1            SO THAT WE CAN USE THE CHB AS AN 
          MX7    6                 INDEX TO FIND THE IDENT. 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA4    X4+B4             FETCH THE IDENT AND FILL 
S2LCM     ELSE
          SX4    X4+B4             COMPUTE LCM ADDRESS AND
          RX4    X4                READ DIRECTORY ENTRY.
S2LCM     ENDIF 
          SPACE  1
          LX1    43                WITH BLANKS FOR PRINTING.
          LX4    54                SHIFT X1 SO THAT THE ON/OFF BIT IS 
          BX4    -X7*X4            AT THE TOP.
          SB5    B5-B1             DECREMENT THE TOTAL CHB COUNT. 
          SX3    1R                WE WILL USE THIS BIT TO DECIDE 
PROCCHB2  LX7    6                 WHETHER TO PREFIX A PLUS OR A
          BX6    X7*X4             MINUS TO THE IDENT NAME. 
          NZ     X6,PROCCHB3
          BX4    X4+X3
          LX3    6
          EQ     PROCCHB2 
          SPACE  1
PROCCHB3  SA2    =1L+              FETCH A PLUS.
          SA5    =1LA              AND A MINUS. 
          BX6    X4+X2             ADD IN THE PLUS. 
          NG     X1,PROCCHB4       JUMP IF THIS IS AN ON TYPE CHB.
          IX6    X6+X5             ELSE MAKE IT A MINUS BY ADDING ONE.
PROCCHB4  SA6    CHBTEMP+B3        STORE THIS WORD. 
          SB3    B3+B1             INCREMENT THE INDEX. 
          SA1    A1+B1             FETCH THE NEXT CHB.
          NE     B3,B7,PROCCHB1    IF THE LINE ISNT FULL TRY AGAIN. 
          SA1    TEMP1             IF IT IS FULL STORE THE
          SX6    X1+10             INDEX IN TEMP1 FOR NEXT PASS.
          SA6    A1                AND GO AHEAD AND PRINT THE LINE ONTO 
 PROCCHB5 PRINT  PRECHB,B3+B1,AUDITFL 
          SA3    TEMP1             NOW RESTORE THE COUNT TO X3. 
          NZ     X3,PROCCHB0       AND LOOP IF MORE TO GO.
AUDIT6    SA1    LISTSIX           LISTSIX IS NON-ZERO WHEN A RUNNING 
          ZR     X1,DONAUDIT       COUNT OF CARDS IN EACH DECK
          SA3    F.AUDCNT          THIS COUNT IS KEPT IN -AUDCNT- 
          SA1    CARDSTAT          THERE IS ONE CNTR WORD FOR EACH
          SX6    B1                IDENT. EACH CNTR WORD HOLDS 4 15-BIT 
          SA2    CHBTAB            COUNTS. FROM LEFT TO RIGHT THEY ARE
          SB3    X3                1-TOTAL CARDS IN IDENT, 2-TOTAL
          MX0    44                ACTIVE CARDS IN IDENT, 3-TOTAL CARDS 
          BX2    -X0*X2            IN IDENT IN CURRENT DECK, 4- TOTAL 
          LX6    30                ACTIVE CARDS IN IDENT IN CURRENT 
          LX2    1
          SX2    X2+B1             SECOND WORD OF AUDCNT ENTRY
          SA4    X2+B3             DECK.
          SX5    B0 
          PL     X1,ACTIVEN 
          SX5    B1 
ACTIVEN   BX6    X6+X5
          IX6    X6+X4
          SA6    A4 
          EQ     DONAUDIT 
          SPACE  1
AUDIT5    SA1    LISTEIGT          LISTEIGHT IS NON-ZERO WHEN INACTIVE
          ZR     X1,AUDIT6         CARDS ARE TO BE LISTED. IF IT IS ON
          SA1    =8L       I       THEN SET THE I FLAG AND JUMP TO
          BX6    X1 
          EQ     AUDIT8            WRITE OUT CARD 
          SPACE  1
AUDIT4    CLASIFY                  DECK NOT BEING AUDITED.
          ZR     X1,AUDIT6
          SA1    LISTFIVE          LISTFIVE IS NON-ZERO WHEN CONTROL
          ZR   X1,AUDIT6           CARDS TO BE LISTED                   550A   5
          SA1    =8L               SET FLAG TO BLANK AND JUMP TO
          BX6    X1                PROCESS CARD 
          EQ     AUDIT8 
          SPACE  1
AUDIT3    SA1    LISTSIX           ENTER HERE FOR ACTIVE DECK OR
          ZR     X1,AUDIT11        COMDECK CARDS.  LISTSIX NON-ZERO 
          RJ     TOTALS            INDICATES TOTALS TO BE PROCESSED.
          SA1    ACTAUDIT          ACTAUDIT NON-ZERO INDICATES PREVIOUS 
          ZR     X1,AUDIT11        DECK BEING AUDITED.
          SA1    LINCOUNT 
          SA2    JPS
          SX1    X1+3-HDRSLOP 
          IX7    X1-X2
          NG     X7,AUDIT11        SUPPRESS SPACE IF AT PAGE TOP
          PRINT  =1L0,1,AUDITFL 
AUDIT11   SA1    IDFLG             PUT NEW DECK NAME IN TITLE 
          RJ     SFN=              BLANK FILL THE DECK NAME 
          BX7    X1 
          SA6    DNTITLE     STORE THE BLANK FILLED NAME. 
          SA6    DNTITLE1    STORE THE BLANK FILLED NAME. 
          SA1    FMODE             IN F MODE ALL DECKS ARE AUDITED, 
          NZ     X1,AUDIT10 
*                                  IF WE ARE NOT IN F MODE THEN ONLY
          SA1    L.DKLIS           DECKS WHICH WERE SPECIFIED ON
          SA2    F.DKLIS           COMPILE CARDS ARE AUDITED, SO THE
          SB2    X1                TABLE DKLIS WHICH CONTAINS THESE 
          SA1    X2+B2             DECK NAMES IS SEARCHED.
AUDIT9    SB2    B2-B1
          NG     B2,AUDIT10 
          SA1    A1-B1
          BX0    X7-X1
          AX0    6
          NZ     X0,AUDIT9
AUDIT10   SX6    B2+B1             ACTAUDIT IS SET NON-ZERO IF AN ENTRY 
          SA6    ACTAUDIT          WAS FOUND. 
AUDIT12   SA1    ACTAUDIT 
          ZR     X1,AUDIT6
          SA1    LINCOUNT 
          SA2    JPS
          SX1    X1+3-HDRSLOP 
          IX7    X1-X2
          NG     X7,NOPGEND5
          PRINT  =1L1,1,AUDITFL    FORCE PAGE IF NO ROOM FOR TITLE+CARD 
 NOPGEND5 PRINT  TITLEONE,8,AUDITFL     TITLE FOR NEXT DECK 
          EQ     AUDIT1 
          SPACE  1                                                      0550  14
E         ENDIF 
          EJECT  4                                                      01256109
**        PRINT  PRINT LINE ON OUTPUT UNIT                              01256110
*                                                                       01256111
*         PRINT COUNTS THE NUMBER OF LINES PRINTED FOR EACH PAGE AND    01256112
*         PERFORMS TITLE PRINTING AND PAGE EJECTION WHEN                01256113
*         NECESSARY.  LPCNT HOLDS THE NUMBER OF LINES PRINTED           01256114
*         ON THE CURRENT PAGE.  IF THE TOTAL NUMBER OF LINES            01256115
*         EXCEEDS THE LIMIT (LLIMIT) TYPES 3 AND 4 LISTINGS             01256116
*         ARE DEFEATED.  IF THE LINE TO BE PRINTED IS                   01256117
*         TOO LONG TO FIT ON A 130 CHARACTER PRINTER, IT                01256118
*         WILL BE SPLIT AND A CONTINUATION LINE PRINTED                 01256119
*         HEADED BY THE CHARACTERS (CONT).                              01256120
*                                                                       01256121
*         ENTRY  B6 - FIRST WORD ADDRESS OF LINE TO BE PRINTED          01256122
*                B7 - WORD COUNT                                        01256123
*                A0 - FET FIRST WORD ADDRESS
          SPACE 
 PRINT    PS     ** 
          SA1    A0 
          ZR     X1,PRINT          EXIT IF L=0
 PRINT.A  SA2    B6                FIRST WORD TO BE PRINTED 
          MX0    54 
          LX2    6
          SB2    A0-OUTPUT
          BX6    -X0*X2            CARRIAGE CONTROL CHARACTER 
          SX6    X6-1R0 
          SB3    X6 
          SX7    B1 
          SA6    PRCC              SAVE CARRIAGE CONTROL FOR LATER
  
          SA1    LINCOUNT          AUDITFL LINE COUNT 
          NZ     B2,PRINT.1 
          SA1    LPCNT             OUTPUT LINE COUNT
          SA7    DPRINT 
 PRINT.1  SX7    B1 
          EQ     B3,B1,PRINT.3     PAGE EJECT CARRIAGE CONTROL
          SX7    X1+B1
          NE     B3,B0,PRINT.2
          SX7    X7+2              PRE+POST SPACE (CC = 0 ) 
 PRINT.2  SA2    JPS
          IX5    X7-X2
          SA7    A1                SAVE NEW LINE COUNT
          NG     X5,PRINT4         OK TO PRINT
  
**  AT THIS POINT IN PRINT, WE GO RECURSIVE TO GET THE TITLE OUT
* 
          SA5    PRINT             ENTRY POINT
          SX6    B6                POINTER TO LINE
          SX4    B7                SIZE OF LINE 
          LX6    30 
          BX7    X5 
          IX6    X6+X4
          SA7    PRENTRY
          SA6    PRPARMS
          PRINT  =1L1,1,A0         PAGE HEADER
          SB2    A0-OUTPUT
          ZR     B2,PRINT.R1       OUTPUT FILE
          PRINT  TITLEONE,8,A0     AUDIT SUBTITLE 
 PRINT.R1 SA1    PRENTRY           RESTORE FROM RECURSION 
          SA2    PRPARMS
          BX6    X1 
          SB7    X2 
          SA6    PRINT
          AX2    30 
          SB6    X2 
          SA1    A6                WAIT FOR ENTRY TO RESTORE
          VOID
          ZR     X1,PRINT.R2
 PRINT.R2 RJ     PRINT.R3 
 PRINT.R3 DATA   0
          EQ     PRINT.A           RE-TRY PRINT LINE
* 
  
 PRINT.3  SA7    A1                SAVE NEW LINE COUNT
          ZR     B2,PRINT.3A
          SX7    4
          SA7    A1                ALLOW FOR FOOTING
          WRITEC A0,=1L1           IF AUDITFL, JUST REMEMBER PAGE TOP 
          EQ     PRINT
  
 PRINT.3A SA2    PGCNT             INCREMENT PAGE COUNT 
          SX6    X2+B1
          SA6    A2 
          BX1    X6 
          RJ     CONDEC            CONVERT PAGE NUMBER
          LX6    36 
          SA6    PAGENO 
          MX7    0
          SA7    PRCC 
          SB6    TITLE
          SB7    PAGENO+1-TITLE 
 BYPASS   SA3    LLIMIT            CHECK LINE LIMIT (THIS WORD OVERWRIT)
          SA2    JPS
          IX6    X3-X2
          SA6    A3 
          PL     X6,PRINT4
          SA2    A3+B1
          MX7    60                -0 
          BX6    X2 
          SA7    A7                PRCC = -0 FOR LIMIT MESSAGE
          SA6    A3 
          MX7    0
          SA7    LISTHREE 
          SA7    LISTFOUR 
  
 PRINT4   ZR     B7,PRINT          SPECIAL CASE, NULL LINE, TITLE ONLY
          ENV    ACT,(2,3),VER2 
          SA2    WCW               GET LENGTH OF RECORD 
          ZR     X2,PRINT.4        IF NOT W-RECORD
          MX7    0
          SA7    WCW               CLEAR WCW
          SA1    A0+FETFIT
          SA3    X1 
          ZR     X3,PRINT.8C       FILE NOT OPEN
          SX5    B6                FIRST WORD OF RECORD 
          PUTW   X1,X5,X2 
          EQ     PRINT.8C 
 PRINT.4  BSS    0
 VER2     ENDIF 
          SA1    B6 
          MX0    -6 
          SB5    B1 
          MX3    -12
 PRINT.4A BX2    -X0*X1            LOOK FOR EOL 
          ZR     X2,PRINT.4C       FOUND IT - (MAYBE) 
 PRINT.4B EQ     B5,B7,PRINT.5     OUT OF COUNT 
          SA1    A1+B1
          SB5    B5+B1
          EQ     PRINT.4A 
 PRINT.4C BX2    -X3*X1            CHECK 12 BIT EOL 
          ZR     X2,PRINT.5        DEFINITE EOL 
          SA2    A1+B1             LOOK AHEAD 
          NZ     X2,PRINT.4B       NOT EOL - TRAILING COLON 
          SX6    1R          TURN 11 CHARACTER EOL INTO 10 CHARACTER EOL
          BX6    X1+X6
          SA6    A1 
  
 PRINT.5  RJ     SFN= 
          BX1    X6 
 PRINT.6  SA3    =8H               BACK OVER TRAILING BLANKS
          SB7    B5 
 PRINT.6A IX2    X1-X3
          NZ     X2,PRINT.7        GOOD CHARACTER IN THIS WORD
          SB7    B7-B1
          ZR     B7,PRINT.S        WHOLE LINE IS BLANK
          SA1    A1-1 
          EQ     PRINT.6A 
  
 PRINT.7  SB4    B1 
          BX2    X1-X3
          LX2    6
          SX6    10 
 PRINT.7A LX2    60-6              BACK OVER TRAILING BLANKS
          SB4    B4-B1
          BX4    -X0*X2 
          ZR     X4,PRINT.7A
          SX5    B7 
          IX5    X5*X6
          SB5    X5+B4             CHARACTER LENGTH OF LINE (FOR 7000)
          SA3    MODEO
          PL     X3,PRINT.B        CONTINUE WITH ASCII
  
          SX4    X4-1R             CONTINUE WITH 6-BIT
          NZ     X4,PRINT.8 
          SB4    B4+1              ADD SPACE BACK AFTER COLON 
 PRINT.8  SB4    B4+B1
          MX6    0
          GE     B4,B0,PRINT.9     EOL GOES INTO NEXT WORD
          MX0    -12               PUT EOL IN THIS WORD 
          SA5    A1                ORIGINAL WORD
          BX6    X0*X5
 PRINT.8A LX7    X5 
          SA6    A5 
          SA7    PREOL             SAVE EOL WORD FOR LATER RECOVERY 
          ENV    NOT,(2,3),VER2    B7=WORD LENGTH, B5 = CHAR LENGTH 
          WRITEC  A0,B6 
 VER2     ELSE
          SA1    A0+FETFIT
          SA2    X1 
          ZR     X2,PRINT.8B       FILE NOT OPEN
          SX2    B6 
          SX5    B5 
          PUT    X1,X2,X5 
 VER2     ENDIF 
 PRINT.8B SA1    PREOL             RESTORE PRIOR EOL WORD 
          BX7    X1 
          SA7    A5 
 PRINT.8C BSS    0
          SA1    PRCC 
          NZ     X1,PRINT          NO POST SPACE
          PL     X1,PRINT.S 
          SB6    LLMESS            LIMIT MESSAGE
          EQ     PRINT.A           GO AROUND AGAIN
  
 PRINT.S  SA3    MODEO             ALL BLANK LINE 
          SA5    PREOL
          SB7    B1                1 WORD 
          SB5    B1+B1             2 CHARACTERS 
          SX6    2R                DISPLAY CODE BLANKS
          SB6    A5 
          NG     X3,PRINT.S1
          SX6    40B               ASCII BLANK
 PRINT.S1 LX6    60-12
          BX5    X6 
          SA6    PRCC              TURN OFF POST PRINT
          EQ     PRINT.8A          PUT OUT BLANK LINE 
  
 PRINT.9  LE     B4,B1,PRINT.9A 
          SX6    2R         BLANKS MUST FOLLOW TRAILING COLON 
 PRINT.9A SA5    A1+B1
          SB7    B7+B1             INCREASE WORD COUNT
          LX6    60-12
          EQ     PRINT.8A 
          SPACE  2
**
*  HERE WE PROCESS LINES NEEDING ASCII TRANSLATION
          SPACE 
 PRINT.B  SB3    B5+B5             CHARACTER COUNT
          SA5    B6                FIRST WORD TO TRANSLATE
          SB6    LINE              WHERE TO PUT TRANSLATED LINE 
          SB2    B7+B7             NUMBER OF WORDS TO STORE 
          SB4    B4+5 
          GE     B4,B1,PRNT8.1
          SB2    B2-B1             5 BLANKS IN LAST WORD
 PRNT8.1  SB2    B6+B2
          RJ     CONV6TO8          CONVERT TO ASCII 
          LT     B4,B1,PRNT8.2
          SB4    B4-5              -UNUSED CHARACTERS IN LAST WORD
 PRNT8.2  SB6    LINE              NEW START AND COUNT
          SB7    B2-B6
          SB5    B3 
          ZR     B4,PRNT8.3        NO ROOM FOR EOL
          MX0    -18
          BX6    -X0*X7 
          SX6    X6-000040B        PRIOR TO END MUST NOT BE -AT-
          ZR     X6,PRNT8.3        IT IS, KEEP LAST BLANK 
          MX0    -12               PUT EOL IN LAST WORD 
          SA5    A7 
          BX6    X0*X7
          EQ     PRINT.8A 
  
 PRNT8.3  SX6    040B              EOL IN NEXT WORD 
          SA5    A7+B1
          SB7    B7+B1
          LX6    60-12
          EQ     PRINT.8A 
          EJECT 
**        PRNTCARD    PRINT A CARD IMAGE. 
*                     USES MULTIPLE LINES IF NECESSARY, IF THE CARD IS
*                     LONGER THAN 80 CHARACTERS 
* 
*         ENTRY = A0 - FET FWA
          SPACE  2
 PRNTCARD PS     ** 
          SB2    A0-OUTPUT
          NZ     B2,PCRD.0         AUDITFL
          SA1    PRINTED
          NZ     X1,PRNTCARD       CARD ALREADY PRINTED ONCE
          SX6    B1 
          SA6    A1                FLAG CARD NOW PRINTED
          SA6    DPRINT 
 PCRD.0   SA2    MODEO
          PL     X2,PRNTASC        ASCII OUTPUT FILE
          RJ     XCARD             GET DISPLAY CODED CARD IMAGE 
          SX5    B1 
          SA1    CARD 
          ENV    ACT,(2,3),VER2 
          SA2    UCW               LENGTH OF RECORD 
          SX5    X2                WORD COUNT 
          AX2    18 
          SB3    X5-1 
          SB2    X2-59             UBC-59 
          MX6    1
          SA1    A1+B3             PICK UP LAST WORD
          LX6    X6,B2             MASK OF VALID CHARACTERS 
          SA2    =8H
          BX1    X6*X1             PRESERVE VALID CHARACTERS
          BX2    -X6*X2            GET BLANKS 
          BX6    X1+X2             ADD TO VALID CHARACTERS
          SA6    A1                REWRITE WORD 
 VER2     ELSE
          MX0    -6 
          MX3    -12
 PCRD.1   BX2    -X0*X1            COUNT WORDS, LOOK FOR EOL
          ZR     X2,PCRD.1B 
 PCRD.1A  SA1    A1+B1
          SX5    X5+B1
          EQ     PCRD.1 
 PCRD.1B  BX2    -X3*X1            CHECK 12 BIT EOL 
          ZR     X2,PCRD.2         YES
          SA2    A1+B1             IS THIS A COLON
          NZ     X2,PCRD.1A        YES
          SX6    1R                TURN TRAILING ZERO INTO BLANK
          BX6    X1+X6
          SA6    A1 
  
 PCRD.2   NZ     X1,PCRD.2A        LAST WORD GOOD 
          SX5    X5-1              LAST WORD IS ALL TERMINATOR
          EQ     PCRD.3 
 PCRD.2A  RJ     SFN= 
          MX7    0
          SA6    A1 
          SA7    A6+B1       INSURE EOL IN NEXT WORD
 VER2     ENDIF 
 PCRD.3   SX6    X5+7 
          AX6    3
          NZ     X6,PCRD.4
          SX6    1
 PCRD.4   SA6    PCLINES           LINE COUNT FOR CARD
          MX2    60-3 
          BX7    -X2*X5 
          SA7    PCWLL             WORDS IN LAST LINE 
          SB2    A0-OUTPUT
          SA1    LPCNT             OUTPUT LINE COUNT
          ZR     B2,PCRD.5
          SA1    LINCOUNT          AUDITFL LINE COUNT 
 PCRD.5   IX7    X1+X6             UPDATE COUNT 
          SA2    JPS
          SX7    X7-HDRSLOP 
          IX6    X7-X2
          NG     X6,PCRD.6         IT FITS
          SA7    A1 
          PRINT  =0,0,A0           FORCE TITLE
  
 PCRD.6   SA2    DNAME             FIRST LINE STARTS WITH DNAME 
          SA1    CARD              AND CARD START 
 PCRD.7   BX6    X2                HEADER 
          SB3    80/10             WORD COUNT FOR PRINT LINE
          SA6    LINE              WRITE HEADER 
          SA2    PCLINES           NUMBER OF LINES
          SX2    X2-1 
          NZ     X2,PCRD.8         NOT LAST LINE
          SA4    PCWLL             WORD COUNT FOR LAST LINE 
          ZR     X4,PCRD.8         IF FULL LINE 
          SB3    X4 
 PCRD.8   BSS    0
          BX6    X1 
          SB3    B3-B1
          SA6    A6+B1             WRITE WORD 
          SA1    A1+B1             GET NEXT WORD
          NZ     B3,PCRD.8         NOT LAST WORD
          NZ     X2,PCRD.11        NOT LAST LINE
          SB3    X4-8 
          SB3    -B3               REMAINING WORDS TO BLANK 
          SA2    =8H
 PCRD.10  SB3    B3-B1
          BX6    X2 
          SA6    A6+B1
          NZ     B3,PCRD.10 
 PCRD.11  BSS    0
          ENV    NOT,(2,3),VER2 
          MX0    -6 
          BX2    -X0*X6 
          NZ     X2,PCRD.12 
          SA2    A1+B1             POSSIBLE COLON OR EOL
          NZ     X2,PCRD.12        NOT EOL
          SX7    1R                EOL, REPLACE BY BLANK
          BX6    X6+X7
          SA6    A6 
 VER2     ENDIF 
 PCRD.12  SX7    A1                LAST FETCHED WORD
          SA2    PCLINES
          SB7    8+1               WORD COUNT IF NOT LAST LINE
          SA7    PCLNEXT
          SX6    X2-1 
          SA6    A2 
          NZ     X6,PCRD.13        NOT LAST LINE
          SA1    CARD1             CARD IDENT AND ACTIVITY TAGS 
          SB7    B7+4 
          SA2    A1+B1
          BX6    X1 
          SA3    A2+B1
          LX7    X2 
          SA6    LINE+8+1 
          SA4    A3+B1
          SA7    A6+B1
          BX6    X3 
          LX7    X4 
          SA6    A7+B1
          SA7    A6+B1
 PCRD.13  BSS    0
          ENV    ACT,(2,3),VER2 
          SX6    B7 
          SA6    WCW               SET LINE LENGTH
 VER2     ENDIF 
          PRINT  LINE,B7,A0 
          ENV    ACT,(2,3),VER2 
          SX6    0
          SA6    WCW               CLEAR WCW
 VER2     ENDIF 
          SA1    PCLINES
          ZR     X1,PRNTCARD       DONE 
          SA1    PCLNEXT
          SA2    =5H >>>>          NEXT LINES HAVE >>>> START 
          SA1    X1 
          EQ     PCRD.7            PRINT NEXT LINE
          SPACE  2
**
*  PRINT ASCII CARD IMAGES - SIMILAR TO ABOVE 
          SPACE 
 PRNTASC  RJ     XCARD8            ASCII IMAGE CARD 
          SX5    B1 
          SA1    CARD8
          MX0    60-12
 PCAS.1   BX2    -X0*X1            COUNT WORDS, LOOK FOR EOL
          ZR     X2,PCAS.2
          SX5    X5+B1
          SA1    A1+B1
          EQ     PCAS.1 
  
 PCAS.2   SA2    ASCIIBLK 
          RJ     PAD8 
          IX3    X6-X2             CHECK IF LAST WORD IS ALL BLANKS 
          NZ     X3,PCAS.3         LAST WORD IS GOOD
          SX5    X5-1              LAST WORD IS ALL TERMINATOR
 PCAS.3   SX6    X5+15             PREPARE FOR DIVISION WITH UPROUNDING 
          AX6    4
          NZ     X6,PCAS.4
          SX6    1
 PCAS.4   SA6    PCLINES           LINE COUNT FOR CARD
 PCAS.4A  SB2    A0-OUTPUT
          SA1    LPCNT             OUTPUT LINE COUNT
          ZR     B2,PCAS.5
          SA1    LINCOUNT          AUDITFL LINE COUNT 
 PCAS.5   IX7    X1+X6             UPDATE COUNT 
          SA7    A1 
          SA2    JPS
          IX6    X7-X2
          NG     X6,PCAS.6         FITS ON PAGE 
          PRINT  =0,0,A0           FORCE TITLE
          SA1    PCLINES
          BX6    X1 
          EQ     PCAS.4A
  
 PCAS.6   SA5    DNAME             FIRST LINE START 
          SA1    CARD8
 PCAS.7   SB6    LINE 
          SB2    B6+2 
          RJ     CONV6TO8 
          MX0    -12
          SB2    80/5              WORD COUNT FOR PRINT LINE
 PCAS.8   BX3    -X0*X1            MOVE NEXT PART OF CARD IMAGE 
          ZR     X3,PCAS.9         WORD WITH EOL
          LX6    X1 
          SB2    B2-B1
          SA6    B6 
          SB6    B6+B1
          ZR     B2,PCAS.11        EXHAUSTED WORD COUNT 
          SA1    A1+B1
          EQ     PCAS.8 
  
 PCAS.9   RJ     PAD8              FILL OUT EOL WORD
          SA1    ASCIIBLK 
 PCAS.10  SB2    B2-B1
          SA6    B6 
          SB6    B6+B1
          BX6    X1 
          NZ     B2,PCAS.10 
 PCAS.11  SX7    A1                ADDRESS OF LAST FETCHED WORD 
          SA2    PCLINES
          SA7    PCLNEXT
          SX6    X2-1 
          SA6    A2 
          NZ     X6,PCAS.13        NOT LAST LINE
          SA5    CARD1             CARD IDENT AND ACTIVITY TAGS 
          SB2    B6+4*2 
          RJ     CONV6TO8          CONVERT AND ADD TO LINE
  
 PCAS.13  SA1    ASCIIBLK 
          BX6    X1 
          SA6    B6 
 PCAS.14  SA2    B6-B1             BACK OVER WORDS OF BLANKS
          IX3    X1-X2
          SB6    B6-B1
          ZR     X3,PCAS.14        WORD ALL BLANK 
          SB7    B6-LINE+1         WORDS IN LINE
          GE     B7,B1,PCAS.15
          SA2    LINE              OVERRAN, EMPTY LINE
 PCAS.15  BSS    0
          MX0    -12
          BX3    -X0*X2 
          SX3    X3-40B            IS LAST CHARACTER SPACE
          NZ     X3,PCAS.16        NO 
          MX3    -18
          BX3    -X3*X2            LOOK FOR PRIOR -AT-
          SX3    X3-000040B 
          NZ     X3,PCAS.17        NO, CAN KILL SPACE FOR EOL 
 PCAS.16  SA2    A2+1              MUST KEEP LAST CHARACTER 
 PCAS.17  BSS    0
          BX6    X0*X2             SET EOL
          SA6    A2 
          SX5    A2-LINE+1         WORD LENGTH
  
          ENV    NOT,(2,3),VER2 
          WRITEC  A0,LINE 
 VER2     ELSE
          SA1    A0+FETFIT
          SA2    X1 
          ZR     X2,PCAS.18        FILE NOT OPEN
          PUTW   X1,LINE,X5 
 VER2     ENDIF 
  
 PCAS.18  SA1    PCLINES
          ZR     X1,PRNTCARD       DONE 
          SA1    PCLNEXT
          SA5    =5H >>>>          >>>> START FOR NEXT LINES
          SA1    X1+B1
          EQ     PCAS.7 
          EJECT 
**        PRPMOD  PULLMOD PROCESSING                                    01256130
*                                                                       01256131
*         PRPMOD PERFORMS PULLMOD PROCESSING.  EACH PULLMOD             01256132
*         CARD PRODUCES AN ENTRY IN THE PMODS TABLE IN PASS             01256133
*         1.  IN PRPMOD THE CHB STRING FOR EACH CARD IS                 01256134
*         SEARCHED TO DETERMINE WHETHER OR NOT ANY CHB                  01256135
*         APPLIES TO ANY PMODS ENTRY.  A THREADED LIST                  01256136
*         IS BUILT FOR EACH PMODS ENTRY IN MODKEY.  THE                 01256137
*         SQUEEZED CARD IMAGES WHICH BELONG TO EACH COR-                01256138
*         RECTION IDENT WHICH IS RECREATED ARE WRITTEN                  01256139
*         ON UPDTMPMD.  ENTRIES IN MODKEY WHICH REPRESENT               01256140
*         CONTROL CARDS TO BE GENERATED ARE MADE IN DICT                01256141
*         FORMAT SO THAT MANUCARD AND FCORX CAN BE USED TO              01256142
*         GENERATE THE CARD IMAGES.  A SERIES OF BITS                   01256143
*         IN THE PMOD ENTRIES ARE USED TO INDICATE RANGE                01256144
*         PROCESSING SO THAT ONLY ONE INSERT OR DELETE WILL             01256145
*         BE GENERATED FOR A RANGE OF CARDS.                            01256146
*                                                                       01256147
*         CALLS  ADDWORD, CLASSIFY, WBIN, MOVEIT                        01256148
                                                                        01256149
G         IF     DEF,PMODKEY
          SPACE  4
PRPMOD    SA2    CHBTAB 
          SA3    SEQNUM 
          MX0    44 
          LX3    18 
          BX6    -X0*X2            FORM MASK OF CURRENT CARD SEQUENCE 
          BX6    X6+X3             NUMBER AND ORDINAL AND SAVE IT IN
          SA6    CURPRC            CURPRC.
          SB3    X1                B3= LENGTH PMODS 
          SA5    F.PMODS
          SB4    X5                B4= ORIGIN PMODS 
          SB5    A2                B5= ORIGIN CHBS
PRPMOD1   SB3    B3-B1
          NG     B3,PRPMOD9        DONE WITH ALL PULLMODS 
          SA4    LCHBTAB
          SB2    X4-1              B2= LENGTH OF CHBS 
PRPMOD2   SA4    B4+B3
          NG     B2,PRPMOD1        ALL CHBS DONE
          SA2    B5+B2             FETCH CHB
          SB2    B2-B1
          MX0    44 
          BX7    X4-X2
          BX7    -X0*X7            COMPARE CARD WITH PULLMOD ENTRY
          NZ     X7,PRPMOD2        NOT SAME IDENT 
          MX0    42 
          SX6    B2 
          BX6    -X0*X6 
          SX1    B3 
          BX1    -X0*X1 
          LX6    18                SAVE B2 AND B3 IN TEMP 
          BX6    X6+X1
          SA6    TEMP 
          NG     B2,PRPMOD4        THIS IS A MASTER CHB 
          MX5    1
          LX5    59 
          BX6    X4+X5             SET TEMP DELETE BIT
          SA1    L.MODKEY          NEXT POINTER VALUE 
          LX1    18 
          AX4    18                SHIFT TO LAST POINTER
          NG     X4,PRPMOD6        PROCESSING DELETE RANGE
PRPMOD3   SX3    X4          ISOLATE POINTER TO LAST ENTRY
          NZ     X3,PRPMOD7        NOT FIRST MODKEY ENTRY THIS IDENT
          BX6    X6+X1             ADD IN NEW LAST ENTRY
          LX1    18                SHIFT TO FIRST POINTER 
PRPMOD8   BX6    X6+X1             ADD NEW FIRST/LAST POINTER 
          SA6    A4 
          SX0    B1+B1             SET DELETE CODE
          LX2    59-16             SHIFT TO DELETE/RESTORE BIT
          PL     X2,PRPMOD8A       JUMP IF DELETE 
          SX0    6                 RESTORE CODE 
PRPMOD8A  SA4    CURPRC 
          LX0    54 
          BX1    X4+X0             CREATE MODKEY ENTRY TO LOOK LIKE 
          ADDWRD MODKEY,X1         DICT ENTRY 
          ADDWRD MODKEY,X1
 PRPMOD8B SA4    TEMP 
          SB3    X4                RESTORE REGISTERS
          AX4    18 
          SA2    F.PMODS
          SB2    X4 
          SB4    X2 
          SB5    CHBTAB 
          EQ     PRPMOD2           RETURN FOR NEXT ENTRY
          SPACE  1
PRPMOD7   SA1    L.MODKEY          GET NEW POINTER
          SA5    F.MODKEY 
          IX0    X5+X3             GET LAST ENTRY 
          SA5    X0 
          LX1    36 
          BX7    X5+X1             ADD IN NEW POINTER 
          SA7    A5                RESTORE ENTRY
          AX1    18 
          MX0    42 
          LX0    18 
          BX6    X0*X6             REMOVE OLD LAST VALUE
          EQ     PRPMOD8
          SPACE  1
 PRPMOD6  SA3    F.MODKEY 
          SX0    X4          ISOLATE POINTER TO LAST ENTRY
          IX0    X0+X3       GET ADDRESS OF LAST ENTRY
          SA5    X0          FETCH WORD 1 OF LAST ENTRY 
          LX5    59-56
          LX2    59-16
          BX5    X5-X2       COMPARE CODE OF LAST ENTRY AND 
*                            CURRENT CARD 
          LX2    16-59       RESTORE X2 
          MI     X5,PRPMOD3  IF NOT SAME CODE 
          SA1    CURPRC 
          BX7    X1 
          SA7    X0+B1       STORE NEW END OF RANGE IN WORD2 OF ENTRY 
          SA6    A4          STORE EDITED PMODS ENTRY 
          EQ     PRPMOD2
          SPACE  1
PRPMOD4   SB7    B1+B1
          SX0    B1 
          LX0    56 
          BX6    X4+X0             SET TEMP INSERT BIT
          NG     X4,PRPMOD4A       END OF DELETE RANGE
          LX3    X4,B7             SHIFT TO RANGE BIT 
          NG     X3,PRPMOD4A       CONTINUE WITH RANGE PROCESSING 
          CLASIFY 
          CCJUMP   YANK,PRPMOD4B   DO NOT PRODUCE AN INSERT CARD FOR
          CCJUMP   SELYANK,PRPMOD4B YANK CARDS, ETC.
          CCJUMP   YANKDECK,PRPMOD4B
          CCJUMP   DEFINE,PRPMOD4B
          SA2    L.MODKEY          NEW LAST POINTER 
          MX0    42 
          LX0    18 
          MX5    1
          BX7    -X0*X6            GET VALUE OF LAST IN X7, 
          BX6    X0*X6             REMOVE IT FROM X6. 
          LX2    18 
          NZ     X7,PRPMOD4F       NOT FIRST ENTRY THIS IDENT 
          BX6    X6+X2             ADD IN NEW LAST POINTER
          LX2    18 
PRPMOD4C  BX6    X6+X2             ADD IN NEW LAST/FIRST POINTER
          SA6    A4                STORE UPDATED ENTRY
          SA1    F.PMID 
          SA4    L.PMID 
          SB2    X1 
          SB3    X4 
          MX0    44 
          SA2    CURPRC 
          BX6    -X0*X2 
PRPMOD4G  SB3    B3-B1
          NG     B3,PRPMOD4H
          SA1    B2+B3
          BX7    -X0*X1 
          IX4    X7-X6
          NG     X4,PRPMOD4Z
          EQ     PRPMOD4G 
          SPACE  1
PRPMOD4H  SA1    CURPRC 
PRPMOD4Z  BSS    0
          LX5    59 
          BX1    X1+X5             ADD CODE BIT 
          ADDWRD MODKEY,X1         ENTER IN TABLE 
          SA4    TEMP 
          SB3    X4                RESTORE B3 
 THESAME  SA2    F.PMODS
          SA4    X2+B3             GET PMOD ENTRY AGAIN 
          BX6    X4 
PRPMOD4A  SA2    L.MODKEY          FETCH NEW POINTER VALUE
          MX0    42 
          LX2    18 
          LX0    18 
          BX7    -X0*X6            SAVE OLD ENTRY,
          BX6    X0*X6             REMOVE FROM X6.
          SA3    F.MODKEY 
          AX7    18 
          BX6    X6+X2             UPDATE LAST POINTER
          IX1    X3+X7
          LX2    18 
          SA1    X1                FETCH LAST ENTRY IN MODKEY 
          SA6    A4                STORE PMODS ENTRY
          BX7    X1+X2             STORE POINTER IN LAST ENTRY
          SA7    A1 
          SA1    PBIAS             FETCH BIAS OF FILE PTEMP 
          SA2    SQLGN8            CARD IMAGE SIZE
          MX0    60-12
          BX3    -X2
          NZ     X2,PRPMOD4D       8-BIT
          SA2    SQLGN             6-BIT
          LX3    X2 
 PRPMOD4D IX6    X1+X2             INCREMENT BIAS 
          BX2    -X0*X3            SIZE WITH SIGN SET FOR 6/8 
          LX2    24 
          BX1    X1+X2
          SA6    A1 
          ADDWRD MODKEY,X1
          SA4    TEMP 
          SA2    F.PMODS
          SB3    X4 
          AX4    18 
          SB4    X2 
          SB2    X4 
          SB5    CHBTAB 
          SA1    SQLGN8 
          NZ     X1,PRPMOD4E
          SA1    SQLGN
 PRPMOD4E BSS    0
          WRITEW PTEMP,A1+B1,X1 
          EQ     PRPMOD8B 
          SPACE  1
PRPMOD9   SA2    CURPRC 
          SX3    X2 
          SA1    F.PMID 
          SA4    L.PMID 
          SB3    X1 
          SB4    X4 
PRPMOD9A  SB4    B4-B1
          NG     B4,PRPMOD9B
          SA1    B3+B4
          SX1    X1 
          BX1    X1-X3
          NZ     X1,PRPMOD9A
          SA1    L.PMID 
          SB2    X1 
PRPMOD9C  SB5    B4+B1
          EQ     B5,B2,PRPMOD9D 
          SA1    B5+B3
          BX6    X1 
          SB4    B4+B1
          SA6    A1-B1
          EQ     PRPMOD9C 
          SPACE  1
PRPMOD9D  BX6    X2 
          SA6    B4+B3
          EQ     PRPMOD9E 
          SPACE  1
PRPMOD9B  BX1    X2 
          ADDWRD PMID,X1
 PRPMOD9E SA1    F.PMID 
          SA2    L.PMID 
          SB2    X2-1 
          SA1    X1+B2
          SA2    F.DIRECT 
          IX2    X1+X2
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X2 
S2LCM     ELSE
          SX2    X2                FETCH
          RX2    X2                      DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          MX7    54 
          BX7    X7*X2
          RJ     CHKDCKS
          NZ     X0,PRPMOD9F
          MX7    0
          SA7    L.PMID 
          SA1    CURPRC 
          ADDWRD PMID,X1
PRPMOD9F  SA1    L.PMODS
          SB3    X1-1 
          SA3    F.PMODS
          SB4    X3 
          SA1    CURPRC 
          MX3    42 
          BX1    -X3*X1 
PRPMOD10  NG     B3,PMODEND        QUIT WHEN ALL ENTRIES DONE 
          SA2    B4+B3             FETCH ENTRY
          BX4    -X3*X2 
          IX4    X4-X1
          NG     X4,PRPMOD19
          MX0    1
          LX0    57                SHIFT TO MASK TEMP INSETT BIT
          BX7    X0*X2             GET TEMP INSERT BIT
          BX2    -X0*X2            REMOVE BIT FROM ENTRY
          LX0    1
          BX2    -X0*X2            REMOVE OLD PERM INSERT BIT 
          LX7    1
          BX2    X7+X2             ADD IN TEMP INSERT BIT IN PLACE OF 
          LX0    1                 PERM BIT 
          BX7    X0*X2             FETCH TEMP DELETE BIT
          BX2    -X0*X2            REMOVE BIT FROM ENTRY
          LX0    1
          BX2    -X0*X2            REMOVE OLD PERM DEL BIT
          LX7    1
          BX7    X7+X2             ADD IN NEW TEMP BIT AS PERM BIT
          SA7    A2 
PRPMOD19  SB3    B3-B1
          EQ     PRPMOD10          TRY NEXT 
          SPACE    1
PRPMOD4B  MX0      42              IF FIRST ENTRY FOR THIS IDENT IN 
          LX0      36              MODKEY TABLE SET START INDEX IN
          BX7      -X0*X6          PMODS ENTRY. 
          NZ       X7,PRPMOD4A
          SA2      L.MODKEY 
          LX2      36 
          BX6      X6+X2
          EQ       PRPMOD4A 
          SPACE  1
PRPMOD4F  AX7    18 
          LX2    18 
          SA1    F.MODKEY 
          SB7    X1                FETCH LAST ENTRY IN MODKEY 
          SA1    X7+B7
          BX7    X1+X2             SET LINK FIELD 
          SA7    A1 
          AX2    18 
          EQ     PRPMOD4C 
G         ENDIF 
          SPACE  4                                                      01256151
**        PROCINS  PROCESS INSERTS                                      01256152
*                                                                       01256153
*         PROCINS IS CALLED FROM INSERT PROCESSING WHEN                 01256154
*         AN ENTRY IN TDICT IS FOUND FOR WHICH A CARD MIGHT             01256155
*         BE INSERTED FOR UPDTEXT.  IF THE CARD COUNTER                 01256156
*         IN WORD 3 OF THE ENTRY INDICATES THAT NO CARDS                01256157
*         ARE TO BE INSERTED, THE ENTRY IS REMOVED FROM                 01256158
*         TDICT AND PROCINS EXITS NORMALLY.  IF CARDS ARE               01256159
*         TO BE INSERTED PROCINS EXITS TO ECOR6.                        01256160
*                                                                       01256161
*         CALLS  MOVEIT                                                 01256162
          SPACE  1
PROCINS   BSS    1
          SA2    A4+2              FETCH THIRD WORD OF ENTRY
          AX2    18 
          SB5    X2                NUMBER OF TEXT CARDS TO BE INSERTED
          NZ     B5,ECOR6          JUMP IF THERE ARE INSERTS
          SX2    A4+3              SOURCE FOR MOVE TO SQUEEZE OUT ENTRY 
          SX3    A4                DESTINATION
          SA4    F.TDICT
          IX7    X4-X2
          SA5    L.TDICT
          SX6    X5-3 
          SA6    A5                REDUCE TABLE LENGTH
          IX1    X7+X5             NUMBER OF WORDS TO MOVE
          MOVE   X1,X2,X3 
          EQ     PROCINS           EXIT 
          SPACE  4
**        PUTNEXC  PUT CHARACTER                                        01256164
*                                                                       01256165
*         THIS ROUTINE IS THE COUNTER PART OF GETNEXC.                  01256166
*         X6 IS USED TO BUILD A WORD.  B5 CONTAINS THE                  01256167
*         NUMBER OF CHARACTERS FOR WHICH SPACE IS STILL                 01256168
*         AVAILABLE IN X6.  B4 CONTIANS 10.  WHEN X6 IS                 01256169
*         FULL, IT IS STORED AT A6+1.                                   01256170
*                                                                       01256171
                                                                        01256172
 PUTNEXC1 LX6    6
          SB5    B5-B1
          BX6    X6+X2
 PUTNEXC  PS
          NZ     B5,PUTNEXC1
          SA6    A6+B1             WORD FULL
          MX6    0
          SB5    10 
          EQ     PUTNEXC1 
          EJECT  4                                                      01256174
**        RDW=   READ WORDS FROM FILE  (7000 ONLY)
* 
*         RDW= IS THE BINARY READ ROUTINE.  IT READS B7 
*         WORDS FROM FILE X2 INTO LOCATIONS STARTING AT 
*         B6.  IF AN END OF RECORD IS ENCOUNTERED, X1 WILL              01256179
*         IF NON-ZERO ON EXIT.                                          01256180
* 
*         FOR 6000 OPERATING SYSTEMS, THE COMCRDW ROUTINE IS USED 
*                                                                       01256181
*         ENTRY  X2 - FET FWA 
*                B2 - NON-ZERO IF B6 POINTS TO LCM ADDRESS (SCOPE 2)
*                B6 - FWA OF AREA READ INTO                             01256183
*                B7 - NUMBER OF WORDS TO BE READ                        01256184
*                                                                       01256185
*         EXIT   X1 - ZERO IF NO EOR OR EOF ENCOUNTERED 
*                                                                       01256187
*         REGISTERS SAVED - A0, B2, X2, A5, X5
*                                                                       01256189
          SPACE  2
          ENV    ACT,(2,3),VER2 
 RDW=     PS     ** 
          ZR     B7,RBINOK
          SA1    X2+FETFIT
          SA3    X1 
          ZR     X3,RDW=
 RBIN8    BSS 
          SA1    X2+FETLCMF 
          SA3    X2+FETOUT
          SX6    X3          OUT
          SA4    X2+FETIN 
 RBIN10   BSS 
          IX7    X6-X4       OUT-IN 
          ZR     X7,RBIN14   EMPTY BUFFER 
          NZ     X1,RBIN11         IF IN LCM
          SA3    X6 
          BX7    X3 
          EQ     RBIN12 
RBIN11    RX7    X6                READ FROM LCM
RBIN12    BSS    0
          EQ     B2,RBIN13         JUMP IF SCM TABLE
          SX0    B6 
          WX7    X0 
          EQ     RBIN13A
RBIN13    BSS    0
          SA7    B6 
RBIN13A   BSS    0
          SX6    X6+B1
          SB6    B6+B1
          SB7    B7-B1
          NE     B7,RBIN10
          SA6    X2+FETOUT
 RBINOK   BSS 
          MX1    0
          EQ     RDW= 
          SPACE  2
 RBIN14   BSS 
          SA6    X2+FETOUT
          SA3    X2 
          LX3    59-4 
          NG     X3,RBIN20   EOF OR EOR 
          SB4    A5          SAVE A5
          BX6    X5 
          SA6    TEMP4       SAVE X5
          SB3    A0                *KLUDGE* UNTIL READ76 CAN BE 
          SA0    X2                *
          RJ     READ76 
          SX2    A0                *
          SA0    B3                *
          SA5    B4          RESTORE A5 
          SA3    TEMP4
          BX5    X3          RESTORE X5 
          ZR     X1,RBIN8 
 RBIN20   BSS 
          SA3    X2 
          LX3    59-3 
          SX1    B6 
+         PL     X3,*+1 
          SX1    -1                END OF FILE
          SA3    X2+B1
          SX6    X3 
          SA6    A3+B1
          SA6    A6+B1
          EQ     RDW= 
 VER2     ENDIF 
          SPACE  4
**        RDWC=  READ WORDS FROM CHECKSUMMED LIBRARY
* 
*         RDWC= IS THE SAME FUNCTIONALLY AS RDW=, EXCEPT THAT WORDS 
*         READ THROUGH RDWC= ARE SCANNED, THE ON BITS TOTALLED, 
*         AND THE TOTAL ADDED TO TDCHSUM.  READW IS USED TO 
*         PERFORM THE ACTUAL READ.
* 
*         ENTRY  X2 - FET FWA 
*                B2 - NON-ZERO IF B6 POINTS TO LCM ADDRESS (SCOPE 2)
*                B6 - FWA OF AREA TO BE READ INTO                       01256200
*                B7 - NUMBER OF WORDS TO BE READ                        01256201
*                                                                       01256202
*         REGISTERS SAVED - A0, X2, A5, X5
          SPACE  1
 RDWCX    RJ     RDW= 
 RDWC=    PS     ** 
          SA1    RJRBIN 
          ZR     B7,RDWCZ          ZERO COUNT 
          NZ     X1,RDWCX 
          SX6    B6                SAVE LENGTH AND DESTINATION
          SX7    B7 
          LX6    18 
          BX7    X6+X7
          SA7    TCRBIN 
          RJ     RDW= 
          SA4    TCRBIN 
          SB5    X4                LENGTH 
          AX4    18 
          SB4    X4                FWA
          SB5    B5-B7             ACTUAL AMOUNT TRANSFERRED
          ZR     B5,RDWC=          ZERO LENGTH
          SA4    RDCHSUM
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA3    B4 
          BX6    X4 
 RBINC1   CX3    X3                COUNT BITS IN WORDS
          SB5    B5-B1             JUST READ
          IX6    X6+X3
          SA3    A3+B1
S2LCM     ELSE
          BX6    X4 
RBINC1    EQ     B2,RBINC2         JUMP IF SCM TABLE
          SX3    B4                READ 
          RX3    X3                 LCM.
          EQ     RBINC3 
  
 RBINC2   SA3    B4 
 RBINC3   CX3    X3                COUNT BITS IN WORD 
          SB5    B5-B1             JUST READ
          IX6    X6+X3
          SB4    B4+B1
S2LCM     ENDIF 
          SPACE  1
          NZ     B5,RBINC1
          SA6    A4 
          EQ     RDWC=
  
 RDWCZ    MX1    0                 ZERO WORD READ IS ALWAYS OK
          EQ     RDWC=
          EJECT  4                                                      01256207
**        RDC=   READ WORDS UNTIL ZERO BYTE (7000 ONLY) 
* 
*         RDC= FUNCTIONS AS RDW= EXCEPT THAT WORDS ARE READ UNTIL A 
*         ZERO BYTE OR E-O-R IS ENCOUNTERED.  B7 WORDS ARE QUARANTEED   01256211
*         UNLESS AN E-O-R IS ENCOUNTERED.  IF B7 WORDS ARE READ         01256212
*         BEFORE A ZERO BYTE IS FOUND, ANY REMAINING WORDS UP TO        01256213
*         THE ZERO BYTE OR E-O-R ARE DISCARDED.  IF A ZERO BYTE         01256214
*         IS FOUND, DATA TRANSFER IS STOPPED. 
* 
*         FOR 6000 OPERATING SYSTEMS  COMCRDC  IS USED. 
*                                                                       01256217
*                                                                       01256218
*         ENTRY  X2 - FET LOCATION
*                B6 - FWA OF DATA                                       01256220
*                B7 - WORD COUNT                                        01256221
*                                                                       01256222
*         EXIT   X1 - NON ZERO IF EOR ENCOUNTERED                       01256223
*                                                                       01256224
*         REGISTERS SAVED - A0, X2, A5, X5
          SPACE  2
  
 RDC0     SX6    55B
          SX4    54 
          LX6    60-6 
          LX4    18 
          SA6    B6                SET NULL RECORD TO 1 BLANK 
          SX6    1
          BX6    X4+X6
          SA6    WCW               INDICATE 1 CHARACTER RECORD
          SA6    UCW
          ENV    ACT,(2,3),VER2 
 RDC=     PS     ** 
          SA1    X2+FETFIT
          SX6    B6 
          SX7    B7 
          GETW   X1,X6,X7,RDECEOD 
          SB2    X7                WORD COUNT 
          LT     B7,B2,RDEC2       MORE READ THAN WANTED
          SB7    B2                ACTUAL READ
 RDEC2    MX6    0
          SA6    B6+B7             MANDATORY TERMINATOR 
          MX1    0
          ZR     B2,RDC0           NO DATA
          SB7    B7-B1
          SA4    B6+B7             LAST WORD READ 
          SA7    WCW               SAVE W CTL WORD
          SA7    UCW               ALSO SET UCW 
          AX7    18 
          SB4    X7                UNUSED BIT COUNT 
          ZR     B4,RDEC3          UBC=0
          SB4    B4-59
          MX6    1
          LX6    B4 
          BX6    X4*X6             ZERO UBC BITS
          SA6    A4 
 RDEC3    MX1    0                 DONE 
          EQ     RDC= 
          SPACE  2
 RDECEOD  NO
+         FETCH  X1,FP,X3 
          MX7    0
          SA7    WCW               CLEAR WCW SINCE NO RECORD READ 
          AX3    5
          SA4    X2 
          MX6    42 
          BX6    X6*X4
          SX4    21B
+         ZR     X3,*+1 
          SX4    X4+10B            EOF
+         BX6    X6+X4
          SA6    X2 
          SX1    B6 
          ZR     X3,RDC=           IF EOR 
 RDECEOF  BSS 
          MX1    59 
          EQ     RDC= 
VER2      ENDIF 
  
          EJECT  4                                                      01256229
**        RDCMPSCR  READ CARD FROM SCRATCH FILE                         01256230
*                                                                       01256231
*         THIS ROUTINE READS A CARD IMAGE FROM THE SCRATCH              01256232
*         FILE UPDTSCR EXPANDS THE SQUEEZED CARD AND SETS APPROPRIATE   01256233
*         POINTERS BY CALLING CLASSIFY.                                 01256234
*                                                                       01256235
*         CALLS  RBIN, CLASSIFY                                         01256236
                                                                        01256237
RDCMPSCR  BSS    1
          READW  UPDTSCR,SQLGN,1
          NZ     X1,RDCMPSCR
          SX7    B0+
          SA7    SQLGN8            DISCARD OLD 8-BIT LINE 
          SA5    SQLGN
          PL     X5,RDCMP1
          BX6    -X5
          MX7    0
          SA6    SQLGN8 
          SA7    A5 
          SA5    A6 
 RDCMP1   BSS    0
          SX6    X5 
          LX5    30 
          SX7    X5 
          SA6    A5 
          SA7    CURCARD
          ZR     X6,RDCMP2         NULL CARD
          READW  X2,A5+B1,X6
 RDCMP2   READW  X2,CARDID,1
          MX6    0
          SA6    CARD 
          SA6    CARD8
          SA6    PRINTED
          SA1    CURCARD
          ZR     X1,RDCMPSCR
          SB4    SPARLIST 
          RJ     CLASSIFY 
          MX1    0
          EQ     RDCMPSCR 
          EJECT  4                                                      01256239
**        READOPL  READ OLD STYLE PL                                    01256240
*                                                                       01256241
*         READOPL IS THE SUBROUTINE WHICH READS CARDS FROM THE OLDPL    01256242
*         IF THE OLDPL IS A PRE-VERSION 1.2 LIBRARY.  IF BEFFLAG IS     01256243
*         NON-ZERO IT CONTAINS A COUNT OF THE CARD IMAGES WHICH HAVE    01256244
*         BEEN SAVED IN THE SVCRD STACK AND RESEBEF IS CALLED TO        01256245
*         RESTORE THE LAST ENTRY MADE IN THE STACK.  IF BEFFLAG         01256246
*         IS ZERO THE NEXT CARD IS TO BE READ FROM THE OLDPL.  IF FAST  01256247
*         IS NON-ZERO, THE READ IS SKIPPED UNTIL ONE MORE PASS IS MADE  01256248
*         THROUGH THE MAIN LOOP TO PROCESS INSERTS.  ONE WORD IS READ   01256249
*         FROM THE OLDPL.  IF AN END OF RECORD IS ENCOUNTERED,          01256250
*         READOPL EXITS WITH X1 NON-ZERO TO INDICATE THIS.  THE WORD    01256251
*         JUST READ SHOULD BE A PREFIX WORD CONTAINING A WORD COUNT, AND01256252
*         A MASTER CHB.  THE WORD COUNT IS VALIDATED SINCE AN INCORRECT 01256253
*         COUNT WOULD RESULT IN UPDATE LOSING ITS PLACE ON THE OLDPL.   01256254
*         THE COUNT CANNOT BE NEGATIVE OR LARGER THAN THE MAXIMUM       01256255
*         EXPANDED CARD LENGTH+2.  IF THE FIRST WORD IS VALID, READOPL  01256256
*         THEN READS ANY ADDITIONAL PREFIX WORDS AND THE CARD IMAGE.    01256257
*         CORRECTION HISTORY BYTES ARE STORED ONE PER WORD BEGINNING    01256258
*         AT CHBTAB.  IF THE OLDPL DOES NOT SUPPORT THE 00B CHARACTER   01256259
*         AND UPDATE HAS BEEN ASSEMBLED TO SUPPORT IT, CONULINE IS      01256260
*         CALLED TO CONVERT ANY 0001 SHORTHAND ENTRIES INTO 5555B.  THE 01256261
*         APPROPRIATE ENTRY IN CNTR IS UPDATED TO INDICATE THE SEQUENCE 01256262
*         NUMBER OF THE NEW CARD.                                       01256263
*                                                                       01256264
*         CALLS  RESBEF, RBIN, CONVLINE                                 01256265
                                                                        01256266
A         IF     DEF,OLDPLKEY 
READOPL   PS
          SPACE  1
NOTBEF    BSS    0
          SA1    FAST 
          NZ     X1,RESETFF 
          READW  OLDPL,TEMP1,1
          NZ     X1,READOPL        THIS OLDPL READ ROUTINE IS SIMILAR 
          SA1    TEMP1             TO -ROPL- EXCEPT THAT IT IS SET UP 
          BX6    X1                TO READ AN OLDPL IN PRE-3.3 FORMAT.
          LX1    24                SHIFT TO SQLGN 
          SB4    CHBTAB 
          SX7    X1                X7 CONTAINS WORD COUNT FOR SQLGN 
          MX0    43                CHB MASK 
          NG     X7,READERR 
          SB3    X7-10
          PL     B3,READERR 
          SA7    SQLGN
          SB2    B1                2 CHB IN THIS WORD.
          MX7    0
          SA6    CARDSTAT          STATUS FROM LIBRARY. 
          SA7    CARD 
          SA7    CARD8
          SA7    SQLGN8 
          SA7    PRINTED
          SA6    A6+B1
RDOPL1    LX1    18                SHIFT TO CHB.
          BX6    -X0*X1            ISOLATE CHB. 
          SB2    B2-B1             DECREMENT CHB/WORD COUNT.
          ZR     X6,RDOPL2         END IF ZERO CHB. 
          SA6    X7+B4             STORE NEXT CHB 
          SX7    X7+B1             INCREMENT CHB INDEX. 
          PL     B2,RDOPL1         LOOP IF MORE CHB-S IN WORD.
          SA7    LCHBTAB           ELSE FETCH NEXT WORD.
          READW  OLDPL,TEMP1,1
          NZ   X1,RDOPLER                                               1604   5
          SA1    TEMP1             RE-ESTABLISH REGISTERS AND LOOP
          SA4    LCHBTAB           TO PROCESS NEXT WORD OF CHB-S. 
          LX1    6
          SB2    B1+B1
          MX0    43 
          BX7    X4 
          EQ     RDOPL1 
          SPACE  1
RDOPL2    SA1    SQLGN             FETCH CARD IMAGE LENGTH. 
          SX3    X7-L.CHB 
          SA7    LCHBTAB           STORE CHB TABLE LENGTH.
          PL     X3,TOOMUCH2
          ZR     X1,RDOPL3         NULL CARD
 TMRET2   READW  OLDPL,A1+B1,X1    READ REST OF CARD
 RDOPL3   NZ     X1,RDOPLER 
          SPACE  1
          IF     DEF,CHAR64,1 
          RJ     CONVLINE 
          IFNE   IP.CSET,IP.C63,1 
          RJ     CONV63 
          SA3    CHBTAB            FIND THE CELL WITHIN -CNTR-
          MX0    44                WHICH HOLDS THE SEQUENCE COUNT 
          BX3    -X0*X3            FOR THIS IDENT. INCREMENT THAT 
          SA2    F.CNTR            COUNT BY ONE AND STORE IT IN 
          IX6    X3+X2              -SEQNUM-
          SA3    X6 
          SX7    X3+B1
          NG     X7,SEQERR         JUMP IF SEQUENCE NUMBER IS TOO BIG 
          SA7    A3 
          SA7    SEQNUM 
          SX1    0           CLEAR EOR FLAG 
          EQ     READOPL
A         ENDIF 
                                                                        1604   9
RDOPLER   SA1    ERRMODE           JUMP IF NOT U MODE                   1604  10
          ZR   X1,ROPLE                                                 1604  11
          SA1    LISTONE           PRINT ERROR MESSAGE                  1604  12
          ZR   X1,READOPL                                               1604  13
          PRINT  (0*** PREMATURE END OF RECORD ON OLD PROGRAM LIBRARY **1604  14
,*)                                                                     1604  15
          EQ   READOPL             AND CONTINUE                         1604  16
          EJECT  4                                                      01256269
**        RECOV  READ ERROR RECOVERY                                    01256270
*                                                                       01256271
*         RECOV IS ENTERED WHEN UPDATE IS PROCESSING A VERSION 1.2 OLDPL01256272
*         AND AS THE RESULT OF A PARITY ERROR OR OTHER READ ERROR THE   01256273
*         POSITION OF THE OLDPL IS UNCERTAIN AND U MODE AS BEEN         01256274
*         SELECTED.  EACH WORD ON THE OLDPL IS SCANNED IN AN ATTEMPT TO 01256275
*         FIND THE BEGINNING OF THE NEXT VALID CARD.                    01256276
*                                                                       01256277
*         CALLS  PRINT, UCARD, ADDID, RBIN                              01256278
          SPACE  4
RECOV     SA1    TEMP              SEARCH DOWN OLDPL FOR NEXT 
          MX0    48                CARD IMAGE.
          LX1    18 
          BX2    -X0*X1 
          AX0    6
          LX1    6
          BX3    -X0*X1 
          NZ     X2,RECOV1
          ZR     X3,RECOV1
          SX4    X3-SQLSIZE-2 
          PL     X4,RECOV1
          SA2    ERRORS 
          SX6    X2+B1
          SA6    A2 
          SA1    LISTONE
          ZR     X1,RECOV2
          PRINT  =1L,1
          PRINT  ( *** OLDPL READ ERROR - ATTEMPTING RECOVERY 
,    ***) 
RECOV2    SA1    ROPL 
          SA2    ERRET
          BX6    X1 
          LX7    X2 
          SA6    A2+B1
          SA7    A1 
          SA1    TEMP 
          JP     ROPLREC
          SPACE  1
ERRET     EQ     ERRGO+1
          SPACE  1
ERRGO     PS
          SA2    LISTONE
          ZR     X2,ERRGO 
          RJ     ADDID
          PRINT  (0*** READ RECOVERED - DATA LOST BEFORE THE FOLLOWING L
,INE ***) 
          PRINT  =1L,1
          MX6    0
          SA6    PRINTED
          PRNTCARD
          MX1    0
          EQ     ERRGO
          SPACE  1
 RECOV1   READW  OLDPL,TEMP,1 
          ZR     X1,RECOV 
          SA1    TEMP 
          EQ     ROPL3A 
          EJECT  4                                                      01256280
**        RESBEF RESTORES SAVED CARD                                    01256281
*                                                                       01256282
*         RESBEF OPERATES THE REVERSE OF SAVECARD (SEE SAVECARD         01256283
*         FOR DETAILS).  ENTRY IS MADE BY A RETURN JUMP WITH THE CONTENT01256284
*         OF BEFFLAG IN X1.  BEFFLAG CONTAINS THE NUMBER OF CARDS WHICH 01256285
*         HAVE BEEN STORED IN SVCRD.  THE TOP CARD IS TAKEN FROM THE    01256286
*         SVCRD STACK AND SET BACK IN SQIMAGE WITH ALL APPROPRIATE      01256287
*         FLAGS SET UP.                                                 01256288
*                                                                       01256289
*         CALLS  MOVEIT, PAD                                            01256290
                                                                        01256291
RESBEF    PS
          SX6    X1-1 
          SA6    A1 
          SA1    F.SVCRD
          SA2    X1 
          BX6    X2 
          LX7    X2,B1
          MX0    2
          BX7    X0*X7
          LX3    X7,B1
          MI     X3,RESBF1   IF NOT AN INSERTED CARD
          MX6    0
RESBF1    SA6    CARDSTAT 
          SA7    CURSTAT
          MX0    52                RESTORE ALL OF THE ITEMS THAT
          AX2    23                SAVECARD SAVED 
          BX6    -X0*X2 
          AX2    8
          BX7    -X0*X2 
          SB2    X6                LINE LENGTH
          SA7    LCHBTAB
          AX2    8
          SX6    X2 
          SA6    SEQNUM 
          SA3    A2+B1
          MX0    1
          BX0    X0*X3
          LX0    56 
          SA3    CARDSTAT 
          BX6    X3+X0
          SA6    A3                RESTORE YANKDECK BIT 
          SA3    CURSTAT
          BX6    X3+X0
          SA6    A3 
RESLP     SX7    X7-1 
          SA2    A2+B1             RESTORE CHBS 
          SX6    X2 
          SA6    X7+CHBTAB
          NZ     X7,RESLP 
          SX6    B2 
          MX7    0
          SB2    B2-1S7 
          NG     B2,RESM6          6-BIT CARD 
          SX6    B2                8-BIT CARD 
          SA7    SQLGN
          SA6    SQLGN8 
          EQ     RESMV
 RESM6    SA6    SQLGN
          SA7    SQLGN8 
 RESMV    SB2    X6 
          MOVE   B2,A2+B1,A6+B1 
          SX1    B2 
          SA2    LCHBTAB
          IX0    X1+X2
          SX0    X0+B1
          SA1    F.SVCRD
          SA2    L.SVCRD
          IX6    X1+X0
          IX7    X2-X0
          SA6    A1 
          SA7    A2 
          SA3    BEFFLAG
          SA1    L.TDICT
          SA2    F.TDICT           TURN ON ANY MODS DEACTIVATED BY THIS 
          SA2    X2                CARD STORE 
          SX0    X3+B1
RESBEFR   ZR     X1,RESBEFS 
          SX1    X1-3 
          BX6    X2-X0
          SA2    A2+3 
          NZ     X6,RESBEFR 
          SA6    A2-3 
          EQ     RESBEFR
          SPACE  1
RESBEFS   SA1    IDFLG
          RJ     SFN= 
          LX6    54 
          SA6    DNAME
          MX7    0
          SA7    CARD 
          SA7    CARD8
          SA7    PRINTED
          MX1    0
          EQ     RESBEF 
          EJECT  4                                                      01256293
**        RESEQ                                                         01256294
*                                                                       01256295
*         RESEQ IS CALLED FOR EACH CARD BEFORE IT IS WRITTEN TO ANY     01256296
*         OUTPUT FILE IF ANY DECK IS TO BE RESEQUENCED IN THIS RUN.     01256297
*         ON ENTRY, X3 CONTAINS THE CONTENTS OF TSEQFLAG.  THIS CELL    01256298
*         IS USED AS A FLAG TO SPECIFY WHETHER OR NOT ANY               01256299
*         RESEQUENCING IS TO BE DONE IN THIS RUN.  IF TSEQFLAG IS ZERO, 01256300
*         RESEQ IS NEVER ENTERED.  IF IT IS NON-ZERO, IT CONTAINS THE   01256301
*         NEXT SEQUENCE NUMBER TO BE ASSIGNED TO THE RESEQUENCED        01256302
*         DECK.  ONLY ACTIVE CARDS ARE SEQUENCED, INACTIVE CARDS ARE    01256303
*         PURGED AT THIS POINT AND RESEQ EXITS TO ECOR1, SKIPPING THE   01256304
*         CALLS TO THE OUTPUT ROUTINES.  SEQFLAG CONTAINS THE DIRECT-   01256305
*         ORY ORDINAL OF THE IDENT TO BE USED FOR RESEQUENCING.  RESEQ  01256306
*         SETS UP THE NEW MASTER CHB AND SAVES THE OLD ONE AND SEQUENCE 01256307
*         NUMBER IN SQRESFLG SO THAT IT MAY BE RESTORED AFTER THE       01256308
*         CURRENT CARD HAS BEEN WRITTEN TO THE VARIOUS                  01256309
*         OUTPUT FILES.  THIS MUST BE DONE BECAUSE CORRECTIONS REFER    01256310
*         TO THE OLD SEQUENCE NUMBERS.                                  01256311
*                                                                       01256312
*         CALLS  UCARD, ADDID, PRINT                                    01256313
          SPACE  1
RESEQ     SA2    CARDSTAT 
          PL     X2,RESEQ1
          SA1    SEQFLAG
          SX6    X1+200000B 
          SA2    CHBTAB 
          SA6    A2 
          SX7    B1 
          BX6    X3 
          SA7    LCHBTAB
          SX7    X3+B1
          NG     X7,SEQERR   IF SEQUENCE NUMBER IS TOO BIG
          SA4    SEQNUM 
          LX2    30 
          SA7    A3 
          SA6    A4 
          BX7    X4+X2
          SA7    SQRESFLG 
          SA5    LISTHREE 
          ZR     X5,NOSEQ 
          RJ     ADDID
          SA1    =10H  SEQ
          BX6    X1 
          SA6    CARD3
          PRNTCARD
          EQ     NOSEQ
          SPACE  1
RESEQ1    SA1    LISTHREE 
          ZR     X1,ECOR1 
          SA1    =10H       P 
          BX6    X1 
          SA6    CARD3
          RJ     ADDID
          PRNTCARD
          EQ     ECOR1
          SPACE  2
RECURERR  SX6    X1+B1             STORE INCREASED BEFFLAG IN 
          SA6    A1                CASE IN U MODE 
          MESSAGE RCMES      ISSUE MESSAGE
          SA1    ERRMODE
          ZR     X1,ABORT          ABORT IF NOT U MODE
          SA2    ERRORS 
          SX6    X2+B1             INCREASE ERROR COUNT 
          SA6    A2 
          EQ     SVCD2             CONTINUE IF U MODE 
          EJECT  4                                                      01256315
**        ROPL   READ OLDPL TO GET A NEW CARD                           01256316
*                                                                       01256317
*         ROPL IS SIMILAR IN FUNCTION TO READOPL.  READOPL READS        01256318
*         PRE-VERSION 1.2 LIBRARIES, ROPL READS VERSION 1.2 LIBRARIES.  01256319
*         BOTH ROUTINES CALL RESBEF IF THE NEXT CARD IS TO BE READ FROM 01256320
*         THE STACK INSTEAD OF THE OLDPL.  ROPL, READOPL, AND RESBEF    01256321
*         ARE RESPONSIBLE FOR SETTING UP SQLGN, SQIMAGE, CHBTAB, SEQNUM,01256322
*         CARDSTAT, CURSTAT.  THERE ARE OCCASIONS IN Q MODE WHERE THE   01256323
*         NEXT CALL TO THE OLDPL READ ROUTINE SHOULD NOT RESULT IN A    01256324
*         CARD BEING READ, BUT SHOULD RESULT IN SKIP MODE BEING ENTERED.01256325
*         IN THESE CASES FAST WILL BE SENT NON-ZERO FLAG IS CLEARED     01256326
*         AND SKIP MODE ENTERED IF ALL PROCESSING HAS NOT BEEN COMPLETED01256327
*         THIS ROUTINE EXITS IN ONE OF THREE WAYS                       01256328
*                1.  THROUGH ABORT IF OLDPL ERROR DETECTED              01256329
*                2.  THROUGH ROPL WITH X1 NON-ZERO IN CASE OF EOR       01256330
*                3.  THROUGH ROPL FOLLOWING NORMAL READ WITH FOLLOWING  01256331
*                    CELLS SET UP                                       01256332
*         SEQNUM = SEQUENCE NUMBER OF CARD
*         SQIMAGE = SQUEEZED CARD IMAGE 
*         SQLGN = LENGTH OF SQUEEZED CARD 
*         CHBTAB  CORRECTION HISTIORY BITES 
*         LCHBTAB = COUNT OF CHBTAB 
*                                                                       01256334
*         CALLS  RBIN, CALLPP, RESBEF, RBINC, PRINT, CONVLINE           01256335
          SPACE  1
RESETFF   MX6    0                 RESET FLAG -FAST-
          SA6    A1 
          SA6    BEFFLAG           ALSO RESET BEFORE FLAG 
          SA1    WORKLGTH 
          NZ     X1,ECOR31         OTHER DECKS TO DO
          SA1    L.TDICT
          ZR     X1,CHEKMODE  ALL MODS DONE 
          EQ     ECOR1
          SPACE  1
 ROPL3    READW  OLDPL,TEMP,1 
          ZR     X1,RECOV 
          SA1    TEMP1
ROPL3A    CX0    X1 
          SA2    RDCHSUM           SUBTRACT THE LAST WORD FROM CHECKSUM.
          IX2    X2-X0
          BX0    X2-X1
          MX6    1
          SA6    CARDSTAT 
          ZR     X0,ROPL           IF THEY ARE THE SAME.
          MESSAGE (=C+*** WARNING *** OLDPL CHECKSUM ERROR ***+)
          SA1    LISTONE
          ZR     X1,ROPL3B         LIST OPTION ONE OFF
          PRINT  (0*** WARNING *** OLDPL CHECKSUM ERROR ***)
 ROPL3B   BSS 
          SA2    ERRORS            INCREMENT FATAL ERROR COUNT. 
          SX6    X2+B1
          SA6    A2 
          EQ     ABORT
ROPL      PS
          SX6    B0 
          MX7    0
          SA6    CARD 
          SA7    CARD8
          SA6    SQLGN
          SA7    SQLGN8 
          SA6    PRINTED
          SA1    BEFFLAG           CHECK TO SEE IF WE HAVE A BEFORE 
          ZR     X1,NOBEF          OR ADDFILE WHICH STORED
          RJ     RESBEF            ELSE RESTORE.
          EQ     ROPL 
          SPACE  1
NOBEF     BSS    0
 A        IF     DEF,OLDPLKEY 
          SA1    RJROPL 
          ZR     X1,NOBEF1
          RJ     READOPL           READ OLD STYLE PL
          EQ     ROPL 
 NOBEF1   BSS    0
 A        ENDIF 
          SA1    FAST              CHECK SPECIAL Q ADDFILE MODE 
          NZ     X1,RESETFF        JUMP TO KESET FLAG IF ON 
          SB6    TEMP1             READ IN THE NEXT CONTROL WORD
          SB7    1                 USEING THE PROPER READ ROUTINE.
          READWC  OLDPL,B6,B7 
          NZ     X1,ROPL           EOR
          SA1    TEMP1             FETCH THE WORD JUST READ 
ROPLREC   LX6    X1,B1             SHIFT INTO X6 WITH ACTIVITY BIT AT 
          BX3    X1 
          LX1    24                TOP. SHIFT X1 TO PUT WORD COUNT IN 
          SB2    B0                B2 INDICATES CHBS IN CURRENT WORD. 
          SB4    CHBTAB            BOTTOM 18 BITS.
          SA5    L.DIRECT 
          SB5    X5 
          MX5    44 
          SX7    X1                X7 NOW CONTAINS SQUEEZED IMAGE LENGTH
          MX0    43 
          NG     X7,ROPL3          THIS MAY BE THE CHECKSUM.
          SB3    X7-SQLSIZE8
          LT     B1,B3,ROPL3
          LX1    60-24+59-S.8BIT   GET RECORD TYPE
          PL     X1,ROPL1A         6-BIT
          SA7    SQLGN8            8-BIT
          MX6    1
          BX6    -X6*X1            TURN OFF 8-BIT FLAG IN STATUS
          LX6    1+S.8BIT+1 
          EQ     ROPL1B 
 ROPL1A   SA7    SQLGN
 ROPL1B   SA0    A7                SAVE RECORD ADDRESS
          LX1    24+18+S.8BIT-59   SHIFT TO SEQUENCE NUMBER 
          SX7    X1                AND STORE IN 
          SA7    SEQNUM            -SEQNUM-.
          MX7    0                 ZERO X7. IT WILL HOLD CHB COUNT. 
          SA6    CARDSTAT          STORE CARD STATUS (BIT 59).
          SA6    A6+B1             AND CURRENT STATUS 
ROPL1     LX1    18                SHIFT TO NEXT CHB. 
          BX6    -X0*X1            ISOLATE 17 BITS (NOT YANK BIT).
          SB2    B2-B1             DECREMENT BYTE INDEX 
          ZR     X6,ROPL2          END OF CHBS IF ZERO CHB
          SA6    X7+B4             STORE NEXT CHB 
          SX7    X7+B1             INCREMENT COUNT. 
          BX6    -X5*X6            CHECK CHB ORDINAL
          SB6    X6 
          GT     B6,B5,ROPL3       LARGER THAN LARGEST IDENT
          PL     B2,ROPL1          LOOP IF MORE IN THIS WORD, 
          SA7    LCHBTAB           ELSE STORE COUNT. IF BIT 59 IS 
          NG     X3,ROPL2          ON THIS IS THE END.
          READWC OLDPL,TEMP1,1
          NZ     X1,ROPL3          MAY BE END  CHECK FOR CHECKSUM 
          SA1    TEMP1             FETCH WORD JUST READ 
          SA4    LCHBTAB           FETCH LENGTH OF CHB TABLE
          BX3    X1                KEEP WORD IN X3 (FOR BIT 59 TEST)
          LX1    6                 SET UP FOR FIRST CHB 
          SB2    B1+B1             B2 INDICATES 3 (2+1) CHBS IN WORD
          MX0    43                MASK FOR ISOLATION OF CHB
          BX7    X4                MOVE CHB TABLE LENGTH TO X7
          SB4    CHBTAB            B4 = BEGINNING OF CHB TABLE
          SA5    L.DIRECT 
          SB5    X5 
          MX5    44 
          EQ     ROPL1             LOOP TO PROCESS THIS WORD OF CHB-S 
          SPACE  1
 ROPL2    SA1    A0                FETCH LENGTH OF SQUEEZED IMAGE 
          SX3    X7-L.CHB 
          SA7    LCHBTAB           STORE LENGTH OF CHB TABLE
          PL     X3,TOOMUCH3
          ZR     X7,ROPL3          NO CHB BYTES 
TMRET3    BSS    0
          READWC OLDPL,A1+B1,X1    READ CARD IMAGE
          SPACE  1
          IF     -DEF,CHAR64,1
          ZR     X1,ROPL           EXIT IF NORMAL READ COMPLETE 
          SPACE  1
          IF     DEF,CHAR64,1 
          ZR     X1,ROPLCH         NORMAL READ COMPLETE 
          SA1    ERRMODE
          NZ     X1,ROPL3 
ROPLE     BSS    0
          SA1    LISTONE           LISTONE NON-ZERO FOR ERROR LISTING 
          ZR     X1,ROPLE1
          PRINT  (0*** PREMATURE END OF RECORD ON OLD PROGRAM LIBRARY **
,*) 
ROPLE1    SA1    ERRMODE
          NZ     X1,ROPL
          EQ     ABORT
          SPACE  1
A         IF     DEF,CHAR64 
ROPLCH    SA4    CHARKEY
          NZ     X4,CONVPH   CONVERSION PERHAPS 
          RJ     CONVLINE 
CONVPH    SA4    SIXTY3 
          ZR     X4,CONVPH1  READING THE SAME CHARACTER SET 
          RJ     CONV63      CONVERT
CONVPH1   SA2    CPYFMLIB 
          SX1    0           CLEAR EOR FLAG 
          NZ     X2,UPDATEB7 IF IN B MODE 
          EQ     ROPL 
A         ENDIF 
          ENDIF 
          EJECT                                                          CP190
**        ROPLL2     READ SECONDARY OLDPL.                               CP190
*                                                                        CP190
*         ROPLL2 IS SIMILAR TO ROPL EXCEPT IT READS SECONDARY OLDPLS.    CP190
*         ROPLL2 WILL PASS BACK ONE CARD IMAGE WHICH WILL BE SET UP      CP190
*         AS FOLLOWS. . .                                                CP190
*                                                                        CP190
*         SQIMAGE-   COMPRESSED CARD IMAGE.                              CP190
*         SEQNUM2-   SEQUENCE NUMBER OF CARD.                            CP190B 
*           SQLGN-   LENGTH OF IMAGE IN SQIMAGE.                         CP190
*            STAT-   STATUS OF CARD.  (- = ACTIVE, + = CARD INACTIVE)    CP190
*             ORD-   ORDINAL OF CARD IDENT IN DIRECTORY.                 CP190B 
*                                                                        CP190
*         UPON RETURN, X1 WILL BE NON-ZERO IF AN EOR WAS READ.           CP190
*         CALLS  RBIN                                                    CP190
                                                                         CP190
ROPLL2    PS                                                             CP190
          SX6    B0 
          MX7    0
          SA6    CARD 
          SA7    CARD8
          SA6    SQLGN
          SA7    SQLGN8 
          SA6    PRINTED
          READW  OLDPL2,TEMP1,1 
          NZ     X1,ROPLL2         IF EOR READ.                          CP190
          SA2    TEMP1             FETCH WORD JUST READ.                 CP190
          LX6    X2,B1             PUT ACTIVITY BIT INTO POS 59.         CP190
          SA6    STAT              STAT IS NG IF CARD IS ACTIVE.         CP190
          LX6    59-36             SHIFT WORD COUNT AROUND.              CP190
          MX3    -18               FORM MASK.                            CP190B 
          BX7    -X3*X6            MASK OFF SQLGN.                       CP190B 
          LX6    60-24+59-S.8BIT   GET RECORD TYPE
          PL     X6,ROPLL2A        6-BIT
          SA7    SQLGN8            8-BIT
          EQ     ROPLL2B
 ROPLL2A  SA7    SQLGN
 ROPLL2B  SA0    A7                SAVE RECORD ADDRESS
          MX4    -16               FORM MASK FOR THE ORDINAL.            CP190B 
          LX6    24+18+S.8BIT-59   SHIFT TO SEQUENCE NUMBER 
          BX7    -X3*X6            MASK OFF THE SEQUENCE NUMBER          CP190B 
          SA7    SEQNUM2           AND STORE IT.                         CP190B 
          LX6    18                SHIFT AROUND THE ORDINAL.             CP190B 
          BX7    -X4*X6            MASK OFF THE ORDINAL AND              CP190B 
          SA7    ORD               STORE IT IN ORD.                      CP190B 
          NG     X2,SKIPY          IF 1ST WORD CONTAINS LAST CHB.        CP190
 ROPLL21  BSS    0
          READW  OLDPL2,TEMP1,1 
          NZ     X1,ROPLE          IF EOR READ.                          CP190
          SA2    TEMP1             FETCH WORD JUST READ.                 CP190
          PL     X2,ROPLL21        LOOP TIL LAST CHB IS READ
SKIPY     BSS    0                                                       CP190
          SA1    A0 
          ZR     X1,ROPLL2         NULL CARD
          READW  OLDPL2,A1+B1,X1   READ CARD IMAGE
          NZ     X1,ROPLE          IF EOR READ.                          CP190
          EQ     ROPLL2            EXIT.                                 CP190
          EJECT                                                          CP190
RSTPTRS   PS                                                             CP190
          SA2    TCOL              PUT                                   CP190
          SA3    TCHAR                 TCOL                              CP190
          LX6    X2                         AND TCHAR                    CP190
          BX7    X3                                   BACK INTO          CP190
          SA6    A2-B1                                          COL      CP190
          SA7    A3+B1                                       AND CHAR.   CP190
          SA1    TSQLGN            PUT SQLGN AND SQIMAGE BACK.           CP190
          MOVE   X1+1,A1,SQLGN
          SA1    TCARDID
          BX6    X1 
          SA6    CARDID 
          EQ     RSTPTRS                                                 CP190
  
* 
* UNEXPECTED EOR
* 
 READERR  SA1    LISTONE
          ZR     X1,ABORT 
          PRINT   (0*** LENGTH ERROR ON OLDPL.  UNUSABLE OLDPL OR HARDWA
,RE ERROR. ***) 
          EQ     ABORT
          EJECT  4                                                      01256340
**        SAVECARD SAVE A CARD                                          01256341
*                                                                       01256342
*         SAVECARD IS CALLED WHEN IT IS NECESSARY TO STORE              01256343
*         THE CURRENT CARD AND ITS ASSOCIATED POINTERS IN ORDER         01256344
*         TO PROCESS A BEFORE OR ADDFILE CARD.  BEFFLAG CONTAINS A      01256345
*         NUMBER WHICH INDICATES HOW MANY CARDS HAVE BEEN STORED IN     01256346
*         THE SVCRD STACK.  THIS NUMBER IS LIMITED TO RECURDEP, AN      01256347
*         ASSEMBLY PARAMETER.  SPACE IS ALLOCATED IN SVCRD AND          01256348
*         EXISTING ENTRIES ARE MOVED SO THAT THE NEW ENTRY WILL BE AT   01256349
*         THE FRONT OF THE STACK.  THE STACK ENTRY IS CREATED IN THE    01256350
*         FORMAT DISCRIBED UNDER THE DISCUSSION OF THE SVCRD TABLE.     01256351
*                                                                       01256352
*         CALLS  MANAGER, MOVEIT                                        01256353
                                                                        01256354
SAVECARD  PS
          SA1    BEFFLAG
          SX0    X1-RECURDEP
          PL     X0,RECURERR       IF CARDS BACKED UP TOO FAR COMPLAIN
          SX6    X1+B1
          SA6    A1 
          SA1    DECKFLAG                                               0014   8
          NG     X1,SVCD2                                               0014   9
          SA1    FASTFLG                                                0014  10
          ZR     X1,SVCD2          JUMP IF NOT Q MODE                   0014  11
          SA1    IDFLG                                                  0014  12
          BX7    X1                                                     0014  13
          SA2    L.DKLIS                                                0014  14
          SA3    F.DKLIS
          SB7    X2                FETCH TABLE LENGTH                   0014  16
          SA3    X3                FETCH TABLE ORIGIN                   0014  17
          SA1    WORKLGTH                                               0014  18
SVCD3     BX4    X7-X3             COMPARE NAMES                        0014  19
          SA3    A3+B1             PICK UP NEXT ENTRY                   0014  20
          AX4    6                 SHIFT OFF EXTRA BITS                 0014  21
          SB7    B7-B1             DECREMENT LOOP INDEX                 0014  22
          ZR     X4,SVCD4          JUMP IF MATCH FOUND                  0014  23
          PL     B7,SVCD3                                               0014  24
          EQ     SVCD2             CONTINUE IF NO MATCH                 0052   8
          SPACE  1                                                      0014  27
SVCD4     SA2    RANDOPL           CHECK IF RANDOM PL AND Q MODE        0086   8
          NZ     X2,SVCD6    IF OLDPL IS RANDOM 
          SX6    X1+B1
          SA6    A1                BY ONE                               0086  13
SVCD6     SX0    4                                                      0086  14
          SA3    A3-B1             FETCH DKLIS ENTRY                    0014  31
          BX6    -X0*X3            CLEAR DONE BIT                       0014  32
          SA6    A3                                                     0014  33
SVCD2     SA1    LCHBTAB           NOW PUSH ANY EXISTING ENTRIES
          SA2    SQLGN8            DOWN AND ALLOCATE SPACE
          SB2    1S7               8-BIT FLAG 
          NZ     X2,SVCD2A
          SA2    SQLGN             6-BIT CARD 
          SB2    0
 SVCD2A   SX7    A2                REMEMBER CARD START
          SA7    TCRBIN 
          SX6    X2+B2             LENGTH + FLAG
          SA6    A2 
          IX1    X1+X2             FOR A NEW CARD TO BE STORED. 
          SX1    X1+B1
          SX6    X1 
          SA6    TEMP1
          ALLOC  SVCRD,X1 
          SA4    TEMP1
          IX1    X3-X4
          IX3    X2+X4
          MOVE   X1,X2,X3 
          MX6    1
          SA1    TCRBIN            FIND INDEX TO DECK NAME
          SA1    X1 
          SA5    CARDSTAT          NOW SAVE IN ADDITION TO THE CARD 
          SA4    CURSTAT           ITSELF ALL OF THE APPROPRIATE
          SA3    SEQNUM            POINTERS AND CONTROL CELLS 
          BX5    X5*X6             WHICH COULD NOT BE RECREATED 
          BX7    X6*X4             AFTER THE CARD IS RESTORED.
          BX4    -X6*X4 
+         ZR     X4,*+1            WORD 1      VFD    1/CARDSTAT, 
          LX6    59                                   2/CURSTAT,
          BX7    X6+X7                                18/SEQNUM,
          SA2    LCHBTAB                              8/LCHBTAB,
          LX7    59                    1/8-BIT-TYPE,  7/SQLGN(8), 
          BX6    X7+X5                                15/INDEX, 
          LX6    21                                   8/NUMBER OF MODS
          BX6    X6+X3
          LX6    8                 WORDS 2--LCHBTAB+1      CHBS 
          BX6    X6+X2
          LX6    8                 WORDS LCHBTAB+1--END    SQIMAGE
          BX6    X6+X1
          LX6    15 
          SA5    F.SVCRD
          LX6    8
          SA6    X5 
          SA5    CARDSTAT 
          MX0    1
          LX5    58-54
          BX5    X5*X0             SAVE YANKDECK BIT
          SA3    CHBTAB 
          BX7    X5+X3
          SA7    A3 
SVCDLP    SX2    X2-1              LOOP TO STORE CHBS 
          SA5    X2+CHBTAB
          BX6    X5 
          SA6    A6+B1
          NZ     X2,SVCDLP
          SX2    1S7               CLEAR POSSIBLE 8-BIT FLAG
          BX1    -X2*X1 
          MOVE   X1,A1+B1,A6+B1 
          SA1    DECKFLAG 
          NG     X1,SVCD1 
          SA1    GETLIMT           SAVE CURRENT DECK NAME IN
          SA2    A1+B1             IDFLG AND DNAME
          BX6    X1 
          LX7    X2 
          SA6    DNAME
          SA7    IDFLG
SVCD1     BSS    0
          SB2    B1+B1
          EQ     SAVECARD 
          EJECT  4                                                      01256356
**        SCITEML SCAN CARD IN SQIMAGE                                  01256357
*                                                                       01256358
*         THIS ROUTINE IS CALLED TO SCAN THE CARD CURRENTLY             01256359
*         IN SQIMAGE AND BUILD THE NEXT ITEM CONSISTING OF ALL          01256360
*         CHARACTERS UP TO THE NEXT DELIMITER.  THE ROUTINE GETCH IS    01256361
*         CALLED TO PICK OUT EACH NEW CHARACTER FROM SQIMAGE.  THIS     01256362
*         CHARACTER IS RETURNED BY GETCH IN X6.  PAD IS CALLED TO PAD   01256363
*         THE RETURNED ENTRY WITH BLANKS.  THE LEFT JUSTIFIED           01256364
*         ITEM IS RETURNED IN X7 WITH ZERO FILL AND IN X6 WITH BLANK    01256365
*         FILL.                                                         01256366
*                                                                       01256367
*         CALLS  GETCH, SFN=. 
          SPACE  1
SCITEM2   LX0    6
          BX0    X0+X6
          RJ     GETCH
SCITEM1   SB7    X6+B2
          SB5    B5-B3
          ZR     B5,SCITEM3 
          ZR     X6,SCITEM3        EXIT ON COLON
          NG     B7,SCITEM2 
          SB6    B7-3 
          NG     B6,SCITEM3  DELIMETER
          EQ     SCITEM2     SPECIAL CHAR 
SCITEM3   LX1    X0,B5
          RJ     SFN= 
          BX7    X1 
SCITEML   PS
          SA1    CHAR 
          MX0    0
          BX6    X1 
          SB2    -1R
          SB5    66 
          SB3    6
          EQ     SCITEM1
          SPACE    4
**        SCITEM SCAN ITEM DELIMITED BY BLANKS AND COMMAS               01256370
*                                                                       01256371
*         SCITEM CALLS SCITEML TO SCAN FOR THE NEXT ITEM ON THE CARD    01256372
*         IMAGE IN SQIMAGE AND THEN TESTS THE LENGTH OF THE SCANNED ITEM01256373
*         TO BE SURE IT IS NOT TOO LONG.  IF THE ITEM IS LONGER THAN 9  01256374
*         CHARACTERS, THE CHARACTERS .ERROR. ARE SUBSTITUTED, THE       01256375
*         FATAL ERROR COUNT INCREMENTED, AND AN APPROPRIATE ERROR       01256376
*         MESSAGE PRINTED.                                              01256377
*         CALLS  SCITEML, PRINT                                         01256378
                                                                        01256379
SCITEM
          RJ       SCITEML
          SB5    B5-B3
          PL     B5,SCITEM
          SA7    BIDEN+4
          PRINT  BIDEN,6
          SA1    ERRORS 
          SX7    X1+B1       BUMP ERROR COUNT 
          SA7    A1 
          SA1    =10H.ERROR.
          SA2    =7L.ERROR. 
          BX6    X1 
          LX7    X2 
          EQ       SCITEM 
          SPACE  4                                                      01256381
**        SCNN   SCAN NUMERIC                                           01256382
*                                                                       01256383
*         SCNN SCANS THE LINE IN SQIMAGE AND BUILDS A NUMERIC ITEM.  IF 01256384
*         A NON-NUMERIC CHARACTER IS FOUND BEFORE TEH NEXT DELIMITER, AN01256385
*         ERROR MESSAGE IS ISSUED.  THE BINARY NUMBER EQUIVALENT TO THE 01256386
*         NUMBER SCANNED IS RETURNED IN X6.                             01256387
*                                                                       01256388
*         CALLS  UCARD, ADDID, PRINT, GETCH                             01256389
  
SCNNER    SA1    LISTONE
          ZR     X1,SCNNER1 
          PRNTCARD
          PRINT  (0*** INVALID NUMERIC FIELD ***) 
SCNNER1   SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          MX6    60                ERROR RESULT = -0
SCNN      PS
          MX0    0
          SA1    CHAR 
          BX6    X1 
          SB2    -1R+ 
          EQ     SCNN1
          SPACE  1
SCNN2     LX4    X0,B1
          LX0    3
          IX4    X4+X0
          IX0    X4+X6
          RJ     GETCH
SCNN1     SB7    X6+B2
          SX6    X6-1R0 
          NG     X6,SCNNER
          NG     B7,SCNN2          CONTINUE IF NUMERIC FIELD
          BX6    X0 
          EQ     SCNN 
          EJECT  4                                                      01256391
          SPACE  4,8
**        SEQERR - SEQUENCE NUMBER ERROR. 
* 
*         ISSUES DIAGNOSTIC AND ABORTS JOB WHEN SEQUENCE
*         NUMBER EXCEEDS 2**17-1 = 131071.
 SEQERR   SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          PRINT  (0*** SEQUENCE NUMBER EXCEEDS 131071 ***)
          EQ     ABORT
          EJECT 
**        SETDEF PROCESS DEFINE DIRECTIVE                               01256392
*                                                                       01256393
*         SETDEF IS CALLED IN PASS 2 WHEN A DEFINE CARD IS ENCOUNTERED. 01256394
*         SETDEF READS PARAMETERS FROM THE CARD AND CREATES THE         01256395
*         DEFINITION TABLE DEFTAB1.                                     01256396
*                                                                       01256397
*         CALLS  UCARD, ADDID, PRINT, SCITEM, GETCH, ADDWORD            01256398
                                                                        01256399
SETDEF    SA1    LISTTWO
          ZR     X1,SETDEF0 
          SA0    B0 
          RJ     ADDID
          PRNTCARD
 SETDEF0  BSS 
          RJ     SCITEM 
          ZR     X6,SETDEF3        IF NO PARAM THEN CHECK FOR NULL PARAM
          SA3    L.DEFTAB 
          SA2    F.DEFTAB 
          SB4    -B1
          SB6    X3+B4
          BX1    X7 
SETDEF1   NG     B6,SETDEF2        JUMP OUT WHEN TABLE IS SEARCHED
          SA3    X2+B6             FETCH NEXT TABLE ENTRY 
          SB6    B6-B1
          BX0    X7-X3
          NZ     X0,SETDEF1        NOT SAME DEFINITION
SETDEF3   SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,ECOR1          END OF CARD
          RJ     GETCH
          EQ     SETDEF0
          SPACE  1
 SETDEF2  ADDWRD DEFTAB,X1         ADD NEW DEFINITION TO TABLE
          EQ     SETDEF3
          SPACE  4
**        SETDO  PROCESS DO DIRECTIVE                                   01256401
*                                                                       01256402
*         SETDO PROCESSES DO CARDS IN PASS 2.  THE YANK BIT IS CLEARED  01256403
*         IN THE DIRECTORY FOR IDENTS SPECIFIED ON THE DO CARD.  IF THE 01256404
*         SPECIFIED IDENT IS NOT CURRENTLY YANKED, A NON-FATAL ERROR IS 01256405
*         LOGGED AND AN APPROPRIATE MESSAGE ISSUED.                     01256406
*                                                                       01256407
*         CALLS  UCARD, ADDID, PRINT, SCITEM, TLUDIR, MISIDENT, GETCH,  01256408
*                PAD                                                    01256409
                                                                        01256410
SETDO     MX6    0
          SA6    TEMP              SET KEY FOR DO 
SETDOS    SA1    LISTTWO
          ZR     X1,SETDO0
          SA0    B0 
          RJ     ADDID
          PRNTCARD
SETDO0    RJ     SCITEM            FETCH DO IDENT 
          ZR     X7,SETDO1         ERROR
          RJ     TLUDIR 
          NZ     X2,SETDO2         IDENT FOUND
SETDO1    RJ     MISIDENT          WRITE ERROR MESSAGE
          EQ     SETDO3 
          SPACE  1
SETDO2    SX0    40B
          SA1    TEMP 
          BX7    X0*X2             GET YANK BIT 
          BX6    -X0*X2            GET ALL BUT YANK BIT 
          NZ     X1,DONT1          THIS IS A DONT 
          ZR     X7,DOERR          DO NOT YANKED
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2 
S2LCM     ELSE
          WX6    X3                WRITE ENTRY INTO DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
SETDO3    SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,ECOR1          END OF CARD
          RJ     GETCH
          EQ     SETDO0 
          SPACE  1
DOERR     SA1    LISTONE
          ZR     X1,DOERR1         NO LIST ERRORS 
          BX1    X2 
          RJ     SFN= 
          SA6    DOMESS+2 
          PRINT  DOMESS,7 
DOERR1    SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     SETDO3 
          SPACE  4
**        SETDONT  PROCESSES DONT DIRECTIVES                            01256412
*                                                                       01256413
*         SETDONT OPERATES EXACTLY AS SETDO EXCEPT THAT IT RESPONDS TO  01256414
*         DONT CARDS.                                                   01256415
*                                                                       01256416
                                                                        01256417
SETDONT   MX6    1
          SA6    TEMP              SET DONT FLAG
          EQ     SETDOS 
          SPACE  1
DONT1     NZ     X7,DOERR          DONT IDENT YANKED
          BX6    X2+X0
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2 
S2LCM     ELSE
          WX6    X3                WRITE ENTRY INTO DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
          EQ     SETDO3 
          SPACE  4                                                       CP190
**        SETFLG                                                         CP190
*                                                                        CP190
*         THIS ROUTINE TURNS ON BIT 3 OF DECKFLG SO THAT IT CAN LATER    CP190
*         BE OR D INTO THE DECK LIST TO DISTINGUISH DECKS FROM           CP190
*         COMDECKS.                                                      CP190
                                                                         CP190
SETFLG    PS                                                             CP190
          SX7    B1                                                      CP190
          LX7    3                                                       CP190
          SA7    DECKFLG                                                 CP190
          EQ     SETFLG                                                  CP190
          SPACE  4
**        SETSELY  PROCESSES SELYANK DIRECTIVES                         01256419
*                                                                       01256420
*         SETSELY PROCESSES SELYANK CARDS DURING PASS 2 BY              01256421
*         VALIDATING THE IDENT NAMES AND MAKING APPROPRIATE             01256422
*         ENTRIES IN THE PRUYAN TABLE.                                  01256423
*                                                                       01256424
*         CALLS  UCARD, ADDID, PRINT, SCITEM, CHKDCKS, MISISENT, GETCH, 01256425
*                ADDWORD                                                01256426
                                                                        01256427
SETSELY   SA1    LISTTWO
          ZR     X1,SETSELY1
          RJ     ADDID
          PRNTCARD
SETSELY1  RJ     SCITEM            PROCESS SELYANK
          BX0    X6                SAVE THE IDENT NAME FOR A WHILE
          SA1    IDFLG             GET CURRENT DECK NAME.                UPD0315
          SA2    =7LYANK$$$                                              UPD0315
          IX1    X1-X2             COMPARE NAMES.                        UPD0315
          NZ     X1,SETSELY5       IF CURRENT DECK NOT YANK DECK.        UPD0315
          BX3    X6                PRESERVE X6
          IX6    X7-X2             SEE IF SELYANKING FROM YANKDECK.      UPD0315
          SA6    SELYKYK           SET ZERO IF SELYANKING YANKDECK.      UPD0315
          BX6    X3                RESTORE X6 
SETSELY5  SA7    TCRBIN 
          BX6    X0                RESTORE NAME FOR POSSIBLE DIAGNOSTIC 
          RJ     CHKDCKS
          ZR     X0,SETSELY2
          RJ     MISIDENT 
          RJ     GETCH
          RJ     SCITEM 
          EQ     SETSELY3 
          SPACE  1
SETSELY2  BSS    0
          RJ     GETCH             PURYAN TABLE 
          RJ     SCITEM 
          RJ     TLUDIR 
          NZ     X2,SETSELY4
          RJ     MISIDENT 
          EQ     SETSELY3 
          SPACE  1
SETSELY4  SX0    B1 
          LX0    23                POSITION YANK BIT
          BX1    X0+X6             ADD IDENT ORDINAL
          ADDWRD PURYAN,X1
          SA1    SELYKYK                                                 UPD0315
          NZ     X1,SETSELY6                                             UPD0315
          MX5    1                 MAKE REMOVE BIT.                      UPD0315
          SA4    F.DIRECT 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SB2    X4                PUT DIRECT ORG INTO B2.               UPD0315
          SA2    B2+X6             FETCH DIRECTORY ENTRY.                UPD0315
          BX3    X6                PUT 1ST WORD ENTRY INTO X3.           UPD0315
          AX3    18                SHIFT OVER TO PICK UP MASK.           UPD0315
          BX7    X3+X2             SET CORRECT BIT INTO DIRECT ENTRY.    UPD0315
          SA7    A2                STORE ENTRY BACK INTO DIRECTORY.      UPD0315
S2LCM     ELSE
          IX7    X4+X6             COMPUTE LCM ADDRESS AND
          RX2    X7                FETCH DIRECTORY ENTRY. 
          BX3    X6                PUT 1ST WORD ENTRY INTO X3.
          AX3    18                SHIFT OVER TO PICK UP MASK.
          BX2    X3+X2             SET CORRECT BIT INTO DIRECT ENTRY. 
          WX2    X7                STORE ENTRY BACK INTO DIRECTORY. 
S2LCM     ENDIF 
          SPACE  1
          BX6    X5+X6             OR IN REMOVE BIT SO THAT THIS ENTRY   UPD0315
          SA6    A6                WILL BE REMOVED IN CHKPURY.           UPD0315
          SA7    A1                SET FLAG NON ZERO.                    UPD0315
SETSELY6  SA1    TCRBIN 
          ADDWRD PURYAN,X1
SETSELY3  BSS    0
          SA1    CHAR 
          SB7    X1-1R             IS THIS END OF CARD
          ZR     B7,ECOR1          YES
          RJ     GETCH             SKIP OVER COMMA
          EQ     SETSELY1          GET ANOTHER DNAME
          SPACE  4                                                       CP190
**        STDKBIT         SET DECK BIT.                                  CP190
*                                                                        CP190
*         THESE INSTRUCTIONS WILL CAUSE A RETURN JUMP TO SETFLG          CP190
*         WHERE THE DECK BIT IS SET UP IN DECKFLG. CONTROL IS            CP190
*         THEN PASSED BACK TO THE APPROPRIATE LOCATION.                  CP190
                                                                         CP190
STDKBIT1  RJ     SETFLG                                                  CP190
          EQ     OUTRLOOP                                                CP190
STDKBIT2  RJ     SETFLG                                                  CP190
          EQ     NEW                                                     CP190
STDKBIT3  RJ     SETFLG                                                  CP190
          EQ     CONVDECK                                                CP190
STDKBIT4  RJ     SETFLG                                                  CP190
          EQ     DECKCARD                                                CP190
STDKBIT5  RJ     SETFLG                                                  CP190
          EQ     CORADA                                                  CP190
STDKBIT6  RJ     SETFLG                                                  CP190
          EQ     CORR4A                                                  CP190
STDKBIT7  RJ     SETFLG                                                  CP190
          EQ     SEARCHDL                                                CP190
STDKBIT8  RJ     SETFLG                                                  CP190
          EQ     SETUPA                                                  CP190
          EJECT  4                                                      01256429
**        SETYANK  PROCESS YANK DIRECTIVES                              01256430
*                                                                       01256431
*         SETYANK PRINTS THE YANK DIRECTIVE, IF L=2 HAS BEEN
*         SPECIFIED, AND THEN CALLS SYB TO SET THE YANK BIT IN
*         THE APPROPRIATE DIRECTORY ENTRY.
*                                                                       01256437
*         CALLS - UCARD, ADDID, PRINT, SYB
                                                                        01256439
SETYANK   SA1    LISTTWO
          ZR     X1,SETYANK1
          RJ     ADDID
          PRNTCARD
SETYANK1  MX7    1
          SA7    YNKFLG      SET FLAG FOR PASS2 YANK PROCESSING 
          RJ     SYB         SET YANK BIT 
          EQ     ECOR1
          SPACE  4                                                      01256441
**        SETYD  PROCESS YANKDECK DIRECTIVES                            01256442
*                                                                       01256443
*         THE YANKDECK BIT IS SET ON, IN THE DECK LIST FOR EACH         01256444
*         CORRESPONDING DECK SPECIFIED.                                 01256445
*                                                                       01256446
*         CALLS  UCARD, ADDID, PRINT, SCITEM, CHKDCKS, MISIDENT, GETCH  01256447
                                                                        01256448
SETYD     SA1    LISTTWO
          ZR     X1,SETYD1
          RJ     ADDID
          PRNTCARD
SETYD1    RJ     SCITEM 
          RJ     CHKDCKS
          ZR     X0,SETYD2
          RJ     MISIDENT 
          EQ     SETYD3 
          SPACE  1
SETYD2    SX0    40B
          BX6    X2+X0
          SA6    A2 
SETYD3    SA1    CHAR 
          SB7    X1-1R
          ZR     B7,ECOR1 
          RJ     GETCH
          EQ     SETYD1 
          EJECT  4                                                      01256450
**        SQUIZOUT SQUEEZE TABLE DICT                                   01256451
*                                                                       01256452
*         SQUIZOUT IS CALLED WHENEVER AN ENTRY IN DICT                  01256453
*         IS MOVED TO TDICT FOR PROCESSING.  SQUIZOUT                   01256454
*         SQUEEZES DICT TO INCREASE THE EFFICIENCY OF                   01256455
*         SUBSEQUENT SEARCHES.                                          01256456
*                                                                       01256457
*         CALLS  MOVEIT                                                 01256458
                                                                        01256459
SQUIZOUT  BSS    1                 SQUEEZE THE TABLE -DICT- AFTER 
          SA5    L.DICT            MOVING AN ENTRY TO -TDICT-.
          SA1    TEMP 
          SA2    F.DICT 
          SX4    X1+3 
          IX3    X2+X1
          IX1    X5-X4
          MOVE   X1,X3+3,X3 
          SA1    L.DICT 
          SX6    X1-3 
          SA6    A1 
          EQ     SQUIZOUT 
          SPACE  4                                                      01256461
**        SRCHCOM  SEARCHES COMIND FOR COMMON DECK                      01256462
* 
*         ENTRY  X7 CONTAINS NAME OF DESIRED COMMON DECK
* 
*         EXIT   X4 = 0, COMMON DECK FOUND, A1 CONTAINS ADDRESS OF
*                           COMIND ENTRY
* 
*                X4 NE 0, COMMON DECK NOT FOUND 
          SPACE  1
SRCHCOM   BSS    1
          SA2    F.COMIND          FETCH ORIGIN OF COMIND TABLE 
          SA1    L.COMIND          FETCH LENGTH OF COMIND TABLE 
          SB2    B1+B1
          MX0    54                SET UP MASK
          SB3    X1 
          SB4    B0 
SRCHC1    GE     B4,B3,SRCHCOM     NO MATCH 
          SA1    X2+B4
          BX1    X0*X1             FETCH COMMON DECK NAME 
          IX4    X7-X1             COMPARE NAMES
          SB4    B4+B2             INCREMENT INDEX
          NZ     X4,SRCHC1
          EQ     SRCHCOM           RETURN 
          SPACE  4,8
**        SYB - SET YANK BIT
* 
*         SYB IS CALLED FROM BOTH PASS1 AND PASS2 WHEN PROCESSING 
*         A YANK DIRECTIVE.  EACH IDENT NAME IS VALIDATED, THE
*         CORRESPONDING DIRECTORY ENTRY IS FETCHED, AND THE 
*         APPROPRIATE BIT IS SET.  THE YNKFLG CELL IS USED TO 
*         DETERMINE WHICH BIT OF THE DIRECTORY ENTRY IS TO BE 
*         SET.  IF SYB HAS BEEN CALLED FROM PASS1, YNKFLG IS
*         POSITIVE AND BIT 1 WILL BE SET.  IF SYB HAS BEEN CALLED 
*         FROM PASS2, YNKFLG IS NEGATIVE AND BIT 5, THE YANK BIT, 
*         WILL BE SET.
* 
*         CALLS GETCH, MISIDENT, PRINT, SCITEM, TLUDIR
  
SYB       PS                 ENTRY/EXIT 
  
*         VALIDATE IDENT NAME, FETCH DIRECTORY ENTRY, AND 
*         SET THE APPROPRIATE BIT.
  
SYB1      RJ     SCITEM 
          RJ     TLUDIR 
          ZR     X2,SYB3     IF INVALID IDENT 
          ZR     X6,SYB2B          IF YANKING YANK$$$.
          SA1    CHAR 
          SB7    X1-1R
          SB2    B1+B1
          EQ     B7,B2,SYB5  IF YANKING A RANGE 
          SA1    YNKFLG 
          LX1    6
          BX6    X1+X2
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA6    A2 
S2LCM     ELSE
          WX6    X3                WRITE ENTRY TO DIRECTORY.
S2LCM     ENDIF 
          SPACE  1
SYB2      ZR     B7,SYB      IF THROUGH PROCESSING CARD, RETURN 
          RJ     GETCH
          EQ     SYB1        LOOP TO PROCESS ENTRIE CARD
  
*         FLAG UNKNOWN IDENT. 
  
SYB2B     BX6    X0                PUT NAME INTO X6 FOR STORING.
SYB3      SA1    YNKFLG 
          PL     X1,SYB4     IF DOING PASS1 PROCESSING
          RJ     MISIDENT 
SYB4      SA1    CHAR 
          SB7    X1-1R
          EQ     SYB2        CONTINUE PROCESSING
  
*         PROCESS RANGE FORM OF YANK DIRECTIVE. 
  
          SPACE  1
          ENV    NOT,(2,3),S2LCM
SYB5      SX6    A2 
S2LCM     ELSE
SYB5      BX6    X3                PUT DIRECTORY ADDRESS INTO X6. 
S2LCM     ENDIF 
          SPACE  1
          SA6    TCRBIN            TEMP SAVE OF FIRST ADDRESS OF RANGE
          RJ     GETCH
          RJ     SCITEM 
          RJ     TLUDIR 
          ZR     X2,SYB3     IF INVALID IDENT 
          ZR     X6,SYB2B          IF YANKING YANK$$$.
          SA1    TCRBIN 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SX7    A2 
S2LCM     ELSE
          BX7    X3                PUT DIRECTORY ADDRESS INTO X7. 
S2LCM     ENDIF 
          SPACE  1
          IX7    X7-X1
          MI     X7,SYB7     IF ORDER OF ADDR IS REVERSED 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA3    YNKFLG 
          LX3    6
          SB3    X1 
          SB4    A2 
SYB6      SA2    B3 
          BX6    X3+X2       SET APPROPRIATE BIT
          SA6    A2 
S2LCM     ELSE
          SA4    YNKFLG            FETCH YANK FLAG. 
          LX4    6                 SHIFT BIT AROUND.
          SB3    X1                SET INDEX. 
          SB4    X3                SET POINTER TO END.
SYB6      SX6    B3                GET ADDRESS IN LCM AND 
          RX2    X6                READ DIRECTORY.
          BX2    X4+X2             SET APPROPRIATE BIT
          WX2    X6                WRITE ENTRY BACK TO DIRECTORY. 
S2LCM     ENDIF 
          SPACE  1
          SB3    B3+B1
          GE     B4,B3,SYB6  IF NOT DONE PROCESSING RANGE 
          EQ     SYB4 
  
*         FLAG BAD ORDER OF IDENTS. 
  
SYB7      SA1    YNKFLG 
          PL     X1,SYB4     IF DOING PASS1 PROCESSING
          SA1    LISTONE
          ZR     X1,SYB8     IF L=1 NOT SPECIFIED 
          PRINT  BDORMG,4 
SYB8      SA1    NFERROR
          SX6    X1+B1
          SA6    A1 
          EQ     SYB4        CONTINUE PROCESSING
          SPACE  4                                                      01256465
**        TLUDIR SEARCHES DIRECTORY FOR IDENT NAME                      01256466
*                                                                       01256467
*         ENTRY  X7 - NAME TO LOOK UP                                   01256468
*         EXIT   X7 = UNCHANGED 
*                X2 = 0 IF NAME NOT IN DICTIONARY 
*                   = ACTUAL ENTRY FOUND
*                A2 = LOCATION OF ENTRY 
*                X3 = LOCATION OF ENTRY IN LCM (SCOPE 2)
*                X6 = INDEX OF ENTRY
  
          SPACE  1
          ENV    NOT,(2,3),S2LCM
TLUDIR2   SA2    A2-B1             FEFETCH ENTRY
          SX6    A2-B6             INDEX OF ENTRY 
S2LCM     ELSE
TLUDIR2   SX6    B6 
          IX6    X3-X6             INDEX OF ENTRY 
S2LCM     ENDIF 
          SPACE  1
TLUDIR    PS
          SA3    F.DIRECT 
          SA2    L.DIRECT 
          ZR     X2,TLUDIR         EXIT EMPTY 
          BX0    X6 
          SB7    X2 
          SX6    57B
          SB6    X3 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    X3 
S2LCM     ELSE
          RX2    X3                FETCH DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
TLUDIR1   BX4    X7-X2             COMPARE NAMES
          BX5    -X6*X4 
          SB7    B7-B1
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    A2+B1
          ZR     X5,TLUDIR2 
          NZ     B7,TLUDIR1 
S2LCM     ELSE
          ZR     X5,TLUDIR2            JUMP IF MATCH
          ZR     B7,TLUDIR3        JUMP IF TABLE EXHAUSTED
          SX3    X3+B1
          RX2    X3 
          EQ     TLUDIR1
TLUDIR3   BSS 
S2LCM     ENDIF 
          SPACE  1
          MX2    0
          BX6    X0 
          EQ     TLUDIR 
          EJECT  4                                                      01256470
**        TOOMUCH  PROCESS CHB OVERFLOW                                 01256471
*                                                                       01256472
*         TOOMUCH IS CALLED WHEN THERE ARE MORE CHBS                    01256473
*         ASSOCIATED WITH A GIVEN CARD THEN THERE IS ROOM               01256474
*         IN CHBTAB TO HOLD THEM.  THIS CONDITION CAUSES                01256475
*         AN ABORT UNLESS THE U PARAMETER IS SPECIFIED.                 01256476
*                                                                       01256477
*         CALLS  PRINT                                                  01256478
                                                                        01256479
TOOMUCH   PS
          SA1    LISTONE
          ZR     X1,TOOMUCHA       DO NOT LIST ERROR
          PRINT  (0*** TOO MANY CHBS -- INCREASE L.CHB ***) 
TOOMUCHA  SA1    ERRORS 
          SA2    ERRMODE
          SX6    X1+B1
          SA6    A1 
          NZ     X2,TOOMUCH 
          EQ     ABORT             ABORT UNLESS U SPECIFIED 
          SPACE  1
TOOMUCH1  RJ     TOOMUCH
          SA5    YANKFLAG          RETRIEVE YANKFLAG
          EQ     TMRET1 
          SPACE  1
          IF     DEF,OLDPLKEY,2 
TOOMUCH2  RJ     TOOMUCH
          EQ     TMRET2 
          SPACE  1
TOOMUCH3  RJ     TOOMUCH
          EQ     TMRET3 
          EJECT  4                                                      01256482
**        TOTALS  PROCESS AUDIT                                         01256483
*                                                                       01256484
*         TOTALS IS PART OF THE AUDIT PROCESSING.  AUDIT                01256485
*         PROCESSING HAS CREATED IN AUDCNT A RUNNING COUNT              01256486
*         OF TOTAL AND INACTIVE CARDS BELONGING TO EACH                 01256487
*         IDENT SINCE THE LAST TIME TOTALS WAS CALLED.                  01256488
*         TOTALS CONVERTS THESE BINARY NUMBERS TO DISPLAY               01256489
*         CODE AND FORMATS THEM INTO A TABLE WHICH IS WRITTEN           01256490
*         TO UPDTAUD.  TOTALS ALSO ADDS THESE TOTALS TO                 01256491
*         THE SUMS BEING KEPT FOR THE ENTIRE OLDPL (ALSO                01256492
*         KEPT IN AUDCNT).                                              01256493
*                                                                       01256494
*         CALLS  WBIN, WDEC, CONDEC                                     01256495
                                                                        01256496
E         IF     DEF,AUDITKEY 
TOTALS    BSS    1                 TOTALS PROCESSES THE IDENT CARD COUNT
          SA1    ACTAUDIT          SKIP UNLESS PREVIOUS DECK AUDITED. 
          ZR     X1,TOTAL1
          SA1    LINCOUNT 
          SX6    X1+5 
          SA2    JPS
          IX7    X6-X2
          NG     X7,NOPGEND2
          PRINT  =8L1,1,AUDITFL 
 NOPGEND2 PRINT  TOTITLE,6,AUDITFL
          PRINT  TOTITLE1,6,AUDITFL 
          PRINT  =8L,1,AUDITFL
TOTAL1    SA1    L.AUDCNT 
          BX6    X1 
          SA6    TCRBIN            WORKING LENGTH OF TABLE
TOTALOOP  SA3    TCRBIN 
          ZR     X3,TOTALS         RBIN = P WHEN FINISHED 
          SA1    F.AUDCNT 
          SA2    L.AUDCNT 
          IX0    X1-X3
          SX6    X3-2              DECREMENT RBIN 
          IX0    X0+X2
          SA5    X0+B1             FETCH SECOND WORD OF AUDCNT ENTRY
          SA6    A3 
          ZR     X5,TOTALOOP       LOOP IF NO CARDS IN IDENT
          SA2    L.DIRECT 
          AX3    1
          SA1    F.DIRECT          IF CARDS IN THIS IDENT WERE FOUND
          SA4    X0                IN THIS DECK ADD THE TEMPORARY 
                                   COUNTERS TO THE MASTER COUNTERS, 
          IX0    X1-X3             FIND THE IDENT NAME IN THE DIRECTORY,
          IX6    X5+X4             FILL IN THE NECESSARY BLANKS, AND
          MX7    54                FORMAT THE SUMMARY LINE FOR
          IX0    X0+X2             PRINTING.
          SA6    A4 
          MX6    0
          SA6    A5 
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA1    X0                THIS IS THE DIRECTORY ENTRY
S2LCM     ELSE
          RX1    X0                THIS IS THE DIRECTORY ENTRY. 
S2LCM     ENDIF 
          SPACE  1
          SX3    1R 
          BX6    X7*X1
TOTAL2    LX7    6                 THIS IS THE BLANK
          BX0    -X7*X6            FILL LOOP
          BX6    X6+X3
          LX3    6
          ZR     X0,TOTAL2
          SA6    AUDITEXT+1        STORE IDENTIFER
          BX7    X5                STORE COUNTERS IN X7 
          MX0    30 
          BX1    -X0*X5 
          RJ     CONDEC 
          SA6    AUDITEXT+4 
          AX7    30 
          BX1    X7                ACTIVE + INACTIVE TOTAL
          RJ     CONDEC 
          SA6    AUDITEXT+3 
          SA1    ACTAUDIT          DONT PRINT UNLESS IN DECK
          ZR     X1,TOTALOOP       TO BE AUDITED. 
          SA1    LINCOUNT 
          SA2    JPS
          IX7    X6-X2
          NG     X7,NOPGEND3
          PRINT  =8L1,1,AUDITFL 
          PRINT  TOTITLE,6,AUDITFL
          PRINT  TOTITLE1,6,AUDITFL 
          PRINT  =8L,1,AUDITFL
 NOPGEND3 PRINT  AUDITEXT,6,AUDITFL 
          EQ     TOTALOOP 
E         ENDIF 
          EJECT  4                                                      01256498
**        UCARD  UNPACK CARD                                            01256499
*                                                                       01256500
*         UCARD IS CALLED TO UNPACK THE SQUEEZED CARD IMAGE             01256501
*         IN SQIMAGE INTO THE AREA BEGINNING AT CARD.  UN-              01256502
*         PACKING INVOLVES RECOGNIZING THE SQUEEZED FORM                01256503
*         OF CONTIDUOUS BLANKS AND EXPANDING THESE TO CON-              01256504
*         TAIN THE ACTUAL NUMBER OF BLANKS (55B).  UCARD                01256505
*         IS SOMEWHAT COMPLEX BECAUSE OF 1. THE POSSIBLE                01256506
*         DIFFERENCE OF CHARACTER SETS BETWEEN OLDPL AND                0214  78
*         SYSTEM RUNNING UNDER 163 OR 64 CHAR SETS), AND 2. THE         0214  79
*         VARIOUS TYPES OF END CONDITIONS WHICH CAN OCCUR               01256508
*         FOR ANY GIVEN LINE.                                           01256509
*                                                                       01256510
*         CALLS LJUST                                                   01256511
          SPACE  2
UCARD     PS
          SA1    CARD 
          NZ     X1,UCARD 
          SA5    SQLGN             LENGTH OF PACKED CARD
          MX0    -6                CHARACTER MASK 
          SB4    X5-1              REMAINING WORD COUNT 
          MX6    0                 FIRST OUTPUT WORD
          SB6    CARD              FIRST WORD TO STORE
          SB3    B0 
          SB7    CARDSIZE          MAXIMUM NUMBER OF WORDS
          SB5    10                NUMBER OF CHARACTERS IN DEST WORD
  
 UCARD0   NZ     B3,UCARD2
          LT     B4,B0,UCARD11     DONE 
 UCARD1   SA5    A5+B1
          SB3    10 
          SB4    B4-B1
 UCARD2   LX5    6
          SB3    B3-B1
          BX4    -X0*X5            CHARACTER
          ZR     X4,UCARD5
 UCARD3   NZ     B5,UCARD4         STUFF IT 
          SA6    B6                STORE FULL WORD
          SB7    B7-B1
          SB6    B6+B1
          MX6    0
          SB5    10 
          ZR     B7,UCARD 
 UCARD4   LX6    6                 ADD CHARACTER TO WORD
          SB5    B5-B1
          BX6    X6+X4
          EQ     UCARD0 
  
 UCARD5   NZ     B3,UCARD6         00+
          LT     B4,B0,UCARD11     END OF CARD
          SA5    A5+B1
          SB3    10 
          SB4    B4-B1
 UCARD6   LX5    6
          SB3    B3-B1
          BX4    -X0*X5            CHARACTER AFTER 00 
          SB2    X4 
          ZR     X4,UCARD11        END OF CARD
          MX4    0
          EQ     B2,B1,UCARD3      00+01 = COLON
          SX4    1R                B2 = N-1 (SPACES)
          ZR     B5,UCARD.8        CURRENT WORD FULL
 UCARD7   LX6    6
          SB2    B2-B1
          BX6    X6+X4
          SB5    B5-B1
          ZR     B2,UCARD3         DONE 
          NZ     B5,UCARD7         MORE ROOM IN WORD
 UCARD.8  SA6    B6 
          SB7    B7-B1
          SB6    B6+B1
          SB5    10 
          ZR     B7,UCARD          FULL UP
          SA3    =8H               FILL FULL WORDS (MAYBE)
          BX6    X3 
          SB2    B2-10+1
          NG     B2,UCARD10        LESS THAN 10 LEFT
 UCARD9   SA6    B6 
          SB7    B7-B1
          SB6    B6+B1
          ZR     B7,UCARD 
          SB2    B2-10
          GE     B2,UCARD9
 UCARD10  SB2    B2+10-1           REMAINING COUNT
          MX6    0
          LT     B2,B0,UCARD0      EXACT WORD FILL
          GE     B2,B1,UCARD7      2 OR MORE
          EQ     UCARD3            ONLY 1 
  
 UCARD11  BSS 
          ENV    ACT,(2,3),VER2 
          SX7    B6-CARD
          SB4    10 
          EQ     B4,B5,UCFULL      IF FULL WORD 
          SB2    B5+B5             CHARS * 2
          SB4    B2+B5             CHARS * 3
          SB4    B4+B4             CHARS * 6
          SX7    B4                UBC
          LX7    18                POSITION FOR WORDS 
          SX1    B6-CARD+1
          BX7    X7+X1
 UCFULL   BSS    0
          NZ     X7,NZREC          IF RECORD NOT ZERO LENGTH
          SX7    54                SET UBC TO 9 CHARACTERS
          SA3    =1L               CHANGE LINE TO ONE BLANK 
          LX7    18                POSITION UBC 
          BX6    X3 
          SX3    B1                SET RL TO 1
          BX7    X7+X3             ADD RL TO UBC = WCW
          SA6    B6                REWRITE RECORD TO ONE BLANK
 NZREC    BSS    0
          SA7    UCW
          MX4    0
          EQ     UCARD12
 VER2     ELSE
          BX5    -X0*X6            LOOK AT LAST CHAR STORED 
          SB2    10 
          NE     B2,B5,LCOK        IF NOT FULL WORD 
          SA1    A6                PICK UP PREVEOUS WORD
          BX5    -X0*X1            LOOK AT LAST CHARACTER 
 LCOK     BSS    0
          MX4    0
          NZ     X5,UCARD12        NOT COLON
          SX4    1R 
 VER2     ENDIF 
 UCARD12  ZR     B5,UCARD13        WORD FULL
          LX6    6
          SB5    B5-B1
          BX6    X4+X6
          MX4    0
          NZ     B5,UCARD12 
 UCARD13  SA6    B6                STORE FULL WORD
          BX6    X4 
          LX6    60-6 
          SA6    A6+B1
          EQ     UCARD
          EJECT 
**        WTW=   MASTER WRITE ROUTINE (SCOPE 2 ONLY)
*                                                                       01256528
*         WBIN IS THE MASTER WRITE ROUTINE FOR UPDATE.                  01256529
*         ALL OUTPUT MUST EVENTUALLY BE DONE BY WBIN,                   01256530
*         ALTHOUGH IT MAY PASS THROUGH WBINC OR WDEC FIRST.             01256531
*         IF THE SPECIFIED FILE HAS COMPLETE STATUS OR THERE            01256532
*         IS A WRITE OPERATION IN PROCESS, WBIN ATTEMPTS                01256533
*         TO MOVE THE SPECIFIED NUMBER OF WORDS INTO THE                01256534
*         FILE BUFFER, OTHERWISE IT GOES INTO AUTOMATIC                 01256535
*         RECALL TO WAIT FOR COMPLETION.  AS LONG AS THERE              01256536
*         IS ROOM IN THE FILE BUFFER WBIN MOVES ONE WORD                01256537
*         AT A TIME INTO IT.  IF THE BUFFER IS FULL WBIN                01256538
*         CHECKS TO SEE WHETHER OR NOT A WRITE IS IN PRO-               01256539
*         GRESS.  IF SO, RECALL IS ENTERED FOR ONE LOOP                 01256540
*         TO ALLOW TIME FOR SPACE TO BE MADE AVAILABLE.                 01256541
*         IF NO WRITE IS IN PROGRESS, ONE IS INITIATED                  01256542
*         AND RECALL IS ENTERED FOR ONE LOOP.  WHEN ALL                 01256543
*         WORDS HAVE BEEN PLACED IN THE FILE BUFFER, BU                 01256544
*         IS CALLED TO ATTEMPT TO BUFFER AHEAD BEFORE                   01256545
*         WBIN EXITS.                                                   01256546
*                                                                       01256547
*         ENTRY  X2 - FET LOCATION
*                B2 - NON-ZERO IF B6 POINTS TO LCM ADDRESS (SCOPE 2)
*                B6 - FWA DATA                                          01256549
*                B7 - WORD COUNT                                        01256550
*                                                                       01256551
*         REGISTERS SAVED - X2, A5, X5
*                                                                       01256553
*         FOR 6000 OPERATING SYSTEMS, COMCWTW IS USED 
          SPACE  1
  
          ENV    ACT,(2,3),VER2 
 WBIN     BSS    1
 WTW=     EQU    WBIN 
          SA0    X2 
          EQ     B7,WBIN
          SA1    A0+FETFIT
          SA3    X1 
          ZR     X3,WBIN           IF NOT OPENED
 WBIN4    BSS 
          SA3    A0+FETRAND 
          LX3    59-47
          PL     X3,WBIN5    IF NOT RANDOM
          SA3    A0+FETRCLC 
          ZR     X3,WBIN5 
          SA4    A0+FETTYPE 
          NZ     X4,WBIN5          IF NOT W-FORMAT
          GETPOS X1,X6
          SA4    A0+EOIPOS
          ZR     X4,WBIN4A         IF ZERO,NEVER BEEN WRITTEN 
          IX7    X6-X4
          ZR     X7,WBIN4A         IF AT EOI
          POSITION   X1,X4            OTHERWISE POSITION TO EOI 
          BX6    X4 
 WBIN4A   BSS 
          SA6    X3 
          MX6    0
          SA6    A3 
 WBIN5    BSS 
          SA3    A0+FETIN 
          SA4    A0+FETLIMIT
          SX6    X3          IN 
          SX4    X4-1        LIMIT OF IN
          SA1    A0+FETLCMF        PICK UP LCM FLAG 
 WBIN6    BSS 
          IX7    X6-X4       IN-LIMIT 
          PL     X7,WBIN8 
          EQ     B2,WBIN6A         JUMP IF SCM TABLE
          SX3    B6                GET LCM ADDRESS AND
          RX3    X3                READ LCM.
          EQ     WBIN6B 
  
WBIN6A    SA3    B6 
WBIN6B    BSS    0
          NZ     X1,WBIN7 
          BX7    X3 
          SA7    X6          STORE WORD IN I-O BUFFER 
          EQ     WBIN7A 
WBIN7     WX3    X6                WRITE TO LCM 
WBIN7A    BSS 
          SX6    X6+B1
          SB6    B6+B1
          SB7    B7-B1
          NE     B7,WBIN6 
          SA6    A0+FETIN 
          EQ     WBIN 
 WBIN8    BSS 
          SA6    A0+FETIN 
          SA1    A0+FETFIT
          RJ     FLUSH76
          EQ     WBIN5
 VER2     ENDIF 
  
          EJECT  4                                                      01256556
**        WTWC=  WRITE SEQUENTIAL PL
*                                                                       01256558
*         WTWC= IS USED AS THE WRITE ROUTINE FOR SEQUENTIAL 
*         NEWPLS.  IT SCANS THE WORDS TO BE WRITTEN, COUNTS             01256560
*         THE TOTAL BITS, ADDS THIS COUNT TO THE TOTAL IN               01256561
*         WRCHSUM, AND CALLS WTW= TO PERFORM THE WRITE
*                                                                       01256563
          SPACE  1
 WTWC=    PS     ** 
          SA0    X2 
          SB5    B7 
          SB4    B6 
          ZR     B7,WTWC=          SKIP NULL WRITE
          SA4    WRCHSUM
          SPACE  1
          ENV    NOT,(2,3),S2LCM
          SA2    B4 
          BX6    X4 
WBINC1    CX3    X2 
          SB5    B5-B1
          IX6    X6+X3
          SA2    A2+B1
S2LCM     ELSE
          BX6    X4                MOVE CURRENT CHECK SUM 
WBINC1    EQ     B2,WBINC2         JUMP IF SCM TABLE
          SX2    B4                FETCH ADDRESS AND
          RX2    X2                READ LCM.
          EQ     WBINC3 
  
WBINC2    SA2    B4                FETCH WORD TO BE SCANNED.
WBINC3    CX3    X2                COUNT. 
          SB5    B5-B1
          IX6    X6+X3             COMPUTE TOTAL. 
          SB4    B4+B1
 S2LCM    ENDIF 
          SPACE  1
          NZ     B5,WBINC1
          SA6    A4 
          SX2    A0 
          RJ     WTW= 
          EQ     WTWC=
          SPACE  4
**        WTC=   WRITE WORDS WITH TERMINAL ZERO BYTE (SCOPE 2 ONLY) 
*                                                                       01256569
*         WTC= IS CALLED FOR ALL WRITES TO A CODED MODE FILE. 
*                                                                       01256574
*         ENTRY  X2 - FET LOCATION
*                B6 - FWA OF DATA                                       01256576
* 
*         ON 6000 OPERATING SYSTEMS, COMCWTC IS USED
          SPACE  1
          ENV    ACT,(2,3),VER2 
 WTC=     PS     ** 
          SB7    B0                ACCUMULATE RL
          MX0    60-12
          SA1    B6-B1
 WDEC1    SA1    A1+B1
          SB7    B7+10
          BX6    -X0*X1 
          NZ     X6,WDEC1 
          MX0    -6 
          NZ     X1,WDEC2          LAST WORD NOT ALL ZERO 
          SA1    A1-B1             LAST NON-ZERO WORD 
          SB7    B7-10
          ZR     B7,WDEC3          EMPTY LINE 
 WDEC2    BX6    -X0*X1            BACK OVER TRAILING ZEROS 
          NZ     X6,WDEC3 
          LX1    60-6 
          SB7    B7-B1
          EQ     WDEC2
 WDEC3    SA3    X2+FETFIT         WRITE RECORD 
          SA4    X3 
          ZR     X4,WTC=
          SX6    B6 
          SX7    B7 
          PUT    X3,X6,X7 
          EQ     WTC= 
 VER2     ENDIF 
          SPACE  4
**        WTH    WRITE WORDS WITH BLANK TRUNCATION (SCOPE 2 ONLY) 
* 
*         WTH= IS CALLED FOR WRITES TO THE COMPILE FILE 
* 
*         ENTRY  X2 - FET LOCATION
*                B6 - FWA OF DATA 
*                B7 - NUMBER OF WORDS OF DATA 
* 
*         ON 6000 OPERATING SYSTEMS, COMCWTH IS USED
  
          ENV    ACT,(2,3),VER2 
 WTH=     PS     ** 
          ZR     B7,WTH=           NO WORDS RETURN
          SA3    1H                WORD OF BLANKS 
          SB7    B6+B7             INITIALIZE READ ADDRESS
 WTH1     SA1    B7-B1             READ WORD OF RECORD
          IX6    X3-X1
          NZ     X6,WTH2           NOT ALL BLANK
          SB7    B7-1              DECREMENT ADDRESS
          NE     B6,B7,WTH1        MORE WORDS 
          SX7    B1                ALL BLANK - WRITE 1 CHARACTER
          EQ     WTHP 
  
WTH2      SX0    10 
          SX6    B7-B6             NUMBER OF WORDS
          IX7    X6*X0             NUMBER OF CHARACTERS 
          SX0    1
          SX6    77B               BLANK MASK 
 WTH3     BX3    X6*X1
          SX3    X3-55B 
          AX1    6                 NEXT CHARACTER 
          IX7    X7-X0             DECREMENT CHARACTER CIUNT
          ZR     X3,WTH3           IF BLANK 
          IX7    X7+X0             ELSE RESET CHAR COUNT
 WTHP     SA3    X2+FETFIT
          SA4    X3 
          ZR     X4,WTH=
          SX6    B6 
          PUT    X3,X6,X7 
          EQ     WTH= 
 VER2     ENDIF 
          EJECT  4                                                      01256584
**        WRCCALL  PROCESS CALL CARD                                    01256586
*                                                                       01256587
*         WRCALL IS CALLED WHEN THE COMPILE FILE IS BEING               01256588
*         WRITTEN AND A CALL CARD IS ENCOUNTERED.  IF THE               01256589
*         CALLED COMMON DECK IS TO BE COPIED TO THE COMPILE             01256590
*         FILE IN RESPONSE TO THE CALL, IT MUST EXIST ON                01256591
*         THE FILE UPDTCDK.  IF IT DOES EXIST ON UPDTCDK,               01256592
*         THERE WILL BE AN ENTRY IN THE TABLE COMIND WHICH              01256593
*         WILL CONTAIN THE NAME AND THE ADDRESS ON UPDTCDK              01256594
*         WHERE IT CAN BE FOUND.  IF THE SPECIFIED COMDECK              01256595
*         IS FOUND, UPDATE COPIES IT TO THE COMPILE FILE.               01256596
*         SINCE A COMDECK CAN BE CALLED FROM ANOTHER                    01256597
*         COMDECK, UPDATE MUST CHECK TO DETERMINE WHETHER               01256598
*         THE PRESENT CALL IS FROM A DECK OR FROM A COMDECK.            01256599
*         IF COMCOUNT IS ZERO, THE CALL IS FROM A DECK,                 01256600
*         AND ALL THAT MUST BE DONE IS TO SAVE THE DECK                 01256601
*         NAME IN TEMP1.  IF THE CALL IS FROM A COMDECK,                01256602
*         COMCOUNT WILL CONTAIN THE RANDOM ADDRESS OF THAT              01256603
*         COMDECK AND A COUNT OF THE NUMBER OF CARDS WHICH              01256604
*         HAVE ALREADY BEEN PROCESSED IN THAT COMDECK.                  01256605
*         THIS INFORMATION IS STORED IN COMBAK SO THAT                  01256606
*         UPDATE CAN RETURN TO PROCESS THE REMAINDER OF                 01256607
*         THE COMDECK.  THE COMDECK NAME IS ALSO SAVED                  01256608
*         IN COMBAK.  IN ANY CASE, THE NEW COMDECK NAME                 01256609
*         IS IN TEMP AND IT MUST BE PLACED IN DNAME FOR                 01256610
*         LISTING PURPOSES.  THEN COMCOUNT IS INITIALIZED               01256611
*         TO CONTAIN THE RANDOM ADDRESS OF THE NEW COMDECK              01256612
*         AND A COUNT OF ZERO.  THE NEW COMDECK IS THEN                 01256613
*         READ, PROCESSED, AND COPIED TO THE COMPILE FILE.              01256614
*         AT THE END OF THE PRESENT COMDECK, A CHECK IS                 01256615
*         MADE TO DETERMINE WHETHER UPDATE SHOULD GO BACK               01256616
*         TO NORMAL PROCESSING OR SHOULD RESTORE AND CON-               01256617
*         TINUE PROCESSING ANOTHER COMDECK.  IF A COMDECK               01256618
*         MUST BE RESTORED, UPDATE OBTAINS THE POSITION                 01256619
*         INFORMATION FROM THE COMBAK ENTRY AND SKIPS                   01256620
*         TO THE NEXT CARD IN THE COMDECK TO BE PROCESSED.              01256621
*         THIS POSITIONING IS DONE BY POSCOM.  OTHERWISE,               01256622
*         THE DECK NAME IS RESTORED AND UPDATE RETURNS                  01256623
*         TO NORMAL PROCESSING THROUGH THE WRCOMPIL EXIT.               01256624
*                                                                       01256625
*         CALLS  CPCLEAR, SCITEM, SRCHCOM, WRCWRITE, ADDWORD, RBIN,     01256626
*                CLASSIFY, WRCOMPFL, POSCOM                             01256627
                                                                        01256628
 WRCCALL  CLEAR  UPDTCDK,READ 
          RJ     SCITEM 
 WRCALLA  RJ     SRCHCOM
          NZ     X4,NOTFOUND       COMMON DECK NOT FOUND, JUMP
          LX6    54 
          SA6    TEMP 
          SA2    A1+B1             IF FOUND PREPARE TO COPY 
          BX6    X2                TO COMPILE FILE
          SA6    UPDTCDK+6
          RJ     WRCWRITE 
          SA1    COMCOUNT 
          ZR     X1,WRCALL7 
          ADDWRD COMBAK,X1
          SA1    DNAME
          ADDWRD COMBAK,X1
*         SEARCH COMBAK FOR CALLED COMMON DECK AND IF PRESENT 
*         ISSUE FATAL DIAGNOSTIC. 
          SA2    F.COMBAK 
          SA1    L.COMBAK 
          SB2    B1+B1
          SB4    B1 
          SB3    X1 
          SA3    TEMP 
SRCHCMB   GE     B4,B3,WRCALL9     IF NOT FOUND 
          SA1    X2+B4
          IX4    X1-X3             CHECK FOR SAME COMMON DECK NAME
          SB4    B4+B2
          NZ     X4,SRCHCMB        LOOP 
          SA1    LISTONE           FOUND
          ZR     X1,WRCALER1       IF LIST OPTION 1 NOT SELECTED
          BX6    X3 
          SA6    RECCALL+3
          PRINT  RECCALL,7
WRCALER1  SA1    ERRMODE
          ZR     X1,ABORT          IF U OPTION NOT SELECTED 
          SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          EQ     WRCOMXIT 
WRCALL9   SA1    TEMP 
          BX6    X1 
          SA6    DNAME
          SA3    UPDTCDK+6
          LX3    30 
          BX6    X3 
          SA6    COMCOUNT 
 WRCALL4  READW  UPDTCDK,SQLGN,1
          NZ     X1,WRCALL5        END OF COMDECK 
          SA5    SQLGN
          MX6    0
          SA6    SQLGN8 
          PL     X5,WRCALL4A
          BX6    -X5               8-BIT CARD 
          SA6    A6 
          MX7    0
          SA7    A5 
          SA5    A6 
 WRCALL4A ZR     X5,WRCALL4B       NULL CARD
          READW  UPDTCDK,A5+B1,X5 
 WRCALL4B READW  UPDTCDK,CARDID,1 
          SX0    B1 
          SA1    COMCOUNT 
          IX6    X1+X0
          SA6    A1 
          MX6    0
          SA6    CARD 
          SA6    CARD8
          SA6    PRINTED
          SB4    SPARLIST 
          RJ     CLASSIFY 
          CLASIFY 
          ZR     X6,WRCALL4C
          CCJUMP TEXT,WRCALTO 
          CCJUMP ENDTEXT,WRCALTE
          CCJUMP CALL,WRCCALL 
          CCJUMP CWEOR,WRCCWEOR 
          CCJUMP WEOR,WRCWEOR 
          CCJUMP WIDTH,WRCWIDTH 
 WRCALL4C BSS    0
          RJ     WRCOMPFL 
          EQ     WRCALL4
WRCALTO   SA1    TXTFLAG           INCREMENT TEXT FLAG
          SX6    X1+B1
          SA6    A1 
          EQ     WRCALL4
WRCALTE   SA1    TXTFLAG           DECREMENT TEXT FLAG
          SX6    X1-1 
          SA6    A1 
          PL     X6,WRCALL4        IF NOT NEG - NO ERROR
          RJ     TXTERR 
          EQ     WRCALL4
          SPACE  1
WRCALL7   SA1    DNAME
          BX6    X1 
          SA6    TEMP2                                                   UPDA164
          EQ     WRCALL9
          SPACE  1
WRCALL5   SA4    L.COMBAK 
          ZR     X4,WRCALL8 
          RJ     POSCOM            SET COMMON DECK POSITION 
          EQ     WRCALL4
          SPACE  2
WRCALL8   MX6    0
          SA1    TEMP2                                                   UPDA164
          LX7    X1 
          SA7    DNAME
          SA6    COMCOUNT 
          EQ     WRCOMPIL 
          EJECT  4                                                      01256630
**        WRCCWEOR,WRCWEOR  PROCESS CWEOR, WEOR CARDS                   01256631
*                                                                       01256632
*         WRCCWEOR IS ENTERED WHEN A CWEOR CARD IS FOUND                01256633
*         DURING THE WRITING OF THE COMPILE FILE.  IF                   01256634
*         WRITING AN AND OF RECORD ON THE COMPILE FILE                  01256635
*         WILL RESULT IN A NULL RECORD, THE E-O-R WILL NOT              01256636
*         BE WRITTEN;  OTHERWISE WRCCWEOR FALLS THROUGH TO              01256637
*         WRCWEOR WHERE ENTRY IS ALSO MADE FOR A WEOR                   01256638
*         CARD.  AN END OF RECORD OF THE LEVEL SPECIFIED                01256639
*         ON THE CWEOR OR WEOR CARD IS WRITTEN ON THE                   01256640
*         COMPILE FILE.                                                 01256641
*                                                                       01256642
*         CALLS  SCNN, WRCWRITE, CALLIO                                 01256643
                                                                        01256644
  
          ENV    ACT,(2,3),VER2 
 CMPWR76  BSSZ   1                 ZERO IF COMP NOT WRITTEN 
* 
 WRCCWEOR SA2    CMPWR76
VER2      ELSE
WRCCWEOR  SA1    COMP              IF THE COMPILE FILE HAS NOT
          SA2    A1+2              BEEN WRITTEN ON AND THE COMPILE
          SA3    A2+B1             BUFFER IS EMPTY,SKIP WRITING 
          SX4    74B               END-OD-RECORD ON CWEOR CARD
          BX1    X1*X4
          SX1    X1-14B 
          ZR     X1,WRCWEOR 
          IX2    X2-X3
VER2      ENDIF 
  
          ZR     X2,WRCWEOR1
WRCWEOR   RJ     SCNN              WRITE END OF RECORD OF LEVEL 
          ENV    ACT,(2,3),VER2 
          SA2    COMP+FETTYPE 
          NZ     X2,WRCWEORA       NOT W TYPE RECORD
          SA3    XMODE
          ZR     X3,WRCWEORA       NOT COMPRESSED FILE
          SA1    COMP+FETFIT
          PUTWP  X1,,0,,,,TERM     TERMINATE W CONTINUATION 
          MX7    0
          SA7    RLCMPL            RESET PARTIAL LENGTH 
 VER2      ENDIF
 WRCWEORA BSS 
          SB7    X6-17B            NOT GREATER THAN 17B 
          NG     B7,WRCWEOR2
  
          ENV    ACT,(2,3),VER2 
          WRITEF COMP 
          EQ     WRCWEOR3 
 WRCWEOR2 WRITER COMP 
 WRCWEOR3 MX6    0
          SA6    CMPWR76
VER2      ELSE
          WRITEF COMP,R 
          EQ     WRCWEOR0 
WRCWEOR2  LX6    14 
          WRITER COMP,RECALL,X
VER2      ENDIF 
 WRCWEOR0 CLEAR  COMP,WRITER       FORCE NEW 77-TABLE 
  
WRCWEOR1  RJ     WRCWRITE 
 WRCWEORX MX1    0
          SA3    COMCOUNT 
          ZR     X3,WRCOMPIL
          EQ     WRCALL4
          EJECT  4                                                      01256646
**        NOTFOUND  PROCESS UNFOUND COMMON DECK                         01256647
*                                                                       01256648
*         ENTRY IS MADE AT NOTFOUND WHEN THE COMDECK SPE-               01256649
*         CIFIED ON A CALL CARD IS NOT FOUND IN THE UPDTCDK             01256650
*         INDEX.  IF XFLAG IS NON-ZERO, THIS IS THE SECOND              01256651
*         SEARCH AND THE COMDECK IS SIMPLY NOT TO BE FOUND.             01256652
*         OTHERWISE, A SEARCH IS MADE OF THE DECK LIST TO               01256653
*         DETERMINE WHETHER OR NOT THE SPECIFIED COMDECK                01256654
*         IS YET TO BE PROCESSED.  IF IT IS NOT FOUND IN                01256655
*         THE DECK LIST, UPDATE GIVES UP.  IF IT IS FOUND,              01256656
*         Q MODE HAS BEEN SELECTED, AND THE OLDPL IS RANDOM,            01256657
*         THE NAME OF THE COMDECK IS ADDED TO THE LIST OF               01256658
*         DECKS TO BE PROCESSED SO THAT IT WILL EVENTUALLY              01256659
*         GET TO UPDTCDK WHERE IT HAS TO BE COPIED TO                   01256660
*         COMPILE.  AT THIS TIME, THE WRITING OF THE COMPILE            01256661
*         FILE MUST BE SUSPENDED SO THE PROPER FLAGS ARE                01256662
*         SET TO WRITE THE REMAINING CARDS TO UPDTSCR                   01256663
*         UNTIL THE NECESSARY COMDECK IS AVAILABLE.                     01256664
*                                                                       01256665
*         CALLS  CRDKLIS, ADDWORD, CPCLEAR                              01256666
                                                                        01256667
 NOTFOUND BSS 
          SA1    YFLAG
          NZ     X1,WRCALERR
          SA1    CREFLG 
          NZ   X1,WRCALERR         ERROR IF CREATION RUN
          SA1    F.DECKS
          SA2    L.DECKS
          SB3    X2-2 
          SA2    X1 
          SB2    B1+B1
NFOUNDL   SA2    A2+B2
          BX4    X7-X2
          AX4    6
          SB3    B3-B2
          LX2    59-3                                                    CP190
          NG     X2,NFOUNDL2       IF DECK BIT SET.                      CP190
          ZR     X4,FOUNDCDK
NFOUNDL2  PL     B3,NFOUNDL                                              CP190
          EQ     WRCALERR 
          SPACE  1
FOUNDCDK  SA4    FMODE
          NZ     X4,FOUNDCD2
          SA1    FASTFLG
          ZR     X1,FOUNDCD2
          SA1    RANDOPL
          ZR     X1,FOUNDCD1
          BX1    X7 
          RJ     CRDKLIS           PUT CALLED COMDECK IN DKLIS
          ZR     X2,NFOUNDCD
          PL     X2,FOUNDCD4
NFOUNDCD  SX3    4                 IF UNFOUND DECK, SET BIT 
          BX6    X6+X3             TWO OF ENTRY TO INDICATE 
          SA6    A6                THAT FACT AND PREVENT INVALID RANGE
          SA1    FASTFLG           FROM CAUSING ERRONEOUS ERRORS. 
          PL     X1,FOUNDCD2
          PL     X2,NFDCD1         IF NOT FAKEOUT ENTRY 
          LX2    58 
          PL     X2,FOUNDCD2   IF DECK HAS NOT BEEN PROCESSED 
  
*         IF DECK HAS BEEN PREVIOUSLY PROCESSED 
*         SQUEEZE ITS *DKLIS* ENTRY OUT AND MOVE IT 
*         TO THE END OF *DKLIS*.
  
          SX3    A6          DESTINATION ADDRESS FOR MOVE 
          SA1    F.DKLIS
          SA2    L.DKLIS
          IX4    X1+X2
          SX2    A6+B1       SOURCE ADDRESS FOR MOVE
          LX0    X6 
          SA0    X4 
          IX1    X4-X3       NUMBER OF WORDS TO BE MOVED
          MOVE   X1,X2,X3 
          BX6    X0 
          SA6    A0-B1       PUT ENTRY AT END OF *DKLIS*
NFDCD1    SA1    WORKLGTH 
          SX6    X1+B1
          SA6    A1 
          EQ     FOUNDCD2 
          SPACE  2
FOUNDCD1  MX6    1
          SA6    WORKLGTH 
FOUNDCD2  SX6    B1 
          SA6    QRANDFLG 
FOUNDCD4  SX6    B1 
          SA1    IDFLG
          SA6    WRSCRACH 
          SA6    XFLAG
          RJ     CRDKLIS
          NZ     X2,FOUNDCD3       ALREADY IN LIST
          SA2    A6                RESTORE ENTRY ADDRESS
FOUNDCD3  SA2    A2 
          SX0    11B
          BX7    X2+X0             IF WE ARE WRITING A COMPILE FILE 
          SA1    L.COMPFL          AND WE ENCOUNTER A CALL TO A COMDECK 
          ZR     X1,FOUNDCD5 IF NO ENTRIES
          SX6    X1-1              WHICH WE HAVE NOT YET PROCESSED, 
          SA6    A1                MAKE SURE THAT WE PROCESS IT AND SKIP
FOUNDCD5  SA1    IDFLG       WRITING COMPILE UNTIL WE HAVE. 
          SA7    A2 
          ADDWRD SCRIND,X1
          CLEAR  UPDTSCR,WRITE
          SX6    SCRLOC 
          SA6    UPDTSCR+6
          SA3    COMCOUNT 
          ZR     X3,WRSCR1    NOT A COMMON DECK UNDERNEATH
          SX6    B1 
          IX1    X3-X6
          ADDWRD COMBAK,X1
          SA1    DNAME
          ADDWRD COMBAK,X1
          EQ     WRCOMXIT 
          SPACE  2
                                                                         CP190
WRCALERR  SB4    B0                                                      CP190
          SA6    BLKFILL           STORE BLANK FILLED COMDECK NAME.      CP190
          MX6    0                                                       CP190
          SA6    PHLAG                                                   CP190
 TOP      SA2    F.CDKTBL          OBTAIN ORIGIN OF COMDECK TABLE.
          SA1    L.CDKTBL          OBTAIN LENGTH OF TABLE                CP190
          SB2    B1+B1             SET B2 EQUAL TO TWO.                  CP190
          MX0    54                MAKE MASK                             CP190
          SB3    X1                PUT TABLE LGTH INTO B3.               CP190
LUPE      GE     B4,B3,NOMTCH      NO MATCH.                             CP190
          SA1    X2+B4             GET NEXT ENTRY FROM TABLE.            CP190
          BX6    X0*X1             ISOLATE COMDECK NAME.                 CP190
          BX4    X7-X6             COMPARE NAMES.                        CP190
          SB4    B4+B2             INCREMENT INDEX.                      CP190
          NZ     X4,LUPE           NOT A MATCH.                          CP190
                                                                         CP190
          SX7    B4                PUT TABLE POINTER INTO TBLPTR INCASE  CP190
          SA7    TBLPTR            TABLE SEARCH HAS TO BE RESUMED.       CP190
          SA6    SCDKNM            STORE COMDECK NAME.                   CP190
          MX1    30                FORM MASK.                            CP190
          SA2    A1+B1             GET INDEX/RA WORD.                    CP190
          BX7    -X1*X2            GET RANDOM ADDRESS.                   CP190
          LX2    30                SHIFT PL ADDRESS AROUND.              CP190
          BX4    -X1*X2            GET PL INDEX.                         CP190
          SA4    X4                GET PL NAME, USING INDEX.             CP190
          SX1    3                 FORM THE COMPLETE BIT.                CP190B 
          MX2    42                MASK FOR SECONDARY OLDPL NAME.        CP190B 
          BX3    X2*X4             OBTAIN SECONDARY OLDPL NAME.          CP190B 
          BX6    X3+X1             ADD COMPLETE BIT TO NAME.             CP190B 
          SA6    OLDPL2            PUT PL NAME INTO FET.                 CP190
          BX6    -X2*X4            OBTAIN OFFSET VALUE.                  CP190B 
          SA6    OFFSET            STORE DIRECT TABLE OFFSET VALUE.      CP190B 
          SA7    OLDPL2+6          PUT RANDOM ADDRESS INTO FET.          CP190
          OPEN   OLDPL2,READ                                             CP190
          CLEAR  OLDPL2,READ       SET IN AND OUT TO FIRST. 
          SA2    PHLAG             IF COLUMN, CHAR, SQLGN AND            CP190
          NZ     X2,DUNT           SQIMAGE ALREADY STORED.               CP190
          SA2    COLUMN                                                  CP190
          LX6    X2                                                      CP190
          SA6    A2+B1             PUT COLUMN INTO TCOL                  CP190
          SA3    CHAR                                                    CP190
          BX6    X3                                                      CP190
          SA6    A3-B1             PUT CHAR INTO TEMP STOREAGE.          CP190
          SA1    SQLGN                                                   CP190
          MOVE   X1+1,A1,TSQLGN 
          SA1    CARDID 
          BX6    X1 
          SA6    TCARDID
DUNT      MX7    30                SET PHLAG                             CP190
          SA7    PHLAG                       NON-ZERO.                   CP190
          RJ     ROPLL2            READ CARD FROM 2NDARY OLDPL.          CP190
          SA1    STAT              OBTAIN STATUS OF CARD JUST READ.      CP190
          PL     X1,RESUME         RESUME SEARCH, *COMDECK INACTIVE.     CP190
          SB4    B1+B1             SET TO SEARCH FOR DECK, COMDECK.      UPDA165
          RJ     CLASSIFY                                                UPDA165
          CLASIFY                                                        UPDA165
          CCJUMP COMDECK,SKIP3     IF COMDECK CARD.                      UPDA165
          EQ     RESUME            IF NOT *COMDECK, RESUME SEARCH.       UPDA165
                                                                         UPDA165
SKIP3     SA1    BLKFILL           FETCH COMDECK NAME.                   UPDA165
          LX1    54                SHIFT IT AROUND FOR PRINTING.         UPDA165
          SA2    DNAME             FETCH CURRENT DECK NAME.              UPDA165
          BX6    X1                PUT COMDECK NAME INTO X6 AND          UPDA165
          SA6    A2                STORE IT INTO DNAME.                  UPDA165
          LX7    X2                PUT CURRENT DNAME INTO X7 AND         UPDA165
          SA7    TEMP3             STORE IT INTO TEMP3.                  UPDA165
          CLEAR  UPDTCDK,WRITE     RESET POINTERS(IN AND OUT TO FIRST)
          SX7    COMLOC                                                  CP190
          SA7    UPDTCDK+6                                               CP190
NXCARD    BSS    0                                                       CP190
          RJ     ROPLL2            READ NEXT CARD FROM 2NDARY PL.        CP190
          NZ     X1,ENDCDK         IF EOR READ.                          CP190
          SA2    STAT              FETCH STATUS OF CARD JUST READ.       CP190
          PL     X2,NXCARD         IF CARD IS INACTIVE.                  CP190
          SA2    OFFSET            FETCH OFFSET VALUE.                   CP190B 
          SA3    ORD               OBTAIN IDENT ORDINAL AND              CP190B 
          IX2    X2+X3             OFFSET IT BY THE OFFSET VALUE.        CP190B 
          SA3    SEQNUM2           FETCH THE CARD SEQUENCE NUMBER.       CP190B 
          LX3    30                PUT SEQUENCE NUMBER IN UPPER BITS.    CP190B 
          BX6    X2+X3             PUT SEQ NUM AND ORDINAL IN 1 WORD.    CP190B 
          SA6    CARDID 
          SB4    SPARLIST          LENGTH OF TABLE TO BE SEARCHED.       UPDA165
          RJ     CLASSIFY                                                UPDA165
          CLASIFY                                                        UPDA165
          CCJUMP ENDIF,WENDIF      IF ENDIF CARD READ.                   UPDA165
          SA2    QUALIF            FETCH SKIP COUNT.                     UPDA165
          NZ     X2,DECRE          IF IF COUNT IN PROGRESS.              UPDA165
          CCJUMP IF,WIF            IF *IF CARD READ.                     UPDA165
 WIT      SA1    SQLGN8 
          ZR     X1,WIT.1          NOT 8-BIT
          BX7    -X1
          SA7    A1                8-BIT FLAG 
          EQ     WIT.2
 WIT.1    SA1    SQLGN             6-BIT
 WIT.2    WRITEW  UPDTCDK,A1,X1+B1  WRITE CARD IMAGE
          WRITEW  X2,CARDID,1 
          EQ     NXCARD            GO GET ANOTHER ONE.                   CP190
                                                                         CP190
ENDCDK    SA1    SCDKNM            FETCH COMDECK NAME.                   CP190
          ADDWRD COMIND,X1         ADD NAME TO COMIND (UPDTCDK INDEX) 
          WRITER UPDTCDK,RECALL                                          CP190
          SA1    COMLOC            GET RANDOM ADDRESS.                   CP190
          ADDWRD COMIND,X1         PUT RANDOM ADDRESS INTO TABLE
          CLEAR  UPDTCDK,READ 
          RJ     RSTPTRS           RESET POINTERS, SQLGN, AND SQIMAGE.   CP190
          SA2    TEMP3             FETCH DECKNAME AND                    UPDA165
          BX6    X2                PUT IT BACK INTO                      UPDA165
          SA6    DNAME             DNAME FOR PRINTING.                   UPDA165
          SA2    BLKFILL           RETRIEVE BLK FILLED COMDECK NAME.     CP190
          BX6    X2                PUT NAME IN X6 FOR FURTHER USE.       CP190
          SA2    SCDKNM            FETCH COMDECK NAME.                   CP190
          BX7    X2                PUT COMDECK NAME INTO X7.             CP190
          EQ     WRCALLA
                                                                         CP190
RESUME    SA4    TBLPTR            PREPARE TO RESUME SEARCHING THE       CP190
          SA3    SCDKNM            FETCH COMDECK NAME WE ARE             CP190
          BX7    X3                SEARCHING FOR AND PUT INTO X7.        CP190
          SB4    X4                COMMOM DECK TABLE WHERE WE LAST       CP190
          EQ     TOP               LEFT OFF.                             CP190
          SPACE  3                                                       CP190
NOMTCH    SA1    PHLAG                                                   CP190
          ZR     X1,NOWAY                                                CP190
          RJ     RSTPTRS           RESET POINTERS, SQLGN, AND SQIMAGE.   CP190
NOWAY     SA1    LISTONE                                                 CP190
          ZR     X1,WRCALER2
          SB7    L.IDW
          RJ     FORMATCX 
          RJ     ADDIDL 
          PRNTCARD
          PRINT  (0*** THE ABOVE CALLED COMMON DECK WAS NOT FOUND ***)
WRCALER2  BSS    0
          SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
          SA1    COMCOUNT                                                UPDA149
          ZR     X1,WRCOMXIT
          ADDWRD COMBAK,X1         ELSE PREPARE TO RESTORE FET POINTERS 
          SA1    DNAME             TO NEXT CARD IN THE CALLING COMDECK.  UPDA149
          ADDWRD COMBAK,X1
          EQ     WRCALL5           FINISH COPYING THE CALLING COMDECK.   UPDA149
          SPACE  2                                                       UPDA165
WENDIF    RJ     WRCWRITE          WRITE ENDIF CARD TO OUTPUT.           UPDA165
          SA2    QUALIF            FETCH SKIP COUNT.                     UPDA165
          NG     X2,NEXT           IF INDETERMINATE COUNT SPECIFIED.     UPDA165
          NZ     X2,DECRE          IF COUNT WAS SPECIFIED.               UPDA165
NEXT      MX6    0                                                       UPDA165
          SA6    A2                SET QUALIF TO ZERO.                   UPDA165
          EQ     NXCARD            GO READ ANOTHER CARD.                 UPDA165
          SPACE  2                                                       UPDA165
DECRE     SX6    X2-1              DECREMENT QUALIF BY ONE AND           UPDA165
          SA6    A2                PUT BACK INTO QUALIF.                 UPDA165
          EQ     NXCARD            GO READ ANOTHER CARD.                 UPDA165
          SPACE  2                                                       UPDA165
WIF       BX6    X1                PREPARE TO SET FROMSCD NON ZERO       UPDA165
          SA6    FROMSCD           AND DO IT.                            UPDA165
          EQ     WRCIF             RUN OFF TO PROCESS THE *IF.           UPDA165
          EJECT  4                                                      01256669
**        WRCDECK  PROCESS DECK CARD WHILE WRITING COMPILE FILE         01256670
*                                                                       01256671
*         WRCDECK IS ENTERED WHENEVER A DECK CARD IS EN-                01256672
*         COUNTERED DURING INITIAL COMPILE FILE PROCESSING.             01256673
*         COPYEND IS CALLED TO TERMINATE WHATEVER PREVIOUS              01256674
*         ACTION WAS BEING DONE ON COMPILE, UPDTCDK, OR                 01256675
*         UPDTSCR.  UPDATE THEN CHECKS TO SEE WHERE (COMPILE            01256676
*         OR UPDTSCR) THE NEW DECK SHOULD BE WRITTEN AND                01256677
*         SETS APPROPRIATE FLAGS.                                       01256678
*                                                                       01256679
*         CALLS  COPYEND, ADDWORD, CRDKLIS                              01256680
                                                                        01256681
WRCDECK   RJ     COPYEND
          SA1    IDFLG
          SA4    XFLAG
          NZ     X4,WRCDECK2
          SA3    FMODE
          NZ     X3,WRCOM1         IF F MODE OR Q RANDOM (NO N OR S)
          SA5    ORDERFLG 
          SA2    F.DKLIS
          SB2    -B1
          SA3    L.DKLIS
          SA2    X2+B2
WRDLOOP   ZR     X3,WRCDECK2       IF THIS IS THE 
          SA2    A2+B1             NEXT DECK IN THE 
          SX3    X3+B2             LIST OF DECKS TO BE
          LX2    58                WRITTEN TO THE 
          NG     X2,WRDLOOP        COMPILE FILE, GO AHEAD 
          LX2    1                 AND PUT IT THERE 
          PL     X2,WRDLOOP 
          LX2    1
          BX0    X2-X1
          AX0    6                 SHIFT OFF GARBAGE
          NZ     X0,WRCDECK1
          SX0    B1 
          BX6    -X0*X2 
          SA6    A2 
          EQ     WRCOM1 
          SPACE  1
WRCDECK1  ZR     X5,WRDLOOP 
WRCDECK2  BSS    0
          BX6    X1                SET FLAG TO INDICATE WRITING TO
          SA6    WRSCRACH          SCRATCH FILE 
          ADDWRD SCRIND,X1         ADD NAME TO SCRATCH INDEX
          SX6    SCRLOC 
          SA6    UPDTSCR+6
          SA4    XFLAG
          ZR     X4,WRCOM          EXIT IF FLAG NOT SET 
          SA1    FMODE             OR IF F MODE                         0014  44
          ZR     X1,WRCOM                                               0014  45
          SA1    IDFLG
          RJ     CRDKLIS
          NZ     X2,WRCDECK3       ALREADY IN LIST
          SA2    A6 
WRCDECK3  SA2    A2 
          SX0    11B               SET BIT SO WE DONT TRY TO DO THIS
          BX7    X2+X0             THE NEXT TIME AROUND 
          SA7    A2 
          EQ     WRCOM
          SPACE  4                                                      01256683
**        WRCEIF PROCESS ENDIF                                          01256684
*                                                                       01256685
*         WRCEIF IS CALLED IN RESPONSE TO AN ENDIF CARD.                01256686
*         ANY ACTIVE IF IS TERMINATED BY SETTING QUALIF                 01256687
*         TO ZERO.                                                      01256688
*                                                                       01256689
*         CALLS  WRCWRITE                                               01256690
                                                                        01256691
WRCEIF    SA2    QUALIF 
          NG     X2,WRCEIF0        IF AN INDEFINITE COUNT SPECIFIED 
          NZ     X2,WRCOM2         IF WE HAVE AN UNEXHAUSTED SKIP COUNT 
WRCEIF0   BSS    0
          MX6    0
          SA6    A2                ZERO THE SKIP COUNT
          EQ     WRCOMA 
          SPACE  1
WRCEIF1   RJ     WRCWRITE 
          EQ     WRCOM
          SPACE  4                                                      01256693
**        WRCIF  PROCESS IF                                             01256694
*                                                                       01256695
*         WRCIF IS CALLED IN RESPONSE TO AN IF CARD.  THE               01256696
*         CONDITIONS ON THE CARD ARE TESTED AND, IF FALSE,              01256697
*         QUALIF IS SET TO NON-ZERO.  QUALIF WILL BE NEGATIVE           01256698
*         IF AN INDEFINITE SKIP RANGE IS SPECIFIED OR PO-               01256699
*         SITIVE IF A SPECIFIC NUMBER OF CARDS IS TO BE                 01256700
*         SKIPPED.  IF POSITIVE QUALIF WILL CONTAIN THE                 01256701
*         ACTUAL NUMBER OF CARDS WHICH ARE TO BE SKIPPED.               01256702
*                                                                       01256703
*         CALLS  WRCWRITE, SCITEM, GETCH, CHKDCKS, TLUDIR, SCNN, WBIN   01256704
                                                                        01256705
          SPACE  1
WRCIF     RJ     WRCWRITE 
          RJ     SCITEM 
          ZR     X7,WRCOMB         SKIP IF NONE 
          SA1    =6L-IDENT
          SX6    B1 
          BX0    X7-X1
          ZR     X0,WRCIF1         -IDENT X6=1
          SA1    =5LIDENT 
          LX6    1
          BX0    X7-X1
          ZR     X0,WRCIF1         IDENT X6=2 
          SA1    =4L-DEF
          LX6    1
          BX0    X7-X1
          ZR     X0,WRCIF1         -DEF X6=4
          SA1    =3LDEF 
          LX6    1
          BX0    X7-X1
          ZR     X0,WRCIF1         DEF  X6=10B
          SA1    =5L-DECK 
          MX6    1
          BX0    X7-X1
          ZR     X0,WRCIF1         -DECK X6=- 
          SA1    =4LDECK
          MX6    2
          BX0    X7-X1
          NZ     X0,WRCOMB         NOT KNOWN IDENTIFIER 
WRCIF1    SA1    CHAR 
          SB7    X1-1R, 
          NZ     B7,WRCOMB         SKIP IF NO COMMA 
          SA6    QUALIF 
          RJ     GETCH
          RJ     SCITEM            FETCH IDENT NAME 
          SA1    QUALIF 
          MX6    0
          SA6    A1 
          ZR     X7,WRCOMB         SKIP IF NO IDENT 
          PL     X1,WRCIF2
          RJ     CHKDCKS           CHECK FOR DECK 
          LX1    1
          ZR     X0,WRCIF5         DECK FOUND 
          PL     X1,WRCOME         -DECK SATISFIED.                      UPDA165
          EQ     WRCIF3 
          SPACE  1
WRCIF5    NG     X1,WRCOME         DECK SATISFIED.                       UPDA165
          EQ     WRCIF3 
          SPACE  1
WRCIF2    SB5    X1 
          AX1    2
          NZ     X1,WRCIF6
          SA2    ORGLGTH           GET ORIGINAL LENGTH OF L.DIRECT.      UPDA165
          BX6    X2                PREPARE TO STORE VALUE.               UPDA165
          SA1    L.DIRECT          FETCH CURRENT DIRECT LENGTH.          UPDA165
          SA6    A1                PUT ORIGINAL LENGTH IN L.DIRECT.      UPDA165
          RJ     TLUDIR            CHECK FOR IDENT
          LX6    X1                                                      UPDA165
          SA6    A1                PUT L.DIRECT BACK IN L.DIRECT.        UPDA165
          EQ     B5,B1,WRCIF4 
          NZ     X2,WRCOME         IDENT SATISFIED.                      UPDA165
          EQ     WRCIF3 
          SPACE  1
WRCIF4    ZR     X2,WRCOME         -IDENT SATISFIED.                     UPDA165
WRCIF3    SA1    CHAR 
          SB7    X1-1R, 
          MX6    1
          SA6    QUALIF            SET INDEFINITE IF RANGE
          NZ     B7,WRCOME         NO CARD COUNT.                        UPDA165
          RJ     GETCH             SKIP COMMA 
          RJ     SCNN              GET COUNT
          SA6    QUALIF            SET COUNT
          EQ     WRCOME                                                  UPDA165
          SPACE  1
WRCIF6    AX2    X1,B1
          SB5    -B1
          SA1    L.DEFTAB 
          SA3    F.DEFTAB 
          SX6    B1 
WRCIF8    ZR     X1,WRCIF4         NOT DEFINED
          IX0    X3+X1
          SA4    X0+B5             LOOK AT NEXT ENTRY 
          IX1    X1-X6             DECREMENT LENGTH 
          BX0    X7-X4
          NZ     X0,WRCIF8         NOT A MATCH
          NZ     X2,WRCOME         DEF SATISFIED.                        UPDA165
          EQ     WRCIF3 
          SPACE  2                                                       UPDA165
WRCOMB    SA2    FROMSCD           RETURN TO WHERE FLAG.                 UPDA165
          ZR     X2,WRCOMB1        IF CONTROL CAME FROM WRCOM.           UPDA165
          MX6    0                 SET FROMSCD                           UPDA165
          SA6    A2                            TO ZERO.                  UPDA165
          EQ     WIT               RETURN TO 2NDARY PL ROUTINE.          UPDA165
          SPACE  2                                                       UPDA165
WRCOME    SA2    FROMSCD           RETURN TO WHERE FLAG.                 UPDA165
          ZR     X2,WRCOM          IF CONTROL CAME FROM WRCOM.           UPDA165
          MX6    0                 SET FROMSCD                           UPDA165
          SA6    A2                            TO ZERO.                  UPDA165
          EQ     NXCARD            RETURN TO 2NDARY PL ROUTINE.          UPDA165
          EJECT  4                                                      01256707
**        WRCMPSCR  WRITE TO UPDTSCR                                    01256708
*                                                                       01256709
*         WRCMPSCR IS CALLED TO WRITE A SQUEEZED CARD                   01256710
*         IMAGE TO WHICH A DIRECTORY ORDINAL AND A SEQUENCE             01256711
*         NUMBER HAVE BEEN ATTACHED, TO THE SCRATCH FILE                01256712
*         UPDTSCR.                                                      01256713
*                                                                       01256714
*         CALLS  WBIN                                                   01256715
                                                                        01256716
WRCMPSCR  BSS    1                 WRITE CMPSCR IN SQUEEZED FORMAT
  
          ENV    ACT,(2,3),VER2 
          SA1    UPDTSCR+FETFIT 
          SA1    X1 
          NZ     X1,WRCMPSC2
          OPEN   UPDTSCR,WRITE
 WRCMPSC2 BSS 
VER2      ENDIF 
  
          SA4    CURCARD           WHERE THE FIRST WORD IS THE LENGTH 
          SA5    SQLGN8            AND THE FLAG IN CURCARD. 
          BX6    -X5               NEGATIVE FOR 8-BIT 
          NZ     X5,WRCMPS.1
          SA5    SQLGN
          BX6    X5                POSITIVE FOR 6-BIT CARD
 WRCMPS.1 BSS    0                 THE LAST 
          LX4    30                WORD IS THE IDENT ORDINAL AND THE
          BX6    X6-X4             SEQUENCE NUMBER
          SA6    A5 
          WRITEW  UPDTSCR,A5,X5+1 
          WRITEW  X2,CARDID,1 
          EQ     WRCMPSCR 
          SPACE  4
**        WRCOM  WRITE COMPILE FILE                                     01256718
*                                                                       01256719
*         WRCOM IS THE MASTER ROUTINE CALLED TO EFFECT                  01256720
*         THE WRITING OF THE COMPILE FILE (OR WHAT WILL                 01256721
*         EVENTUALLY BE WRITTEN TO THAT FILE, I.E., IN-                 01256722
*         FORMATION TEMPORARILY WRITTEN TO UPDTSCR OR                   01256723
*         UPDTCDK). DECK, COMDECK, IF, AND ENDIF CARDS                  01256724
*         ARE SORTED OUT HERE AND THE APPROPRIATE PRO-                  01256725
*         CESSOR CALLED.  FOR ALL CARDS, EXCEPT DECK AND                01256726
*         COMDECK, THE DIRECTORY ORDINAL AND THE SEQUENCE               01256727
*         NUMBER ARE PLACED IN -CARDID-.  FLAGS ARE 
*         CHECKED AND THE CARD IS PROCESSED BY THE APPRO-               01256730
*         PRIATE ROUTINE TO THE COMPILE, UPDTSCR, OR                    01256731
*         UPDTCDK FILE.                                                 01256732
*                                                                       01256733
*         CALLS  CLASSIFY, WRCOMPIL, ADDWORD                            01256734
                                                                        01256735
WRCOM     BSS    1
          SA1    COMP 
          ZR     X1,WRCOM          NO COMPILE FILE TO BE WRITTEN
          CLASIFY 1 
          CCJUMP ENDIF,WRCEIF 
          SA2    QUALIF 
          NZ     X2,WRCOM2
          CCJUMP COMDECK,WRCOMDK
          CCJUMP DECK,WRCDECK 
WRCOMA    SA4    CHBTAB 
          MX2    44 
          BX3    -X2*X4 
          SA2    SEQNUM 
          LX2    30                THE IDENT ORDINAL AND SEQUENCE 
          BX6    X2+X3             NUMBER ARE STORED IN THE WORD IN 
          SA6    CARDID 
          CLASIFY                                                       0007  31
          CCJUMP IF,WRCIF 
          CCJUMP ENDIF,WRCEIF1
WRCOMB1   SA1    COMFLG                                                  UPDA165
          NZ     X1,WRCOMDKS       JUMP IF PROCESSING A COMDECK 
          SA1    WRSCRACH 
          NZ     X1,WRSCR          JUMP IF WRITING TO SCRITCH.
          RJ     WRCOMPIL          WRITE TO COMPILE.
          EQ     WRCOM
          SPACE  1
 WRCOM1   ADDWRD COMPFL,X1
          EQ     WRCOM
          SPACE  1
WRCOM2    SX6    X2-1 
          SA6    A2 
          EQ     WRCOM             DECREMENT SKIP COUNT 
          SPACE  1
WRCOMXIT  SA1    ORDERFLG 
          ZR     X1,WRCOM 
          EQ     WRCOMPIL 
          SPACE  4                                                      01256737
**        WRCOMDK  PROCESS COMDECK CARD WHILE WRITING COMPILE FILE      01256738
*                                                                       01256739
*         WRCOMDK IS ENTERED IN RESPONSE TO A COMDECK                   01256740
*         CARD ENCOUNTERED BY THE ROUTINE WRCOM.  THIS                  01256741
*         ROUTINE SETS THE FLAG COMFLG TO INDICATE THAT                 01256742
*         THE FOLLOWING CARDS SHOULD BE WRITTEN TO UPDTCDK              01256743
*         AND SETS UP THE INDEX ENTRY IN THE UPDTCDK FET                01256744
*         FOR THE CURRENT COMDECK.                                      01256745
*                                                                       01256746
*         CALLS  COPYEND, ADDWORD, GETCH, SCITEML                       01256747
                                                                        01256748
WRCOMDK   RJ     COPYEND
          SA1    IDFLG             ADD DECK ID TO COMMON INDEX
          ADDWRD COMIND,X1
          BX6    X3 
          SA1    CHAR 
          SA6    COMFLG            SET COMMON DECK FLAG 
          SX1    X1-1R, 
          NZ     X1,WRCOMDK1       JUMP NOT POSSIBLE NOPROP 
          RJ     GETCH             SKIP COMMA 
          RJ     SCITEML
          SA1    =0LNOPROP
          IX6    X7-X1             IF THIS IS A NON-PROPAGATING 
WRCOMDK1  SA6    NOPROP            COMDECK THIS FLAG WILL BE ZERO 
          SX7    COMLOC 
          SA7    UPDTCDK+6         SET RANDOM INDEX 
          CLEAR  UPDTCDK,WRITE
          SA1    IDFLG             PICK UP THE COMMON DECK NAME 
          RJ     CRDKLIS           FIND COMMON DECK-S DKLIS ENTRY 
          MX7    1
          SA2    A2                RELOAD THE COMDECK-S DKLIS ENTRY 
          LX7    4
          BX7    X7+X2             SET THE COMMON DECK-S COMPLETE BIT 
          SA7    A2 
          EQ     WRCOM
          EJECT  4                                                      01256750
**        WRCOMDKS  WRITE CARD TO UPDTCDK                               01256751
*                                                                       01256752
*         THIS ROUTINE IS CALLED TO ACTUALLY WRITE A CARD               01256753
*         TO UPDTCDK.  THE ONLY SPECIAL PROCESSING DONE                 01256754
*         IS TO RECOGNIZE CALL CARDS AND PERFORM ONE OF                 01256755
*         TWO ACTIONS WHEN A CALL IS FOUND:  1.  IF UPDATE              01256756
*         IS IN Q MODE, WRQCHECK IS CALLED (SEE BELOW).                 01256757
*         2.  IF NOT IN Q OF IN F MODE, WRCHMOD IS CALLED.              01256758
*                                                                       01256759
*         CALLS  CLASSIFY, WBIN, WRCHMOD                                01256760
                                                                        01256761
WRCOMDKS  CLASIFY 
          CCJUMP CALL,WRCOMDK2
 WRCOMDK9 SA1    SQLGN8 
          BX6    -X1
          SA6    A1 
          NZ     X1,WRCOMDK8
          SA1    SQLGN
 WRCOMDK8 WRITEW  UPDTCDK,A1,X1+1 
          WRITEW  X2,CARDID,1 
          EQ     WRCOM
          SPACE  1
WRCOMDK2  SA1    FASTFLG
          NZ     X1,WRCOMDK3       Q MODE 
          SA1    FMODE
          NZ     X1,WRCOMDK9       F MODE 
          RJ     WRCHMOD
          EQ     WRCOMDK9 
          SPACE  1
WRCOMDK3  RJ     WRQCHECK 
          EQ     WRCOMDK9 
          SPACE  4                                                      01256763
**        WRCHMOD  PROCESS MODIFIED COMMON DECKS                        01256764
*                                                                       01256765
*         SINCE, IN THIS MODE, A MODIFICATION TO A COMMON               01256766
*         DECK MUST BE PROPAGATED TO ALL DECKS AND COMDECKS             01256767
*         WHICH CALL IT, THE CALLED COMDECK IS CHECKED                  01256768
*         AND IF THE MODIFICATION BIT IS ON, MODFLG IS                  01256769
*         TURNED ON, SO THAT THE CURRENT COMDECK WILL HAVE              01256770
*         ITS MODIFICATION BIT SET.                                     01256771
*                                                                       01256772
*         CALLS  SCITEM                                                 01256773
                                                                        01256774
WRCHMOD   PS
          RJ     SCITEM            GET COMDECK NAME 
          SA1    L.COMIND          SEE IF CALLED COMMON DECK HAS
          SA2    F.COMIND          BEEN MODIFIED AND SET MODFLG IF
          SB4    X1                IT HAS.
          SX6    B1+B1
          SB5    B0 
          BX7    X7+X6
WRCHMOD1  GE     B5,B4,WRCHMOD
          SA4    X2+B5
          BX0    X7-X4
          SB5    B5+2 
          NZ     X0,WRCHMOD1
          SA6    MODFLG 
          EQ     WRCHMOD
          EJECT  4                                                      01256776
**        WRCOMPFL  WRITES CARD IMAGE TO COMPILE                        01256777
*                                                                       01256778
*         WRCOMPFL WRITES A CARD IMAGE TO COMPILE AFTER                 01256779
*         DETERMINING THE LENGTH AND MODE (SQUEEZED OR EX-              01256780
*         PANDED) TO BE WRITTEN.                                        01256781
*                                                                       01256782
*         CALLS  UCARD, FORMATCD, WBIN, WDEC                            01256783
                                                                        01256784
WRCOMPFL  BSS    1
          SA1    COMP 
          ZR     X1,WRCOMPFL       NO FILE
  
          ENV    ACT,(2,3),VER2 
          SX6    B1 
          SA6    CMPWR76
VER2      ENDIF 
  
          SA1    XMODE
          ZR     X1,NOTX
          SB7    17                17 CHAR IDENT
          RJ     FORMATCX          BUILD IDENT WORDS
          SA1    COMP              CHECK FILE STATUS
          SA2    A1+2              IN 
          SA3    A2+B1             OUT
          IX3    X2-X3
          NZ     X3,YESX1          BUFFER NOT EMPTY 
          SX2    30B
          BX1    X2*X1             CHECK EOR STATUS 
          SX1    X1-10B 
          ZR     X1,YESX1          NOT NEW RECORD 
          MX6    6                 PUT OUT 77 HEADER
          SA6    TCWBIN 
  
          ENV    ACT,(2,3),VER2 
          SA1    COMP+FETFIT
          PUTWP  X1,TCWBIN,1,,,0
          CLEAR  COMP,WRITE        CLEAR WRITER CODE
 VER2     ELSE
          WRITEW COMP,A6,1
 VER2     ENDIF 
 YESX1    SA1    MODEC
          NG     X1,YESX6          6-BIT
          SA5    SQLGN8            8-BIT X-FILE 
          NZ     X5,YESX8.3 
          SA1    CARD8             MAKE 8-BIT CARD IMAGE
          NZ     X1,YESX8.2 
          SA1    SQLGN
          ZR     X1,YESX8.3 
          RJ     UCARD
          RJ     CARD6TO8 
 YESX8.2  RJ     SQUEEZ8
          SA5    SQLGN8            CLEAR SQLGN8 SO WE WONT THINK THIS 
          MX6    0                 IS A REAL 8-BIT CARD 
          SA6    A5 
 YESX8.3  MX0    42 
          SA2    IDFIELD+1
          BX6    X0*X2
          IX6    X6+X5             ADD LENGTH TO HEADER 
          SA6    A2 
          ENV    ACT,(2,3),VER2 
          SA1    COMP+FETFIT
          SX4    A5+B1
          SX6    X5+2 
          PUTWP  X1,IDFIELD,2,,,0  WRITE 2 WORD HEADER
          PUTWP  X1,X4,X5,,,0      WRITE LINE 
          SA2    COMP+FETTYPE 
          NZ     X2,YESX8.4        NOT W TYPE RECORD
          SA4    RLCMPL            FETCH PREVIOUS LENGTH
          SX5    X5+2 
          IX7    X4+X5
          SA7    RLCMPL            SAVE NEW ACCUM LENGTH
          SX4    RL7000 
          IX4    X4-X7
          PL     X4,YESX8.4        IF BELOW THRESHOLD/
          MX7    0
          PUTWP  X1,,0,,,,TERM     TERMINATE W CONTINUATION 
          SA7    RLCMPL 
 YESX8.4  BSS 
  
 VER2     ELSE
          WRITEW COMP,IDFIELD,2    WRITE HEADER 
          WRITEW X2,A5+1,X5        WRITE CARD 
 VER2     ENDIF 
          EQ     WRCOMPFL 
  
 YESX6    SA5    SQLGN             6-BIT X-FILE 
          NZ     X5,YESX8.3 
          SA1    SQLGN8 
          ZR     X1,YESX8.3 
 YESX6.1  RJ     CONV8TO6 
          SA5    SQLGN
          EQ     YESX8.3
          SPACE  2
* 
*  NON-X-COMPILE FILES
* 
 NOTX     RJ     FORMATCD          MAKE IDENT FIELD 
          SA1    COMP 
          LX1    59 
          PL     X1,NOTX.1         COMPILE FILE BUSY
          SX6    74B               OPCODE MASK
          LX1    1
          SX0    14B               CIO -WRITE- CODE 
          BX6    -X6*X1            REMOVE POSSIBLE -WRITER- 
          IX6    X6+X0             INSTALL -WRITE-
          SA6    A1 
 NOTX.1   SA1    MODEC
          PL     X1,COMP8          8-BIT COMPILE FILE 
          RJ     XCARD             GET CARD IMAGE 
  
          SA2    WIC               EXPAND TO LINE BUFFER
          SB3    10 
          SA1    CARD-1 
          SA6    LINE-1 
          SB4    X2                CARD WIDTH (CHARS) 
          MX0    -12               EOL MASK 
          ZR     B4,COMP6.5        SPECIAL CASE, CARD WIDTH=0 
          ENV    ACT,(2,3),VER2 
          SA2    UCW         FETCH W CTL WD FROM UCARD
          SB2    X2          WORDS IN LINE
          AX2    18          UNUSED BITS
 VER2     ENDIF 
 COMP6.2  SA1    A1+B1
          SB4    B4-B3
          LX6    X1 
          SA6    A6+B1
          ENV    ACT,(2,3),VER2 
          SB5    A6-LINE+1         WORDS MOVED
          EQ     B2,B5,COMP6A NO MORE TO MOVE 
          GT     B4,B0,COMP6.2 MORE TO MOVE 
          SX7    B5 
          MX2    0           MINIMUM UNUSED BIT COUNT 
          SA7    A2          NEW LINE LENGTH
 COMP6A   GE     B4,B0,COMP6B 
          SX1    6
          SX7    -B4         UNUSED CHARACTERS
          IX7    X1*X7       CONVERT TO BITS
          IX0    X2-X7
          PL     X0,COMP6B
          SX2    X7          SET LARGEST UNUSED BIT COUNT 
 COMP6B   BSS    0
          SB5    X2                UNUSED BITS
          SB5    -B5
          SA1    =1H
          EQ     COMP6.5A 
 VER2     ELSE
          BX2    -X0*X1 
          ZR     X2,COMP6.3        END OF LINE
          GT     B4,B0,COMP6.2     MORE TO MOVE 
          SA1    A1+B1             LOOK AHEAD IN CASE OF 11 CHAR EOL
          NZ     X1,COMP6.5 
          SB4    B4-B3
          MX6    0
          SA6    A6+B1
  
 COMP6.3  NZ     X6,COMP6.4 
          SA1    A1-1              BACK UP IF LAST WORD ALL ZERO
          MX0    -6 
          SB4    B4+B3
          LX6    X1 
          BX2    -X0*X1 
          SA6    A6-1 
          NZ     X2,COMP6.5        NOTHING TO FILL
 COMP6.4  RJ     SFN=              BLANK FILL LAST WORD 
          SA6    A6+0 
 VER2     ENDIF 
  
 COMP6.5  SA1    =8H               START BLANK FILL 
          GE     B4,B0,COMP6.6     SHORT LINE OR WIC MULTIPLE OF 10 
          SB2    B4+B4             OVERAGE * 2
          SB5    B2+B4                     * 3
          SB5    B5+B5                     * 6
 COMP6.5A BSS 
          MX0    1
          SB5    59+B5
          AX0    B5 
          BX6    X0*X6             CHARACTERS TO KEEP 
          BX5    -X0*X1            BLANK FILL 
          IX6    X5+X6
          SA6    A6 
 COMP6.6  SA3    WIW
          ENV    ACT,(2,3),VER2 
          SA4    COMP+FETTYPE 
          ZR     X4,COMP6.6A        IF W TYPE RECORD
 VER2     ELSE
          ZR     X3,COMP6.10       LINE ONLY, NO IDENT
 VER2     ENDIF 
 COMP6.6A BSS 
          SA2    WIS               SPACES BEFORE IDENT
          BX6    X1 
          SB4    X2+B4             REMAINING PLACES TO SPACE FILL 
          LT     B4,B0,COMP6.8     DONE WITH SPACES 
 COMP6.7  SB4    B4-B3
          SA6    A6+B1
          GE     B4,B0,COMP6.7
  
 COMP6.8  SB2    B4+B4             TURN OVERAGE TO BITS 
          SA1    WII               IDENT WIDTH
          SB4    B2+B4             OVERAGE * 3
          LX0    X1,B1             WIDTH * 2
          SX2    IDFIELD           SOURCE WORD
          SB4    B4+B4             OVERAGE * 6 (BITS) 
 COMP6.9  IX0    X1+X0             WIDTH * 3 (OR * 6) 
          SX4    A6                DESTINATION WORD 
          SB4    60+B4             DESTINATION BIT
          LX0    1                 BITS TO MOVE (WIDTH * 6) (OR 12) 
          SB2    B0                SOURCE STARTING BIT
          RJ     MNS=             * MOVE IDENT *
          SX2    =0 
          SX0    60 
          SB2    B0 
          RJ     MNS=             * END OF LINE * 
          MX6    0
          SA6    X4 
  
 COMP6.W  BSS 
          ENV    ACT,(2,3),VER2 
          SA3    WII               IDENT WIDTH IN CHARS 
          NZ     X3,COMP6.WA       LINE HAS IDENT 
          SA1    UCW               UCARD CTL WORD 
          SX1    X1                WORDS TO WRITE 
          SX2    10D
          IX5    X1*X2             CHARS TO WRITE 
          EQ     COMP6.WB 
 COMP6.WA SA1    WIC
          SA2    WIS               SPACES BEFORE IDENT
          IX5    X1+X2
          IX5    X5+X3             TOTAL LINE LENGTH
 COMP6.WB BSS 
          SA1    COMP+FETFIT
          PUT    X1,LINE,X5        WRITE LINE TO COMPILE
 VER2     ELSE
          WRITEC COMP,LINE
 VER2     ENDIF 
          EQ     WRCOMPFL 
          SPACE  2
 COMP6.10 SA1    =8H               SPACES 
          SB2    A6-LINE
          SA2    A6 
          ZR     B2,COMP6.12       ONLY ONE WORD IN LINE
 COMP6.11 IX0    X2-X1             LOOK FOR WHOLE WORDS OF SPACES 
          NZ     X0,COMP6.12       OTHER STUFF IN WORD
          SB2    B2-B1
          SA2    A2-1 
          NZ     B2,COMP6.11
  
 COMP6.12 BSS 
          ENV    ACT,(2,3),VER2 
          SA1    COMP+FETTYPE 
          ZR     X1,COMP6.W        W TYPE RECORD
 VER2     ENDIF 
          WRITEH COMP,LINE,A2-LINE+1
          EQ     WRCOMPFL 
          SPACE  2
* 
 COMP8    RJ     XCARD8            8-BIT COMPILE FILE 
  
          SA5    IDFIELD
          SB6    IDFIELD8 
          SB2    IDFIELD8+4 
          RJ     CONV6TO8          CONVERT IDENT TO 8-BIT 
          SA2    WIC               EXPAND TO LINE BUFFER
          SB3    5
          SA1    CARD8-1
          SA6    LINE-1 
          SB4    X2                CARD WIDTH (CHARS) 
          MX0    -12               EOL MASK 
          ZR     B4,COMP8.5        SPECIAL CASE, CARD WIDTH = 0 
 COMP8.2  SA1    A1+B1
          SB4    B4-B3
          LX6    X1 
          BX2    -X0*X1 
          SA6    A6+B1
          ZR     X2,COMP8.3        END OF LINE
          GT     B4,B0,COMP8.2     MORE TO MOVE 
          EQ     COMP8.5
  
 COMP8.3  NZ     X6,COMP8.4 
          SA1    A1-1              BACK UP IF LAST WORD ALL ZERO
          SB4    B4+B3
          LX6    X1 
          SA6    A6-1 
          EQ     COMP8.5
  
 COMP8.4  RJ     PAD8              BLANK FILL LAST WORD 
          SA6    A6+0 
  
 COMP8.5  SA1    ASCIIBLK          START BLANK FILL 
          GE     B4,B0,COMP8.6     SHORT LINE OR EVEN WORD WIC
          SB2    B4+B4             OVERAGE * 2
          SB5    B2+B4                     * 3
          SB5    B5+B5                     * 6
          SB5    B5+B5                     * 12 
          MX0    1
          SB5    59+B5
          AX0    B5 
          BX6    X0*X6             CHARACTERS TO KEEP 
          BX5    -X0*X1            BLANK FILL 
          IX6    X5+X6
          SA6    A6 
 COMP8.6  SA3    WIW
          ZR     X3,COMP8.10       NO IDENT TO BE ADDED 
          SA2    WIS               SPACES BEFORE IDENT
          BX6    X1 
          SB4    X2+B4             REMAINING PLACES TO SPACE FILL 
          LT     B4,B0,COMP8.8     DONE WITH SPACES 
          SB3    5                 RESET B3 
 COMP8.7  SB4    B4-B3
          SA6    A6+B1
          GE     B4,B0,COMP8.7
  
 COMP8.8  SB2    B4+B4             TURN OVERAGE TO BITS 
          SA1    WII               IDENT WIDTH
          SB4    B2+B4             OVERAGE * 3
          LX1    1                 WIDTH * 2
          SX2    IDFIELD8          SOURCE WORD
          SB4    B4+B4             OVERAGE * 6
          LX0    X1,B1             WIDTH * 4
          SB4    B4+B4             OVERAGE * 12 
          EQ     COMP6.9           JOIN 6-BIT CODE
  
 COMP8.10 SA1    ASCIIBLK          SPACES 
          SB2    A6-LINE
          SA2    A6 
          ZR     B2,COMP8.12       ONLY ONE WORD IN LINE
 COMP8.11 IX0    X2-X1             SKIP WHOLE WORDS OF BLANKS 
          NZ     X0,COMP8.12       NON-BLANK IN HERE
          SB2    B2-B1
          SA2    A2-1 
          NZ     B2,COMP8.11
  
 COMP8.12 BSS    0
          ENV    ACT,(2,3),VER2 
 COMP8.W  SX5    A2-LINE+1         COMPUTE LINE LENGTH
          IX4    X5+X5             WORDS * 2
          LX5    3                 WORDS * 8
          IX5    X4+X5             WORDS * 10 
          SA1    COMP+FETFIT
          PUT    X1,LINE,X5 
          EQ     WRCOMPFL 
 VER2     ELSE
          MX4    60-6              MASK FOR LAST SIX BITS 
          BX0    -X4*X2 
          NZ     X0,COMP8.13       IF NOT ZERO
          SA1    ABZBYTE           GET ASCII BLANK PLUS DISPLAY BLANK 
          BX6    X1 
          SA6    A2+B1             ADD TO RECORD TO FAKE OUT WRITEH 
          SA2    A2+1              INCREMENT LINE POINTER 
 COMP8.13 BSS    0
          WRITEH COMP,LINE,A2-LINE+1
          EQ     WRCOMPFL 
 VER2    ENDIF
          EJECT 
**        WRCWIDTH                 PROCESS WIDTH CARD 
* 
*         WRCWIDTH PROCESSES THE WIDTH STATEMENT AND
*         UPDATES THE FORMAT CELLS
* 
*         WIC - WIDTH OF CARD IMAGE 
*         WIW - WIDTH OF IDENT FIELD
* 
*         (DERIVED).. WIS - SPACES BETWEEN END OF CARD AND IDENT
*                     WII - ACTIVE WIDTH OF IDENT 
  
 WRCWIDTH RJ     WRCWRITE 
          SA1    CHAR 
          SB7    X1-1R
          ZR     B7,WRCWDR         RESTORE DEFAULT SETTINGS 
          SB7    X1-1R, 
          ZR     B7,WRCWD0
          RJ     SCNN 
          SB7    X6-256-1 
          PL     B7,WIDERR
          SA6    WIC               CARD WIDTH 
          SA5    WIW
          SA1    CHAR 
          SX6    X5                DEFAULT CARD IDENT WIDTH 
          SB7    X1-1R, 
          NZ     B7,WRCWD1
 WRCWD0   RJ     GETCH
          RJ     SCNN 
 WRCWD1   SA1    WIC
          IX2    X1+X6
          SB7    X2-256-1 
          PL     B7,WIDERR
          SA6    WIW               IDENT WIDTH
          SB7    X6-16
          GE     B7,B1,WRCWD2 
          SB6    X6-14
          SB7    B1 
          GE     B6,B1,WRCWD2 
          SB7    B0 
 WRCWD2   SX7    B7 
          SA7    WIS               SPACE COUNT
          IX6    X6-X7
          SA6    WII               ACTIVE IDENT SIZE
          EQ     WRCWEORX          RETURN FROM WHENCE WE CAME 
  
 WIDERR   SA1    LISTONE
          ZR     X1,WIDERR1 
          RJ     ADDID
          PRNTCARD
          PRINT  (0*** ERROR. WIDTH EXCEEDS 256 CHARACTERS ***) 
 WIDERR1  SA1    ERRORS 
          SX6    X1+B1
          SA6    A1 
 WRCWDR   SA1    FULLCOL           RESTORE DEFAULT WIDTH
          SA2    EIGHTY 
          ZR     X2,WRCWDR1 
          SX7    72                8
          SX6    8
          ZR     X1,WRCWDR3 
          SX7    80                D,8
          SX6    0
          EQ     WRCWDR3
 WRCWDR1  SX7    72                NORMAL (NOT D OR 8)
          SX6    L.CIW
          ZR     X1,WRCWDR3 
          SX7    80                D
          SX6    10 
 WRCWDR3  SA7    WIC
          EQ     WRCWD1 
          EJECT  4                                                      01256786
**        WRCOMPIL  PROCESS SPECIAL DIRECTIVES                          01256787
*                                                                       01256788
*         WRCOMPIL SORTS OUT CALL, CWEOR, AND WEOR CARDS                01256789
*         AND CALLS WRCOMPFL TO WRITE THE COMPILE FILE.                 01256790
*                                                                       01256791
*         CALLS  CLASSIFY, WRCOMPFL                                     01256792
                                                                        01256793
WRCOMPIL  BSS    1
          CLASIFY 1 
          ZR     X1,WRCOMP1 
          CCJUMP TEXT,WRCOMPIL
          CCJUMP ENDTEXT,WRCOMPIL 
          CCJUMP CALL,WRCCALL 
          CCJUMP WEOR,WRCWEOR 
          CCJUMP CWEOR,WRCCWEOR 
          CCJUMP WIDTH,WRCWIDTH 
WRCOMP1   RJ     WRCOMPFL 
          EQ     WRCOMPIL 
          SPACE  4
**        WRCWRITE  WRITE SPECIAL CARDS TO OUTPUT                       01256795
*                                                                       01256796
*         WRCWRITE IS A SUBROUTINE CALLED TO WRITE CALL,                01256797
*         WEOR, CWEOR, IF, AND ENDIF CARDS TO THE LIST                  01256798
*         FILE.                                                         01256799
*                                                                       01256800
*         CALLS  UCARD, FORMATCD, PRINT                                 01256801
                                                                        01256802
WRCWRITE  PS
          SA1    LISTTWO           THIS IS A SUBROUTINE TO WRITE
          ZR     X1,WRCWRITE       TYPE TWO LISTINGS IF THE PROPER
          SB7    L.IDW             FLAG IS SET. 
          RJ     FORMATCX 
          RJ     ADDIDL 
          PRNTCARD
          EQ     WRCWRITE 
          EJECT  4                                                      01256804
**        WRNPL  WRITE NEW PROGRAM LIBRARY                              01256805
*                                                                       01256806
*         WRNPL IS THE MASTER NEWPL WRITE ROUTINE.  IF                  01256807
*         DECKFLAG IS POSITIVE, THE CURRENT CARD IS AN                  01256808
*         ACTIVE DECK OR COMDECK CARD.  IF THIS IS TRUE,                01256809
*         AND THE NEWPL IS A RANDOM FILE, THE LAST RECORD               01256810
*         MUST BE COMPLETED SINCE THE CURRENT CARD STARTS               01256811
*         A NEW ONE.  WHEN THE RECORD IS COMPLETE, OR IF                01256812
*         THE NEWPL IS NOT RANDOM OR NON-EXISTENT, THE                  01256813
*         RANDOM ADDRESS OF THE LAST DECK (OR ZERO IF NOT               01256814
*         RANDOM) IS ENTERED IN NEWDKS AND THE NAME OF                  01256815
*         THE NEW DECK IS PLACED IN NEWDKS.  IF THE NEW                 01256816
*         ENTRY IS A DUPLICATE OF AN ENTRY ALREADY IN                   01256817
*         THE LIST, A MESSAGE IS ISSUED TO THIS EFFECT                  01256818
*         AND WRITING OF THE NEWPL IS SUSPENDED IF IN                   01256819
*         PROGRESS.  IN ADDITION, THE YANKDECK BIT IS                   01256820
*         SET IN NEWDKS, IF THE CURRENT DECK IS YANKED.                 01256821
*         IN ALL CASES, IF A NEWPL IS TO BE WRITTEN, WRNPL              01256822
*         THEN PERFORMS THE REVERSE OF OPERATIONS PER-                  01256823
*         FORMED BY ROPL AND WRITES THE CARD TO NEWPL.                  01256824
*                                                                       01256825
*         CALLS  WBIN, CALLIO, PAD, PRINT, ADDWORD                      01256826
          SPACE  1
WRNPL     BSS    1
          SA1    DECKFLAG 
          PL     X1,WRNPL1         ACTIVE DECK CARD 
WRNPL2    SA1    NEWPL
          ZR     X1,WRNPL 
          SA1    MODENF 
          NG     X1,WRNPL2A        FORCE 6-BIT PL 
          SA5    SQLGN8            IS THERE AN 8-BIT IMAGE
          ZR     X5,WRNPL2A        NO 
          MX3    1                 YES, SET FLAG
          LX3    1+S.8BIT-36
          BX5    X3+X5
          EQ     WRNPL2B
 WRNPL2A  RJ     CONV8TO6          MAKE 6-BIT CARD IMAGE IF NEEDED
          SA5    SQLGN
          NZ     X5,WRNPL2B  NON-NULL CARD EXISTS.
          ENV    ACT,(2,3),VER2 
          EQ     WRNPL2B
 VER2     ELSE
          SA5    NULCARD     FOR 1.3 SAKE, USE SINGLE BLANK 
 VER2     ENDIF 
 WRNPL2B  BSS    0
          SA3    LCHBTAB
          SB5    CHBTAB 
          MX6    0
          SB3    B0 
          SA6    X3+B5
          SA1    B5 
          SA6    A6+B1
          MX0    5
          SA2    CARDSTAT 
          BX6    X0*X2
          LX6    23 
          BX7    X1 
          SA7    A1 
          BX7    X6+X5             STATUS+LGTH OF SQUEEZED IMAGE
          MX0    1
          SA4    SEQNUM 
          LX7    18 
          SB2    X3-1 
          SB6    B5+B1
          BX7    X7+X4
WRN2      BSS    0
          LX7    18 
          SB2    B2-B1
          BX7    X1+X7
          SB3    B3-B1
          SA1    A1+B1
          PL     B3,WRN2
          SA7    A7+B1             STORE SQUEEZED CHB-S FOR OUTPUT
          MX7    0
          SB3    B1+B1
          PL     B2,WRN2
          SA1    A7 
          BX7    X1+X0
          SA7    A7 
          WRITEWC NEWPL,B6,A7-B5
          WRITEWC X2,A5+B1,X5 
          EQ     WRNPL
          SPACE  1
WRNPL1    SA1    RANDNPL
          NG     X1,WRNPL3
          WRITER NEWPL,RECALL 
          CLEAR  NEWPL,WRITE
          SA1    RANDTEMP 
          SX6    A1 
          SA6    NEWPL+6
 WRNPL3   ADDWRD NEWDKS,X1
          SA1    IDFLG
          SA3    F.NEWDKS 
          SA4    L.NEWDKS 
          MX5    54 
          SB2    B1+B1
          SB5    X4 
          SB6    B0 
WRNPL4    GE     B6,B5,WRNPL5 
          SA2    X3+B6             CHECK TO BE SURE WE DONT CREATE
          SB6    B6+B2             DUPLICATE DECKS
          BX0    X1-X2
          BX0    X5*X0
          NZ     X0,WRNPL4         NOT DUPLICATE
          SA2    LISTONE
          ZR     X2,WRNPL6         NO LIST ERROR
          RJ     SFN= 
          SA6    DUPDECK+2
          PRINT  DUPDECK,5
WRNPL6    SA2    NEWPL
          NZ     X2,WRNPL7   IF NEWPL IS BEING CREATED
          SA3    NFERROR
          SX6    X3+B1       INCREMENT NONFATAL ERROR COUNT 
          SA6    A3 
          EQ     WRNPL5 
  
WRNPL7    SA3    ERRORS 
          SX6    X3+B1       INCREMENT FATAL ERROR COUNT
          SA6    A3 
WRNPL5    SA3    IDFLG             DECK OR COMDECK NAME.                 UPDA178
          CLASIFY                                                        UPDA178
          CCJUMP COMDECK,WRNPL8    IF COMDECK DO NOT ADD DECK BIT.       UPDA178
          SA2    DECKFLG           ELSE, DECK. GET DECK BIT.             UPDA178
          BX3    X3+X2             ADD DECK BIT TO DECK NAME.            UPDA178
WRNPL8    BX1    X3                PREPARE TO ADD NAME TO NEWDKS.        UPDA178
          MX6    0                 CLEAR                                 UPDA178
          SA6    DECKFLG                 DECKFLG.                        UPDA178
          ADDWRD NEWDKS,X1
          SA1    YANKFLAG 
          SA2    CARDSTAT 
          MX0    1
          LX0    56                REMOVE OLD UANKDECK BIT
          BX6    -X0*X2            AND ADD NEW YANKDECK BIT 
          SA6    A2                IF NECESSARY 
          NZ     X1,WRNPL2
          BX6    X6+X0
          SA6    A2 
          EQ     WRNPL2 
          EJECT  4                                                      01256828
**        WRQCHECK  CHECK COMDECK NAME IN LIST                          01256829
*                                                                       01256830
*         WHEN A CALL CARD IS FOUND IN A COMDECK, AND                   01256831
*         UPDATE IS IN Q MODE WITH A RANDOM OLDPL, WRQCHECK             01256832
*         IS CALLED TO INSURE THAT THE CALLED COMDECK                   01256833
*         APPEARS IN THE LIST OF DECKS TO BE PROCESSED                  01256834
*         (DKLIS).                                                      01256835
*                                                                       01256836
*         CALLS  SCITEM, SRCHCOM, CRDKLIS                               01256837
                                                                        01256838
WRQCHECK  PS
          SA1    RANDOPL
          ZR     X1,WRQCHECK       IF SEQUENTIAL OLDPL, RETURN
          RJ     SCITEM 
          RJ     SRCHCOM           SEARCH FOR COMMON DECK 
          ZR     X4,WRQCHECK       COMMON DECK FOUND, RETURN
          SA1    F.DECKS
          SA2    L.DECKS                                                 CP190
          SB3    X2-2                                                    CP190
          SA2    X1                                                      CP190
          SB2    B1+B1                                                   CP190
WRQCHEK2  SA2    A2+B2                                                   CP190
          BX4    X7-X2                                                   CP190
          AX4    6                                                       CP190
          SB3    B3-B2                                                   CP190
          LX2    59-3                                                    CP190
          NG     X2,WRQCHEK3       IF DECK BIT SET.                      CP190
          ZR     X4,FOUND                                                CP190
WRQCHEK3  PL     B3,WRQCHEK2                                             CP190
          EQ     WRQCHECK                                                CP190
                                                                         CP190
FOUND     BX1    X7                PUT COMDECK NAME INTO X1.             CP190
          SX6    B1 
          SA6    QRANDFLG    POSSIBLE COMDECK OUT OF ORDER
          RJ     CRDKLIS
          NZ     X2,WRQCHECK
          SA3    FASTFLG     IF IN -Q-
          PL     X3,WRQCHEK1       MODE WITH K OPTION SET WORKLGTH
          SA1    WORKLGTH          TO INDICZTE THE NEW LENGTH.
          SX6    X1+B1
          SA6    A1 
          EQ     WRQCHECK 
          SPACE  2
WRQCHEK1  ZR     X3,WRQCHECK
          SA1    RANDOPL
          NZ     X1,WRQCHECK
          MX6    1
          SA6    WORKLGTH          IF IN SEQUENTIAL Q MODE SET WORKLGTH 
          EQ     WRQCHECK          MINUS TO PROCESS ENTIRE LIBRARY. 
          SPACE  4
**        WRSCR  WRITE UPDTSCR                                          01256840
*                                                                       01256841
*         WRSCR WRITES THE SCRATCH FILE UPDTSCR.  WRQCHECK              01256842
*         AND WRCHMOD ARE CALLED IF NECESSARY AS IN WRCOMDKS            01256843
*         ABOVE.  THE CURRENT CARD IS THEN WRITTEN TO                   01256844
*         UPDTSCR.                                                      01256845
*                                                                       01256846
*         CALLS  CLASSIFY, WRCMPSCR, WRCHMOD, WRQCHECK                  01256847
                                                                        01256848
WRSCR     CLASIFY 
          CCJUMP CALL,WRSCR2
WRSCR1    RJ     WRCMPSCR 
          EQ     WRCOM
          SPACE  1
WRSCR2    SA1    FASTFLG
          NZ     X1,WRSCR3         Q MODE 
          SA1    FMODE
          NZ     X1,WRSCR1         F MODE 
          RJ     WRCHMOD
          EQ     WRSCR1 
          SPACE  1
WRSCR3    SA1    RANDOPL
          ZR     X1,WRSCR1
          RJ     WRQCHECK 
          EQ     WRSCR1 
          SPACE  4                                                      01256850
**        WRSOU  WRITE POSSIBLE SOURCE FILE                             01256851
*                                                                       01256852
*         WRSOU IS CALLED TO WRITE THE SOURCE FILE.  IF T               01256853
*         MODE HAS BEEN SELECTED, NOCOMMON WILL BE NON-ZERO             01256854
*         AND COMMON DECKS WILL NOT BE WRITTEN TO SOURCE.               01256855
*                                                                       01256856
*         CALLS  UCARD, WDEC, CLASSIFY                                  01256857
          SPACE  1
WRSOU     BSS    1
          SA1    SOURCE 
          ZR     X1,WRSOU 
          SA4    NOCOMMON 
          NZ     X4,CHNOCOM 
WRSOU1    BSS    0
          SA1    MODES             OUTPUT MODE OF SOURCE FILE 
          PL     X1,WRSOU8         8-BIT
          RJ     XCARD             6-BIT
          ENV    ACT,(2,3),VER2 
          SA4    UCW
          SA1    SOURCE+FETFIT
          PUTW   X1,CARD,X4 
 VER2     ELSE
          WRITEC SOURCE,CARD
 VER2     ENDIF 
          EQ     WRSOU
  
 WRSOU8   RJ     XCARD8 
          ENV    ACT,(2,3),VER2 
          SA1    CARD8             COUNT CHARACTERS 
          SX7    B0 
          MX0    -12
          ZR     X1,WRSOU8C        NULL CARD
          SX7    10 
 WRSOU8A  BX2    -X0*X1            LOOK FOR END OF LINE 
          ZR     X2,WRSOU8B        FOUND IT 
          SA1    A1+B1
          ZR     X1,WRSOU8C        WHOLE WORD IS EOL
          SX7    X7+10
          EQ     WRSOU8A
  
 WRSOU8B  SX7    X7-2              COUNT BACK OVER EOL
          AX1    12 
          BX2    -X0*X1 
          ZR     X2,WRSOU8B 
 WRSOU8C  SA1    SOURCE+FETFIT
          PUT    X1,CARD8,X7
 VER2     ELSE
          WRITEC SOURCE,CARD8 
 VER2     ENDIF 
          EQ     WRSOU
          SPACE  1
CHNOCOM   SA3    WRCOMMON 
          CLASIFY 
          CCJUMP COMDECK,WRSOU4 
          CCJUMP DECK,WRSOU3
          ZR     X3,WRSOU1
          EQ     WRSOU
          SPACE  1
WRSOU4    SX6    B1 
          SA6    A3 
          EQ     WRSOU
          SPACE  1
WRSOU3    MX6    0
          SA6    A3 
          EQ     WRSOU1 
          SPACE  4
**        XCARD, XCARD8       FORCE 6 OR 8 BIT FORM FOR OUTPUT
* 
          SPACE  1
 XCARD    PS     **                FORCE 6-BIT IMAGE
          SA1    CARD 
          NZ     X1,XCARD 
          SA1    SQLGN
          NZ     X1,XCARD.2 
          SA1    SQLGN8 
          ZR     X1,XCARD          NO CARD
          RJ     CONV8TO6 
 XCARD.2  RJ     UCARD
          EQ     XCARD
          SPACE  2
* 
 XCARD8   PS     **                FORCE 8-BIT IMAGE
          SA1    CARD8
          NZ     X1,XCARD8
          SA1    SQLGN8 
          NZ     X1,XCARD8.2
          SA1    SQLGN
          ZR     X1,XCARD8.1
          RJ     UCARD
 XCARD8.1 RJ     CARD6TO8 
          EQ     XCARD8 
  
 XCARD8.2 RJ     UCARD8 
          EQ     XCARD8 
          SPACE  4
**        COMMON CODE INTERFACE ROUTINES
* 
*        *CALLED FROM COMPASS PL
* 
*         COMC- MNS, MTP, MVE, SFN, SYS 
*CALL COMCMNS 
*CALL COMCMTP 
*CALL COMCMVE 
*CALL COMCSFN 
*         IF 6000 OPERATING SYSTEM, COMC- CIO, RDC, RDO, RDW, 
*                                         STF, WTC, WTO, WTW
          LIST   -F                * DONT LIST UNUSED I/O ROUTINES *
          ENV    NOT,(2,3),VER2 
*CALL COMCCIO 
*CALL COMCRDC 
*CALL COMCRDW 
*CALL COMCSTF 
*CALL COMCCPM 
*CALL COMCSYS 
*CALL COMCWTC 
*CALL COMCWTW 
*CALL COMCWTH 
 VER2     ENDIF 
          SPACE  4
          ENV    ACT,(2,3),VER2 
          TITLE  7000 V2 DM INTERFACES
          EJECT 
 CHKFMT   SPACE  1
*********************************************************************** 
*    CHKFMT      CHECK FORMAT OF MAIN OR ALTERNATE INPUT FILE         * 
*         ENTRY  X2 = FET LOCATION
*         USES   A1, X1, X3 
*                                                                     * 
*    METHOD--                                                         * 
*      THE FETCH MACRO IS USED TO RETREIVE THE RECORD TYPE.           * 
*                                                                     * 
*      IF THE FILE IS RECORD TYPE W, RETURN.                          * 
*         ELSE IF THE FILE IS NOT RECORD TYPE Z, GO TO PROCESS ERROR  * 
*              ELSE USE THE FETCH MACRO TO RETRIEVE THE RECORD LENGTH.* 
*                   IF THE RECORD LENGTH IS LE 100B, RETURN.          * 
*                   ELSE PROCESS ERROR.                               * 
*                                                                     * 
*    ERROR PROCESSING--                                               * 
*      IF LIST OPTION 1 IS NOT SPECIFIED, GO PRINT ERROR MESSAGE.     * 
*      ELSE, IF FILE IS NOT THE MAIN INPUT FILE PRINT CARD IN ERROR   * 
*                                                                     * 
*      PRINT THE ERROR MESSAGE FOLLOWING                              * 
*      ***MAIN OR ALTERNATE INPUT FILE IS IN AN UNSUPPORTED FORMAT*** * 
*                                                                     * 
*      ABORT.                                                         * 
*********************************************************************** 
          SPACE  1
CHKFMT    PS
          SA3    X2+FETFIT         DETERMINE FIT ADDRESS
          FETCH  X3,RT,X1          GET RECORD TYPE
          ZR     X1,CHKFMT         IF RECORD TYPE=W, RETURN 
          SX1    X1-3              ELSE 
          NZ     X1,CHKFMT1        IF NOT RECORD TYPE=Z, ERROR
          FETCH  X3,FL,X1          ELSE GET RECORD TYPE=Z LENGTH
          SX1    X1-511D
          MI     X1,CHKFMT         IF RT=Z AND FL.LE.(2*255), RETURN
CHKFMT1   SA1    LISTONE           ELSE DO ERROR PROCESSING 
          ZR     X1,CHKFMT2        IF NO LIST 
          SX1    X2-INPUT 
          ZR     X1,CHKFMT2        IF INPUT FILE, NO CARD TO PRINT
          RJ     PRINTERR          PRINT CARD IN ERROR
CHKFMT2   PRINT  BADFMT,7          PRINT ERROR MESSAGE
          EQ     ABORT             ABORT THE UPDATE RUN 
  
 OPEN76   SPACE  1
*********************************************************************** 
*    OPEN76      PROCESS OPENING OF FILE                              * 
*         ENTRY  A0 = FET LOCATION                                    * 
*                X6 = 7RM DESIGATOR FOR FILE PROCESSING DIRECTION     * 
*                X7 = 0 IF NO REWIND,NON-ZERO IF OPEN WITH REWIND     * 
*    REGISTERS SAVED-- A0,B1                                          * 
*                                                                     * 
*    METHOD-- IF THE LFN OF THE FET IS ZERO                           * 
*      JOB STEP) AN IMMEDIATE RETURN IS MADE.  OTHERWISE,THE LFN OF   * 
*      IS NON-ZERO (INDICATING THE FILE HAS BEEN OPENED DURING THIS   * 
*      JOB STEP) AN IMMEDIATE RETURN IS MADE.  OTHERWISE,THE LFN OF   * 
*      THE FET IS SET INTO THE FIT AND THE SETFIT MACRO EXECUTED.     * 
*                                                                     * 
*      IF THE FILE IS NOT CURRENTLY OPENED, IT IS OPENED FOR I-O,WITH * 
*      OR WITHOUT REWIND DEPENDING UPON THE VALUE OF X7 AT THE TIME   * 
*      OF ROUTINE ENTRY.                                              * 
*                                                                     * 
*      IF THE FILE HAS BEEN PREVIOUSLY OPENED FOR OUTPUT AND UPDATE   * 
*      IS TO READ THE FILE, THE FILE IS CLOSED WITH REWIND AND THEN   * 
*      OPENED FOR I-O.  IF THE FILE HAS BEEN OPENED FOR INPUT AND     * 
*      UPDATE IS TO WRITE ON THE FILE, THE FILE IS CLOSED, NO REWIND, * 
*      AND THEN OPENED FOR I-O.                                       * 
*                                                                     * 
*      IF THE FET INDICATES A RANDOM FILE AND THE OPEN REQUEST WAS    * 
*      FOR WRITE, THE CURRENT WA IS SET INTO THE RECORD LOCATION      * 
*      SPECIFIED IN THE FET.  IF THE FILE IS TO BE READ RANDOMLY,     * 
*      IT IS CLOSED AND THEN RE-OPENED WITH EXTEND.  THE LAST RECORD  * 
*      OF THE FILE IS CHECKED FOR DIRECT$ IN WORD 1 AND IF SUCH IS    * 
*      THE CASE, THE 6000-TYPE INDEX IS READ INTO THE AREA SPECIFIED. * 
*      IF THE INDEX IS NOT FOUND, THE RANDOM BIT OF THE FET IS        * 
*      CLEARED.                                                       * 
*    NOTES--                                                          * 
*      FILES WHICH ARE BLOCKED OR WHICH HAVE BEEN SPECIFIED           * 
*      TO BE OPENED WITHOUT REWIND CANNOT BE RANDOM.                  * 
*                                                                     * 
*      FILES WHICH ARE OPENED BY THIS ROUTINE ARE OPENED WITH         * 
*      PROCESSING DIRECTION = I-O REGARDLESS OF THE FILE TYPE REQUEST.* 
*********************************************************************** 
          SPACE  1
* 
 OPEN76   BSS    1
          SA6    PDFLG76
          SA7    REWFG76
          SA1    A0+FETFIT
          SA3    A0 
          MX6    42 
          BX6    X6*X3
          ZR     X6,OPEN76         IF LFN NOT SPECIFIED 
          SA3    X1 
          MX7    42 
          BX7    X7*X3             FIT LFN
          BX7     X7-X6      COMPARE FET AND FIT LFN
          ZR   X7,OPEN76           IF FILE ALREADY OPEN 
          SA6    X1 
          SETFIT X1 
          FETCH  X1,OC,X3 
          SX3    X3-#OPEN#
          NZ     X3,OPEN20         IF NOT OPENED
          FETCH  X1,PD,X3 
          SA4    PDFLG76
          BX6    X3-X4
          ZR     X6,OPEN15         IF PD SAME AS REQUESTED
          SX3    X3-#IO#
          ZR     X3,OPEN15         IF PD IS I-O 
          SX6    X4-#INPUT# 
          NZ     X6,OPEN12
          CLOSEM X1,R 
          EQ     OPEN20 
 OPEN12   CLOSEM X1,N 
          EQ     OPEN20 
* 
 OPEN15   SA3    REWFG76
          ZR     X3,OPEN25
          REWINDM   X1
          EQ     OPEN25 
 OPEN20   BSS 
          SA3    REWFG76
          NZ     X3,OPEN23
          OPENM  X1,I-O,N 
          EQ     OPEN25 
 OPEN23   OPENM  X1,I-O,R 
 OPEN25   BSS 
          FETCH  X1,RT,X3 
          BX6    X3 
          SA6    A0+FETTYPE 
          SA4    A0+FETRAND 
          LX4    59-47
          PL     X4,OPEN76
          NZ   X6,OPENRXZ          IF RECORD TYPE NOT W                 0009   4
          FETCH  X1,BT,X3 
          NZ     X3,OPENRXZ        BLOCKED FILES CANNOT BE RANDOM 
          SA3    PDFLG76
          SX3    X3-#INPUT# 
          ZR     X3,OPENRI0        IF INPUT FILE
          SA3    A0+FETRCLC 
          ZR     X3,OPEN76         IF RECORD LOCATION NOT SPECIFIED 
          GETPOS X1,X6
          SA6    X3                SET RECORD LOCATION
          MX7    0
          SA7    A3                CLEAR REQUEST
          EQ     OPEN76 
 OPENRI0  BSS 
          SA3    A0+FETINDX 
          MX6    30 
          BX6    -X6*X3 
          ZR     X6,OPEN76
          SB4    X6 
          AX6    18 
          SB5    X6 
 OPENRIA  BSS 
          SX3    RANIDX            PLACE IN WHICH TO READ INDEX 
 OPENRI   BSS 
          GETPOS  X1,X2            SAVE POSITION                        0009   7
          STORE  X1,FO=SQ 
          CLOSEM X1,N 
          OPENM  X1,I-O,E 
          STORE  X1,DX=OPENRX 
          SKIPBL X1,1 
          SX7    2
          GETWP  X1,X3,X7,OPENRX
          SA4    X3 
          BX7    X4 
          SA4    RANDID 
          IX4    X7-X4
          ZR     X4,OPENRIF 
          EQ     OPENRX1
 OPENRX   NO
 OPENRX1  BSS 
          POSITION X1,X2           RESTOR POSITION                      0009   9
 OPENRXZ  BSS 
          MX6    1
          SA3    A0+FETRAND 
          LX6    47-59
          BX6    -X6*X3 
          SA6    A3 
          EQ     OPEN76 
 OPENRIF  BSS 
          SA3    X3+B1
          SX7    B5 
+         IX4    X3-X7
          PL     X4,*+1 
          SX7    X3 
          MX6    0
          SA6    A0+FETINDX 
          SX6    B4 
          GETWP  X1,X6,X7 
          EQ     OPEN76 
* 
 RANDID   DATA   7LDIRECT$
 REWFG76  BSS    1
 PDFLG76  BSS    1
 READ76   EJECT 
*********************************************************************** 
*    READ76      FILL BINARY BUFFER                                   * 
*         ENTRY  A0 = FET LOCATION                                    * 
*         EXIT   X1 = NON-ZERO IF END-OF-DATA                         * 
*                FET IN-POINTER UPDATED                               * 
*                                                                     * 
*    REGISTERS SAVED-- A0,B1                                          * 
*    METHOD--                                                         * 
*      AN IMMEDIATE RETURN WILL BE MADE IF BUFFER IS NOT EMPTY.  IF   * 
*      FET INDICATES RANDOM FILE AND THE RECORD LOCATION IS SPECIFIED * 
*      THE FILE WILL BE POSITIONED TO THE WA IN THE RECORD LOCATION   * 
*      ADDRESS.  GETWP WILL BE ISSUED FOR 512 WORDS AT A TIME UNTIL   * 
*      THE BUFFER IS FILLED OR UNTIL AN AMOUNT LESS THAN 512 IS READ  * 
*      (AND THE RECORD TYPE IS NOT W).  A SHORT NON-W TYPE RECORD OR  * 
*      A DATA EXIT FROM THE GETWP MACRO WILL RESULT IN THE FET STATUS * 
*      BEING SET TO EOR OR EOF.  UPON EXIT, X1 WILL BE NON-ZERO IF    * 
*      AN END-OF-DATA CONDITION EXISTS AND THE BUFFER IS EMPTY.       * 
*********************************************************************** 
          SPACE  1
 READ76R  MX1    0           SET COMPLETION FLAG
 READ76   BSS    1
          SA1    A0+FETFIT
          SA3    A0+FETIN 
          SA4    A3+B1
          IX4    X3-X4
          NZ     X4,READ76R  IF BUFFER NOT EMPTY
 READ76D  BSS 
          SA3    A0+FETRAND 
          LX3    59-47
          PL     X3,READ76J  IF NOT RANDOM
          SA3    A0+FETRCLC 
          ZR     X3,READ76J  IF RECORD LOCATION NOT SPECIFIED 
          MX6    0
          SA6    A3          CLEAR
          POSITION X1,X3
          SPACE  2
 READ76J  BSS 
          FETCH  X1,FP,X3 
          SX4    X3-#EOI# 
          ZR     X4,READEOD5
          SA3    A0+B1
          SX6    X3          IN ADDRESS 
          SA6    A0+FETOUT
          SA3    A0+FETLIMIT
          SX3    X3-1              LIMIT - 1 INTO X3
          SX7    RL7000 
 READ76H  BSS 
          SA4    A0+FETLCMF 
          BX6    X6+X4             ADD IN LCM BIT IF SET
          GETWP  X1,X6,X7,READEOD 
          SX6    X6                RESTORE X6 
          SX7    X7 
          IX6    X6+X7
          SA6    A0+FETIN 
          SX4    X7-RL7000
          PL     X4,READ76K        IF NOT SHORT RECORD
          SA4    A0+FETTYPE 
          SX4    X4-#WT#
          NZ     X4,READEOD1       IF SHORT RECORD AND NOT W-FORMAT 
 READ76K  BSS 
          IX4    X6-X3             IN-LIMIT(-1) 
          PL     X4,READ76M        IF BUFFER FULL 
          SX7    RL7000 
          IX4    X4+X7             CHECK THAT NEXT READ WILL NOT OVERFLO
          NG     X4,READ76H 
          ZR     X4,READ76H 
 READ76M  BSS                      BUFFER AS FULL AS POSSIBLE 
          SX6    FETRD+2
          SA3    A0 
          MX7    42 
          BX7    X7*X3
          IX6    X6+X7
          SA6    A3          SET READ STATUS
          MX1    0
          EQ     READ76 
          SPACE  2
*                END-OF-DATA ENCOUNTERED
 READEOD  NO
+         SX7    X7 
          SX6    X6                RESTORE X6 
          IX6    X6+X7
          SA6    A0+FETIN 
 READEOD1 BSS 
          FETCH  X1,FP,X3 
          AX3    5
 READEOD5 BSS 
          SA4    A0 
          MX6    42 
          BX6    X6*X4
          SX4    27B         EOR
+         ZR     X3,*+1 
          SX4    X4+10B      EOF
+         BX6    X6+X4
          SA6    A0 
          SA4    A0+B1
          SA3    A4+B1
          SX4    X4 
          IX4    X4-X3
+         MX1    0
          NZ     X4,*+1      IF BUFFER NOT EMPTY
          MX1    59 
          EQ     READ76 
 WEOR76   EJECT 
*********************************************************************** 
*    WEOR76      WRITE END-OF-RECORD(SECTION)                         * 
*         ENTRY  A0 = FET LOCATION                                    * 
*    METHOD--                                                         * 
*      IF FILE IS NOT OPEN, RETURN IMMEDIATELY.  IF FILE IS BINARY,   * 
*      FLUSH76 IS CALLED TO EMPTY OUTPUT BUFFER.  IF FILE IS RANDOM   * 
*      AND RECORD LOCATION ADDRESS IS SPECIFIED, WA IS SET INTO       * 
*      SPECIFIED LOCATION.  WEOR MACRO IS EXECUTED AND EOR STATUS SET * 
*      IN FET.  IF RECORD TYPE IS W, WA AFTER EOI IS SET INTO EOIPOS  * 
*      OF FET.                                                        * 
*********************************************************************** 
          SPACE  1
 WEOR76   BSS    1
          SA1    A0+FETFIT
          SA3    X1 
          ZR     X3,WEOR76         IF NOT OPENED
WEOR76A   BSS 
          SA3    A0 
          SX6    FETMODE
          BX6    X6*X3
          ZR     X6,WEOR76B 
          RJ     FLUSH76
 WEOR76B  BSS 
          SA3    A0+FETRCLC 
          ZR     X3,WEOR76C 
          SA4    A0+FETRAND 
          LX4    59-47
          PL     X4,WEOR76C        IF NOT RANDOM
          GETPOS  X1,X6 
          SA6    X3 
          MX6    0
          SA6    A3 
 WEOR76C  BSS 
          SA3    A0 
          MX6    42 
          BX6    X6*X3
          SX7    FETMODE
          BX7    X7*X3
          SX7    X7+25B 
          BX6    X6+X7
          SA6    A3          SET EOR STATUS 
          WEOR   X1 
          SA3    A0+FETRAND 
          LX3    59-47
          PL     X3,WEOR76         IF NOT RANDOM
          GETPOS X1,X6
          SA6    A0+EOIPOS         SAVE EOI ADDRESS 
          EQ     WEOR76 
          SPACE  4
*********************************************************************** 
*    FLUSH76     WRITE REMAINDER OF OUTPUT BUFFER                     * 
*         ENTRY  A0 = FET LOCATION                                    * 
*                X1 = FIT LOCATION                                    * 
*    METHOD--                                                         * 
*      IF CODED FILE, RETURN.  OTHERWISE USE PUTW OR PUTWP TO         * 
*      EMPTY BUFFER.                                                  * 
*********************************************************************** 
          SPACE  1
 FLUSH76  BSS    1
          SA3    A0 
          SX6    FETMODE
          BX6    X6*X3
          ZR     X6,FLUSH76  IF CODED FILE
          SA3    A0+FETRCLC 
          SA4    A0+FETRAND 
          ZR     X3,FLUSH76C       IF RECORD LOCATION NOT SPECIFIED 
          LX4    59-47
          PL     X4,FLUSH76C       IF NOT RANDOM
          GETPOS X1,X6
          SA6    X3                STORE RECORD LOCATION
          MX6    0
          SA6    A3                CLEAR
 FLUSH76C BSS 
          SA4    A0+B1
          SA3    A4+B1
          SX6    X4 
          IX3    X3-X6
          ZR     X3,FLUSH76  IF BUFFER IS EMPTY 
          SA6    A3          SET IN=FIRST 
 FLUSHD   BSS 
          SA4    A0+FETLCMF 
          BX6    X6+X4             ADD LCM BIT IF SET 
          SX4    RL7000 
          IX7    X3-X4
          PL     X7,FLUSHF   IF REMAINDER GE NOMINAL LENGTH 
          SX4    X3 
          SA3    A0+FETTYPE 
          NZ     X3,FLUSHF
          PUTW   X1,X6,X4 
          EQ     FLUSH76
 FLUSHF   PUTWP  X1,X6,X4,,,RL7000
          ZR     X7,FLUSH76 
          NG     X7,FLUSH76 
          BX3    X7 
          IX6    X6+X4
          EQ     FLUSHD 
          SPACE  4
*   WEOF76 - WRITE END-OF-FILE
 WEOF76   BSS    1
          SA1    A0+FETFIT
          SA3    X1 
          ZR     X3,WEOF76         IF NOT OPENED
          SA3    A0 
          SX6    FETMODE
          BX6    X6*X3
          ZR     X6,WEOF76C 
          RJ     FLUSH76
 WEOF76C  BSS 
          FETCH  X1,LOP=X6   CHECK LAST OPERATION 
          SX6    X6-#PU#
          NZ     X6,WEOF76D  IF NOT *PUT* 
          WEOR   X1          WRITE END OF SECTION 
WEOF76D   BSS 
          ENDFILE X1
          SA3    A0 
          MX6    42 
          BX6    X6*X3
          SX7    FETMODE
          BX7    X7*X3
          SX7    X7+35B 
          BX6    X6+X7
          SA6    A3          SET STATUS=EOF 
          EQ     WEOF76 
          SPACE  4
*********************************************************************** 
*    SETINDX     WRITE 6000 TYPE INDEX ON RANDOM FILE                 * 
*         ENTRY  A0 = FET LOCATION                                    * 
*                X1 = FIT LOCATION                                    * 
*    METHOD--                                                         * 
*      ADDRESS AND LENGTH OF INDEX EXTRACTED FROM FET - IF EITHER     * 
*      ZERO,RETURN.  IF FET STATUS NOT EOR OR EOF,CALL WEOR76 TO      * 
*      TERMINATE PREVIOUS RECORD.  CONSTRUCT INDEX IN OUTPUT BUFFER   * 
*      OF FILE AND WRITE WITH PUTW.  INDEX LENGTH CANNOT BE LONGER    * 
*      THAN BUFFER LENGTH-3.                                          * 
*********************************************************************** 
          SPACE  1
 SETINDX  BSS    1
          SA3    A0+FETINDX 
          SB6    X3          ADDRESS OF INDEX 
          EQ     B6,SETINDX 
          AX3    18 
          MX7    -12
          BX3    -X7*X3 
          ZR     X3,SETINDX  IF LENGTH=0
          SA4    A0 
          LX4    59-4 
          SB7    X3 
          PL     X4,SETINDX6   IF NOT EOR OR EOF
          RJ     WEOR76 
 SETINDX6 BSS 
          SX7    B7+2        LENGTH TO WRITE
          PUTWP  X1,RANDID,1,,,X7  WRITE THE RANDOM INDEX RECORD ID 
          SX6    B7 
          SA6    DUMDIR            STORE LENGTH IN TEMPORARY LOCATION 
          PUTWP  X1,DUMDIR,1       WRITE LENGTH 
          SX6    B6 
          SX7    B7 
          PUTWP  X1,X6,X7          WRITE THE RANDOM INDEX 
          EQ     SETINDX
 CLOSE76  EJECT 
*********************************************************************** 
*    CLOSE76     CLOSE FILE                                           * 
*         ENTRY  A0 = FET LOCATION                                    * 
*                X7 = 0,NO REWIND. GT 0,REWIND.  LT 0,UNLOAD          * 
*    METHOD--                                                         * 
*      IF FILE NOT OPEN, RETURN.  IF RANDOM FILE,CALL SETINDX TO      * 
*      WRITE 6000-TYPE INDEX TO FILE.  EXECUTE CLOSEM ACCORDING TO    * 
*      CONTENTS OF X7 UPON ENTRY.  SET FIT LFN TO ZERO.               * 
*********************************************************************** 
          SPACE  1
 CLOSE76  BSS    1
          SA1    A0+FETFIT
          SA7    REWFG76
          SA3    X1 
          ZR     X3,CLOSE76        IF NOT OPENED
          SA3    A0+FETRAND 
          LX3    59-47
          PL     X3,CLOSE76D  IF NOT RANDOM 
          RJ     SETINDX
 CLOSE76D BSS 
          SA3    REWFG76
          NG     X3,CLOSE76U
          NZ     X3,CLOSE76R
          CLOSEM X1,N 
          EQ     CLOSE76P 
 CLOSE76R CLOSEM X1,R 
          EQ     CLOSE76P 
 CLOSE76U CLOSEM X1,U 
 CLOSE76P SA3    A0+B1
          SX6    X3 
          SA6    A3+B1
          MX7    0
          SA6    A6+B1
          SA7    X1 
          SA3    REWFG76
          ZR     X3,CLOSE76 
          MX6    0
          SA6    A0+EOIPOS
          EQ     CLOSE76
          SPACE  4
*********************************************************************** 
*    REWIND76    REWIND FILE                                          * 
*         ENTRY  A0 = FET LOCATION                                    * 
*    METHOD--                                                         * 
*      RETURN IF FILE NOT OPENED.  SET FET IN=OUT=FIRST.  CLEAR       * 
*      EOIPOS OF FET.  EXECUTE REWINDM                                * 
*********************************************************************** 
          SPACE  1
*    REWIND76 - REWIND FILE 
REWIND76  BSS    1
          SA1    A0+FETFIT
          SA3    X1 
          ZR     X3,REWIND76       IF NOT OPENED
          SA3    A0 
          MX7    51 
          LX7    3
          BX7    X7*X3
          SX3    50B
          IX7    X7+X3
          SA7    A3 
          SA3    A0+B1             PICK UP FIRST
          SX6    X3 
          SA6    A3+B1             SET IN 
          SA6    A6+B1             SET OUT
          REWINDM  X1 
          MX6    0
          SA6    A0+EOIPOS
          EQ     REWIND76 
          SPACE  4
**        SVNPLFET - SAVE NEWPL FET 
*         EXIT - CURRENT NEWPL FET SAVED IN NPLSAVE 
  
 SVNPLFET BSS    1
          SB7    LFET-1 
 SVNPLFT1 SA1    NEWPL+B7 
          BX6    X1 
          SA6    NPLSAVE+B7 
          SB7    B7-B1
          GE     B7,B0,SVNPLFT1 
          EQ     SVNPLFET 
          SPACE  4
**        RSNPLFET - RESTORE NEWPL FET
*         EXIT - NEWPL FET RESTORED FROM NPLSAVE
  
 RSNPLFET BSS    1
          SB7    LFET-1 
 RSNPLFT1 SA1    NPLSAVE+B7 
          BX6    X1 
          SA6    NEWPL+B7 
          SB7    B7-B1
          GE     B7,B0,RSNPLFT1 
          EQ     RSNPLFET 
  
 NPLSAVE  BSS    LFET              TEMPORARY STORAGE FOR TRUE NEWPL FET 
VER2      ENDIF 
  
          SPACE  1
* 
* CONDITIONAL CALL TO IDP COMMON DECK FOLLOWS 
* CONTROLLED BY (IF DEF,UPDEBUG)
*IF DEF,UPDEBUG 
          LIST   -L 
*CALL CALLIDP 
          LIST   L
*ENDIF
EPASS2    BSS    0
          END    UPDATE 
