*DECK FILE
          IDENT     FILE
          COMMENT   CRM FILE CONTROL CARD PROCESSOR 
          LIST   X
          SST 
          B1=1
*#
*1DC  PROGRAM FILEC 
*0D   PURPOSE 
*0        PROCESS THE FILE CONTROL CARD 
*0D   CALL
*0        FILE(LFN,[=AXXXXXX][,KEYWORD=OPTION]...)
*0D   PARAMETERS
*0        LFN       FIT FWA.
*0        AXXXXXX   OPTIONAL NEW LFN. 
*0        KEYWORD   SYMBOLIC NAME FOR A FIT FIELD (E.G. BT).
*0        OPTION    APPROPRIATE OPTION FOR ASSOCIATED KEYWORD.
*0                  EXAMPLE - 
*                   FILE(ABC,BT=C,RT=U,SDS=YES,MRL=10000) 
*0D   ACTION
*0        THE FILE CARD PROCESSOR IS A STAND-ALONE CONTROL CARD 
*         CALLABLE 0,0 OVERLAY. IT USES THE MICROS AND A FEW OF THE 
*         MACROS FROM TXTCRM AND IN ADDITION HAS SEVERAL MACROS 
*         OF ITS OWN. 
*0        FILEC PICKS UP THE FILE CONTROL CARD PARAMETERS FROM RA+2 ... 
*         AND WRITES FILE ZZZZZDG. THERE IS NO LIMIT TO THE NUMBER
*         OF FILE CARDS THAT CAN BE PROCESSED. THE FIRST RECORD IS 63 
*         DECIMAL WORDS LONG AND IS AN INDEX CONTAINING THE LFN-S FOR 
*         62 FILES. THE 63RD WORD CONTAINS A ZERO IF THIS IS THE
*         LAST INDEX AND A ONE IF THERE IS ANOTHER INDEX PRU
*         62 PRU-S FURTHER DOWN THE FILE. EACH LFN IS LEFT-JUSTIFIED
*         ZERO-FILLED. THE FILE CARD FOR THE FIRST LFN IS RECORD 2 OF 
*         ZZZZZDG, THE DATA FOR THE SECOND LFN IS IN THE THIRD RECORD 
*         AND SO FORTH. 
*0        THE SCOPE LOGICAL RECORD CONTAINING THE DATA FOR EACH LFN 
*         IS 2+2*#FTL#+31+12+1 WORDS LONG. #FTL, IS A MICRO DEFINED 
*         ON TXTCRM AS THE LENGTH OF THE EXTERNAL PORTION OF THE FIT
*         (ALL USER-ACCESSIBLE FIELDS ARE IN THE FIRST #FTL# WORDS
*         OF THE FIT). THE FIRST WORD OF EACH SCOPE LOGICAL RECORD
*         IS AN OFFSET TO TELL THE LOADER WHERE TO FIND THE LIST
*         OF EXTERNALS TO BE LOADED (FWA+(FWA)). THE SECOND WORD
*         CONTAINS FLAGS INTERNAL TO FILE. THE ONLY ONE CURRENTLY 
*         DEFINED IS #GET# WHICH IS BIT 59. IT IS SET WHEN A USE=GET
*         IS DONE AND IS USED TO KNOW WHETHER THE GET BLOCK AND 
*         RECORD TYPE EXTERNALS WERE PUT UP IN RESPONSE TO A USE=GET
*         OR A USE=SKIPFL. THE NEXT #FTL# WORDS CONTAIN THE FIT DATA
*         AS SPECIFIED ON THE FILE CARD. THE NEXT #FTL# WORDS CONTAIN 
*         1-S IN THE BIT POSITIONS WHERE FIT FIELDS HAVE BEEN 
*         SPECIFIED. THE NEXT 31+12 WORDS CONTAIN EXTERNAL
*         REFERENCES TO MODULES THAT ARE TO BE STATICALLY LOADED
*         VIA A LDSET(STAT=LFN/LFN/...).
*0        SUBSEQUENTLY, WHEN AN OPEN OR SETFIT IS DONE, OPEN
*         READS UP EACH ORIGINAL FIT WORD, APPLIES THE NEGATIVE OF THE
*         MASK WORD FROM ZZZZZDG, OR-S IN THE NEW FIT DATA FROM 
*         ZZZZZDG, AND STORES THE NOW-MODIFIED FIT WORD BACK INTO THE 
*         FIT.
*0D   REGISTERS USED
*0        ALL 
*0D   OTHER CODE REQUIRED 
*0        NONE
*0D   NARRATIVE DESCRIPTION 
*#
          TITLE               IDENT     FILE
         LCC       OVERLAY(FILE,0,0)
BEGINR   BSS       0
  
CCT      EQU       7               BIT COUNT (USED TO LEFT-JUSTIFY ALPH)
T        SET       1               TEMPORARY X
CHAR     EQU       5               THE CURRENT CHAR FROM CONTROL CARD 
BITS     EQU       5
WORD     EQU       3
QUAL$    EQU       1
          SST 
 #EK#     MICRO     1,,/ERROR/     TO PREVENT USE OF CI.SQ AND EK.SQ
 QUAL$    EQU    1
#FETA2#  SET       2
Q.FTL    SET       #FTL#
LAST     MICRO
#USE#    MICRO     1,,/0,0,0,0,0,0/    FAKE USE MICRO TO FOOL FOPTN 
#OMIT#   MICRO     1,,/0,0,0,0,0,0/    FAKE OMIT MICRO TO FOOL FOPTN
#GET#    MICRO     1,,/0,0,01D,59D,3,1/  GET STATIC LOAD
 #PUT#    MICRO     1,,/0,0,01D,58D,3,1/  PUT STATIC LOAD 
LASTL    SET       0
NAMEL    SET       0
PARA     SET       4
          TITLE     ERROR    MACRO     MESS,REG 
*#
*0D       ERROR MACRO MESS,REG
*     -MESS- IS THE ERROR MESSAGE.
*     -REG- IF PRESENT GIVES THE PART OF THE CARD TO PUT INTO THE 
*     MESSAGE.  ERROR TRANSFERS TO -SIMPLMES- TO ISSUE THE MESSAGE
*     AND ABORT.
*#
ERROR    MACRO     MESS,REG 
         LOCAL     MM 
         SX7       MM 
KIND     IFC       EQ, REG
         EQ        SIMPLMES 
KIND     ELSE 
         IFEQ      REG,X.CHAR,3 
         BX6       X.CHAR 
         LX6       54 
         DUP       0,2
         LX6       REG,B.SHIFTER
         SA6       MM+2 
         EQ        SIMPLMES 
KIND     ENDIF
         USE       MESSAGE
MM       DIS       ,/ MESS/ 
         USE       *
ERROR    ENDM 
  
          TITLE     NOTTYPE  MACRO     T,L
*#
*0D       NOTTYPE MACRO T,L 
*     -T- IS EITHER -ALPHA- OR -NUMERIC-
*     -L- IS WHERE TO GO IF THE PARAMETER ON THE CARD WAS NOT OF
*     TYPE -T-.  THE TYPE IS SAVED IN -TYPE-. 
*#
NOTTYPE  MACRO     T,L
         SA1       TYPE 
         IFC       EQ,/T/NUMERIC/,2 
         ZR        X1,L 
         ELSE      1
         NZ        X1,L 
NOTTYPE  ENDM 
  
          TITLE     OVER     MACRO     N,L
*#
*0D       OVER,UNDER,NOT,IS MACROS
*     -N- IS THE CHARACTER TO COMPARE THE CURRENT CHARACTER (X.CHAR) TO.
*     -L- IS WHERE TO GO IF TRUE. 
*#
OVER     MACRO     N,L
         SX.T      X.CHAR-N-1 
         PL        X.T,L
OVER     ENDM 
          TITLE     UNDER    MACRO     N,L
UNDER    MACRO     N,L
         SX.T      X.CHAR-N 
         NG        X.T,L
UNDER    ENDM 
  
ZERO     MACRO     L
         ZR        X.CHAR,L 
ZERO     ENDM 
          TITLE     NOT      MACRO     N,L
NOT      MACRO     N,L
         SX.T      X.CHAR-N 
         NZ        X.T,L
NOT      ENDM 
          TITLE     IS       MACRO     N,L
IS       MACRO     N,L
         SX.T      X.CHAR-N 
         ZR        X.T,L
IS       ENDM 
  
          TITLE              MACRO     OPT,NAME,LIST,PLUS 
*#
*0        OPT SETS UP A TABLE OF OPTIONS FOR KEYWORDS WITH SYMBOLIC 
*     VALUES. 
*     -NAME- ANY TAG (MANDITORY), REFERENCED FROM -FOPT- MACRO. 
*     -LIST- THE POSSIBLE VALUES. 
*     -PLUS- KT,RT,BT,ULP HAVE SOMETHING APPENDED (-PLUS-) TO THE 
*     ELEMENTS IN -LIST-. 
*#
         MACRO     OPT,NAME,LIST,PLUS 
NAME     BSS       0
         IRP       LIST 
         CON       0"JUSTIFY"LIST,#_LIST_PLUS_# 
         IRP
NAME.    BSS       0
OPT      ENDM 
          TITLE              MACRO   OPT+T,NAME,LIST
*#
*0        OPT+T IS THE SAME AS -OPT- WITH -PLUS- EUUAL TO -T-.
*#
         MACRO   OPT+T,NAME,LIST
NAME     BSS       0
         IRP       LIST 
         CON       0"JUSTIFY"LIST,#_LIST_T_#
         IRP
NAME.    BSS       0
OPT+T    ENDM 
  
          TITLE              MACRO     FOPT,NAME,ROUTINE,OPTS,DEFAULT 
*#
*         FOPT SETS UP ONE ENTRY IN THE MAIN TABLE (SEE BELOW). 
*         FOPTN IS A SLAVE FOR FOPT.
*#
         MACRO     FOPT,NAME,ROUTINE,OPTS,DEFAULT 
M        IF        -MIC,#_NAME_#
M        IFC       NE,/NAME/OMIT/ 
M        IFC       NE,/NAME/USE/
2        ERR       NAME IS NOT A MICRO
M        ELSE 
         IFC       EQ,/"JUSTIFY"/R/,4 
LASTL    MICCNT    LAST 
THIS     MICRO     1,, NAME 
NAMEL    MICCNT    THIS 
         IFLE      LASTL,NAMEL,2
         IFEQ      LASTL,NAMEL,2
         IFC       GE,/"LAST"/NAME/,1 
         ERR       OPTIONS OUT OF ORDER 
LAST     MICRO     1,,/NAME/
NITEM    SET       NITEM+1
         CON          0"JUSTIFY"NAME
         FOPTN     ROUTINE-JUMPS,"#_NAME_#" 
         IFC       NE,/OPTS//,2 
         VFD       30/OPTS.,30/OPTS 
         SKIP      1
         CON       DEFAULT
M        ENDIF
FOPT     ENDM 
  
          TITLE     FOPTN     MACRO     ROUTINE,TABL,WORD,LEN,BIT 
FOPTN     MACRO     ROUTINE,TABL,WORD,LEN,BIT 
         VFD       12/2000B+BIT,30/ROUTINE,18/WORD
TMPF     SET       60-LEN-BIT 
         VFD       TMPF/,LEN/-0,BIT/    MASK WORD 
FOPTN    ENDM 
          TITLE     GETCHAR  MACRO
*#
*0D       GETCHAR, GETDEL, GETWORD MACROS 
*     THESE MACROS GET THE NEXT CHARACTER, DELIMITER (BETWEEN 
*     PARAMETERS), AND PARAMETER, RESPECTIVELY, OFF THE CONTROL CARD. 
*     REGISTERS.. 
*             TEMP--B4
*             OUT--X5 (X.CHAR)
*             GLOBAL--X0=54 BIT MASK
*                     AX4=CURRENT WORD
*                     B2=POSITION IN CURRENT WORD 
*                     B1=1
*     CALLS..   REFILL (TO GET NEXT WORD) 
*#
GETCHAR  MACRO
GETCHAR  SET       0
         LX4       6
         BX.CHAR  -X0*X4
         SB2       B2-B1
GETCHAR  ENDM 
  
GETDEL   MACRO
         SA.PARA   A.PARA 
         BX.CHAR   -X0*X.PARA 
         SA.CHAR   X.CHAR+DELS
GETDEL   ENDM 
  
GETWORD  MACRO
         RJ        GETWORD
GETWORD  ENDM 
  
DELS     DATA      0
         ECHO      1,C=((,),=,/,(( )),+,-)
         DATA      1R_C 
         DUP       8,1
         DATA      1R,
         DATA      1R.
          TITLE     STUFF    MACRO     XREG 
*#
*0D       STUFF MACRO XREG
*     -STUFF- POSITIONS -XREG- AND JUMPS TO -STUFFIT- (WHICH ENDS UP
*     BY GOING TO -CKDELIM-).     REGISTERS.. 
*             TEMP--A137, X01367
*             IN--A2=POINTER INTO -TABLE- 
*                 B.BITS (B5)=BIT POSITION
*                 B.WORD (B3)=WORD IN FIT 
*             GLOBAL--B1=1
*                     AX4,X.CHAR,B2 (SEE -GETCHAR-) 
*#
STUFF    MACRO     XREG 
         LX6       XREG,B.BITS
         EQ        STUFFIT
         ENDM 
          TITLE     BINSRCH  MACRO     ITEM,TABLE,ISIZE,TSIZE,NOTFND
*#
*0        -BINSRCH- IS CALLED IN ONE PLACE TO SEARCH -TABLE-. 
*     -ITEM- = WHAT TO SEARCH FOR (IGNORED, ASSUMED TO BE X6) 
*     -TABLE- = -TABLE- 
*     -ISIZE- = ITEM SIZE = 4 
*     -TSIZE- = SIZE OF -TABLE- 
*     -NOTFND- = WHERE TO GO IF NOT FOUND 
*     REGISTERS.. 
*             IN--X6
*             TEMP--X1235,B345
*             OUT--A2=ADDRESS WITHIN -TABLE-
*#
BINSRCH  MACRO     ITEM,TABLE,ISIZE,TSIZE,NOTFND
          LOCAL     BS1,BS2 
          SPACE     1 
          SX3       ISIZE          ITEM SIZE
          SB5       TSIZE+1        TABLE SIZE (END OF TABLE +1) 
          SB3       -B1            START OF TABLE - 1 
          MX5       36             KEY FIELD MASK 
          BX6       X6*X5          ISOLATE KEY
 BS1      BSS       0 
          SB4       B5+0           BIG = NEW BOUND
 BS2      BSS       0 
          SB5       B4-B3          BIG - SMALL
          LE        B5,B1,NOTFND   IF DIF LT 2, KEY NOT FOUND 
          SX1       B4+B3          NEW = BIG + SMALL
          AX2       X1,B1          NEW = (BIG+SMALL)/2
          SB5       X2+0           NEW BOUND
          IX1       X2*X3          NEW * ITEM SIZE
          SA2       X1+TABLE       NEW ITEM 
          BX2       X5*X2          ISOLATE ITEM 
          IX1       X6-X2          KEY - ITEM 
          NG        X1,BS1         IF ITEM GT KEY 
          SB3       B5+0           SMALL - NEW BOUND
          NZ        X1,BS2         IF KEY NE ITEM 
BINSRCH  ENDM 
  
          TITLE     FILLOUT  MACRO     WITH,SIZE
*#
*0D       FILLOUT MACRO WITH,SIZE 
*         -TABLE- IS PADDED WITH ONE EXTRA ITEM FOR CASE WHERE KEY IS 
*         GREATER THAN ANY IN TABLE.
*         -WITH- IS FILLER AND COMPARES GREATER THAN ANY IN TABLE.
*         -SIZE- IS THE NUMBER OF WORDS PER ITEM IN TABLE.
*#
FILLOUT  MACRO     WITH,SIZE
         CON       WITH 
         BSSZ      SIZE-1 
 TBLSIZ   SET       NITEM+1 
FILLOUT  ENDM 
*#
*0        -JUSTIFY- IS A MICRO WITH VALUE -R- OR -L- INDICATING RIGHT 
*     OR LEFT JUSTIFICATION OF CHARACTER STRINGS IN A REGISTER. 
*     NOTE THAT WITH THE CURRENT SCHEME OF PARAMETER CRACKING -L- IS
*     USED.  BUT IF IT IS EVER NECESSARY/DESIRABLE TO CHANGE (REWRITE)
*     THE CRACKING ROUTINES THEN EVERYTHING ELSE (-TABLE-, -FOPT-, -OPT-
*     -ERROR-, ETC.) WILL (HOPEFULLY) CHANGE AUTOMATICALLY. 
*#
JUSTIFY  MICRO     1,, L
SHIFTER  SET       0
         IFC       EQ, "JUSTIFY" R ,1 
SHIFTER  SET       CCT
         TITLE     STATIC LOADING MACRO+CAPSULE NAMES 
*         TABLE OF MACRO NAMES (FIRST 6 CHARACYERS) AND BASIC 
*     (W/OUT $RM,$SQ,ETC) CAPSULE NAME TO ACCOMPLISH THAT MACRO-S 
*     FUNCTION. 
************************************************************************
*          ANY CHANGES TO THIS TABLE MUST BE REFLECTED IN CAHNGES 
*         TO *FOMASK* 
************************************************************************
STATBL   BSS       0
         VFD       36D/5LCHECK,24D/4RCHEK 
          VFD       36D/6LCHECKR,24D/4RCHEK 
STATCL   VFD       36D/6LCLOSEL,24D/4RLABL
 STATCLO  BSS       0 
         VFD       36D/6LCLOSEM,24D/4RCLSF
 STATDEL  BSS       0 
         VFD       36D/6LDELETE,24D/3RDLT 
          VFD       36D/6LENDFIL,24D/4RWEOX 
 STATFLSH VFD       36D/6LFLUSHM,24D/4RFLSH 
STATGET  VFD       36D/3LGET,24D/3RGET
STATGL   VFD       36D/4LGETL,24D/4RLABL
         VFD       36D/4LGETN,24D/4RGETN
 STATGNR  BSS       0 
          VFD       36D/5LGETNR,24D/4RGTNR
STATGETP VFD       36D/4LGETP,24D/3RGET 
 STATGTWR VFD       36D/5LGETWR,24D/4RGTWR
STATOPEN VFD       36D/5LOPENM,24D/4ROPEN 
STATPUT  VFD       36D/3LPUT,24D/3RPUT
STATPL   VFD       36D/4LPUTL,24D/4RLABL
STATPUTP VFD       36D/4LPUTP,24D/3RPUT 
 STATPTWR VFD       36D/5LPUTWR,24D/4RPTWR
 STATREP  BSS       0 
         VFD       36D/6LREPLAC,24D/4RREPL
         VFD       36D/6LREWIND,24D/3RREW 
 STATRMK  VFD       36D/6LRMKDEF,24D/4RKDEF 
 STATSEK  BSS       0 
         VFD       36D/4LSEEK,24D/4RSEEK
STATSTFT VFD       36D/6LSETFIT,24D/4RSTFT
          VFD       36D/6LSKIPBF,24D/4RSKIP 
STATSKBL VFD       36D/6LSKIPBL,24D/4RSKBL
          VFD       36D/6LSKIPBP,24D/4RSKIP 
          VFD       36D/6LSKIPFF,24D/4RSKIP 
STATSKFL VFD       36D/6LSKIPFL,24D/4RSKFL
          VFD       36D/6LSKIPFP,24D/4RSKIP 
         VFD       36D/5LSTART,24D/4RSTRT 
          VFD       36D/4LTGET,24D/4RGPTM 
          VFD       36D/4LTPUT,24D/4RGPTM 
          VFD       36D/4LWEOR,24D/4RWEOX 
STATWM   VFD       36D/4LWTMK,24D/4RLABL
STATBLND BSS       0
STATBLSZ EQU       STATBLND-STATBL
         SPACE     4
         TITLE     ZZZZZDG VFD-S AND EQU-S
*         FO,BT,RT DISPLAY CODE CHARACTERS TO APPEND TO GET/PUT FOR 
*     STATIC LOADING
FOBAM    VFD       36D/0,12D/0LWA,12D/0LSQ
FOAAM    VFD       12D/0,12D/0LAK,12D/0LDA,12D/0,12D/0LIS 
BTDC     VFD       30D/0,6/0LE,6/0LK,6/0LC,6/0LI,6/0
RTDC     VFD       6/0,6/0LS,6/0LU,6/0,6/0LT,6/0LD,6/0LZ,6/0LR,6/0LF,6/0
,LW 
INDEXSIZ EQU       63 
 EXTBSZ   EQU       17D 
  
*        WHEN CHANGING FILSIZ DONT FORGET TO CHANGE SLSZ.RM IN TXTCRM 
 FILSIZ   EQU       INDEXSIZ+2*Q.FTL+STATBLSZ+EXTBSZ+2+1
"DEFILE" VFD       42/0L"DEFILE",18/3 
         VFD       60/BUF 
         VFD       60/BUF 
         VFD       60/BUF 
         VFD       60/BUF+FILSIZ
 BUF      BSSZ      INDEXSIZ
         VFD       60/2*Q.FTL+1 
FLAGS    BSSZ      1
 FIT      BSSZ      FILSIZ-INDEXSIZ-1 
MASK     EQU       FIT+Q.FTL
EXTA     EQU       MASK+Q.FTL      CONTAINS FO-LEVEL EXTERNALS (STAT LD)
EXTB     EQU       EXTA+STATBLSZ   CONTAINS BT/RT EXT + MISC$RM ETC 
OUT      EQU       "DEFILE"+3 
IN       EQU       "DEFILE"+2 
         SPACE     1
          TITLE     HRL      MACRO     T,W,L,B
HRL      MACRO     T,W,L,B
#HRL#    MICRO     1,,/T,W,42,B/
         ENDM 
         HRL       "#HRL#"
#LFN#    MICRO     1,,/0,00,42,18/
         TITLE     EXTERNAL SYMBOL EQU-S
* 
*        ZZZZZDG EQU SYMBOLS FOR STATIC LOADING EXTERNALS 
************************************************************************
*         ANY CHANGES TO THIS TABLE MUST BE REFLECTED IN CHANGES
*         TO *FOMASK* 
************************************************************************
* 
GETBT    EQU       EXTB            ORDER-DEPENDENT ON CODE IN ABR---
GETRT    EQU       EXTB+1            GET/PUT BT PRECEDES GET/PUT RT 
PUTBT    EQU       EXTB+2 
PUTRT    EQU       EXTB+3 
 LBUF     EQU       EXTB+5
RPAR     EQU       EXTB+6 
 ERRS     EQU       EXTB+7
 DF       EQU       EXTB+8
 CLOSE    EQU       EXTB+9D 
OPEN     EQU       EXTB+10D 
COMM     EQU       EXTB+11D 
 AAMCTL   EQU       EXTB+12D
 SEEKMP   EQU       EXTB+13D
 GETMP    EQU       EXTB+14D
 PUTMP    EQU       EXTB+15D
 RBL      EQU       EXTB+16D
************************************************************************
*         THIS TABLE CONTAINS A WORD FOR EACH FO
*         THESE WORDS HAVE A BIT SET FOR EACH FCN IN EXTA 
*          AND EXTB THAT IS VALID FOR THAT FO.  ANY CHANGES TO EXTA 
*         OR EXTB MUST BE REFLECTED HERE
************************************************************************
 FOMASK   BSS       0 
          VFD       60D/75715761767765701000B 
          VFD       60D/04201020000001741000B 
          VFD       60D/0 
          VFD       60D/06263066450021721000B 
          VFD       60D/0 
          VFD       60D/06263066450021721000B 
          VFD       60D/06263066450021721000B 
 MPMASK   VFD       60D/00000010000000016000B 
         TITLE     KEYWORD TABLE
*#
*0        -TABLE- CONTAINS ALL THE ALLOWABLE KEYWORDS.  THE ENTRIES 
*     MUST BE IN ALPHABETICAL ORDER (WHEN APPROPRIATELY ALLIGNED, RE..
*     MICRO -JUSTIFY-).  -TABLE- IS PADDED (SEE -FILLOUT-) SO THAT A
*     BINARY SEARCH (-BINSRCH-) CAN BE USED.
*     -FOPT- GENERATES -TABLE-, ITS ARGUMENTS ARE 
*         1.  INDICATION OF WHICH ROUTINE TO USE TO DECODE OPTION.. 
*                  A=ALPHA OPTION IS SYMBOLIC, TABLE LOOKUP NEEDED
*                  D=DECIMAL OPTION IS A DECIMAL NUMBER 
*                  DM=DECMAX OPTION IS DECIMAL WITH UPPER LIMIT 
*                  O=OCTAL  OPTION IS OCTAL 
*                  OD=OCTDEC  OPTION IS OCTAL (PREFERRED) OR DECIMAL
*                  L7=LEFT7 OPTION IS FILE NAME 
*         2.  NAME OF AN OPT-SEQUENCE OF OPTIONS. 
*                  (FOR A=ALPHA ONLY) 
*         3.  A NUMBER
*                  FOR DM=DECMAX        THE LEAST UPPER BOUND 
*                  FOR ALL EXCEPT A,DM  THE DEFAULT VALUE (USUALLY 0) 
*                  FOR ALL EXCEPT A,DM  -0 INDICATES NO DEFAULT ALLOWED 
*     EACH ENTRY IN -TABLE- LOOKS LIKE
*      WRD 0  THE KEYWORD IN DISPLAY CODE 
*      WRD 1  BIT 58.. 1 (FOR USE OF UNPACK INSTRUCTION)
*             BITS 53-48: THE BIT POSITION OF THE FIELD (IN FIT)
*             BITS 29-18: THE ROUTINE TO EXECUTE
*             BITS 17-0: THE WORD NUMBER (IN FIT) 
*      WRD 2  A MASK CORRESPONDING TO THE FIELD.
*      WRD 3       EITHER 
*             THE BOUNDS FOR SEARCHING A LIST OF SYMBOLIC OPTIONS 
*                  OR 
*             THE DEFAULT 
*                  OR 
*             THE MAXIMUM+1 
*                  OR 
*             -0 FOR NO DEFAULT ALLOWED 
*#
NITEM    SET       0
TABLE    BSS       0
 ASCII    FOPT      DM,,3 
 BBH      FOPT      A,NOYES 
BCK      FOPT      A,NOYES
 BFS      FOPT      DM,,1S17
BT       FOPT      A,ICKE 
B8F       FOPT      A,NOYES 
 CC       FOPT      A,NOYES 
CF       FOPT      A,RNU
CL       FOPT      DM,,7                                                0038   6
CM       FOPT      A,NOYES
 CNF      FOPT      A,NOYES 
CP       FOPT      D
CPA       FOPT      DM,,100B
 C1       FOPT     A,NOYES                                              AT25   3
 DFC      FOPT      D 
 DKI      FOPT      A,NOYES 
DP       FOPT      DM,,100                                              0038   8
 EFC      FOPT      D 
 EMK      FOPT      A,NOYES 
EO       FOPT      A,TDA
ERL      FOPT      D                                                    0038  10
 EXD      FOPT      A,NOYES 
 FF       FOPT      A,NOYES 
 FIB      FOPT      A,NOYES 
FL       FOPT      D
FLM      FOPT      D
FO       FOPT      A,SQETC
FWI      FOPT      A,NOYES
 HB       FOPT     A,NOYES
HL       FOPT      D
HMB      FOPT      D
IBL      FOPT      D
 IC       FOPT      A,ICOPTS
IP       FOPT      DM,,100                                              0038  12
KL       FOPT      D
KP       FOPT      DM,,10                                               0038  14
 KT       FOPT      A,SIFUA 
LBL      FOPT      D
LCR      FOPT      A,CRTCHK 
LFN      FOPT      L7 
LL       FOPT      DM,,7                                                0038  16
LP       FOPT      D
LT       FOPT      A,STNSUL 
MBL      FOPT      D
MFN       FOPT      L6
MKL      FOPT      D
MNB      FOPT      D
MNR      FOPT      D
MRL      FOPT      D
MUL      FOPT      D
 NDX      FOPT      A,NOYES 
NL       FOPT      D
OF       FOPT      A,RNE
OMIT     FOPT      OM,,-OMITDEF 
ON        FOPT      A,OLDNEW
 ORG      FOPT      A,OLDNEW
 OVF      FOPT      A,OV                                                T41Z  31
 PC       FOPT      D 
PD        FOPT      A,INOUT 
PM       FOPT      A,SR 
PNO       FOPT      D 
RB       FOPT      D
REL       FOPT      A,EQLEGE
 RKP      FOPT      DM,,11
RKW      FOPT      DM,,4097 
 RMK      FOPT      D,,62B
RT       FOPT      A,RECTYP 
 SB       FOPT     A,NOYES                                              AT25   5
 SBF      FOPT      A,NOYES 
 SDS      FOPT      A,NOYES 
SPR      FOPT      A,NOYES
TL       FOPT      D
TRC       FOPT      DM,,64
ULP      FOPT      A,ULPS 
USE      FOPT      U,,-USEDEF 
VF       FOPT      A,RNU
XBS       FOPT      DM,,1S17
XN       FOPT      L7 
         FILLOUT   4"JUSTIFY"4444,4 
TABLEEND BSS       0
  
* THE TABLE OF ALPHA OPTIONS
 SQETC    OPT       (SQ,WA,IS,DA,AK)
NOYES    OPT       (NO,YES) 
 SR       OPT       (S,R),PM
STNSUL   OPT       (S,NS,UL,ANY)
ICKE     OPT+T     (I,C,K,E)
INOUT     OPT       (INPUT,OUTPUT,IO) 
OLDNEW    OPT       (OLD,NEW) 
RECTYP    OPT+T     (W,F,R,Z,D,T,U,S) 
 SIFUA    OPT       (S,I,F,U,A),KT
CRTCHK    OPT       (CHK,CRT) 
ULPS     OPT       (NO,V,F,VF,U,FU,VFU,VU),P
TDA      OPT       (T,D,A,TD,DD,AD) 
RNE      OPT       (R,N,E)
 RNU      OPT       (R,N,U,RET,DIS,DET) 
 OV       OPT       (OVO,OVB,OVH)                                       T41Z  33
EQLEGE    OPT       (EQ,LE,GE,NE,LT,GT) 
 ICOPTS   OPT       (D64,D63,AS6,AS8,ASCII,EBCDIC,BCD)
  
 EVNODD   OPT       (EVN,ODD) 
         LIST      A,G,D,X
         LIST      -G,-D
         TITLE     GET THE LFN
         ENTRY     FILEC
FILEC    BSS       0
*#
*0DC  CODE
*0        TO START WITH GET PAST -FILE- AND PICK UP (AND CHECK) THE FILE
*     NAME.  THEN LOOK FOR IT IN ZZZZZDF ("DEFILE").  THERE ARE SEVERAL 
*     POSSIBILITIES.. 
*         . ZZZZZDF IS EMPTY
*         . THE FILE NAME IS FOUND
*         . NOT FOUND BUT AN EMPTY ENTRY (I. E. <0) WAS FOUND.
*         . NOT FOUND BUT NO EMPTY ENTRIES--ADD ONTO THE END. 
*     SINCE THE BUFFER CONTAINS ROOM FOR BOTH THE INDEX (INDEXSIZ=63
*     WORDS) AND THE ENTRY, THEN, IF THE FILE NAME IS FOUND, A -SKIPF-
*     AND A -READ- ARE DONE TO GET THE PREVIOUS INFORMATION ON THE
*     FILE INTO THE SECOND PART OF THE BUFFER.
*#
         SA1       2               CHECK FOR *FILE.*
         SB2       10 
         MX0       54 
         SB1       1
         SA.PARA   1
         ZR        X1,CLOSER       JUMP IF *FILE.*
         SB6       GOTNAME
         GETWORD
         OVER      1RZ,BADFNAM
         ZERO      BADNEWN
         BX6       X4 
         BINSRCH   X6,TABLE,4,TBLSIZ,SNTXOK 
         MX7       1
         SA7       SNTXCK 
SNTXOK   BSS       0
         EQ        ALPH 
BADFNAM  ERROR     (FIRST PARAMETER MUST BE FILE NAME)
GOTNAME  LX6       X6,B.SHIFTER 
         SX1       A4 
         PX7       X1,B4
         LX7       12 
         PX7       X7,B2
         SA7       POINTER         SAVE SOURCE POINTERS 
          SA0       "DEFILE"
          SYSY      160B,RCL       OPEN 
 .NODROP  IFNE      #NODROP#,0
          SX2       =YLFM=
          NG        X2,SKP.NAD
          BX3       X6             SAVE X6 ACROSS THE SET.FS SYSTEM CALL
          SET.FS     A0,NAD 
          BX6       X3
 SKP.NAD  BSS       0 
 .NODROP  ENDIF 
 RDINDX   BSS       0 
          SYSY      010B,RCL       READ 
          SA2       A0             FET
         SX0       30B                  EOF 
         BX3       X2*X0
         IX2       X0-X3
         SX7       FIT-2
         MX0       54 
         SA7       OUT
         SA7       IN 
         ZR        X2,NOENT             JUMP IF NO ENTRIES
         SA3       BUF-1           INITIALIZE A3
         SB3       0
 SFFILE  BSS       0
         SA3       A3+B1           SEARCH FOR FILE NAME 
         IX2       X3-X6
         SB4       X3 
         PL        X3,NMT          JUMP IF NOT CANCELLED-FILE(LFN)
         NZ        B3,NMT 
         SB3       A3+0            REMEMBER EMPTY ENTRY 
NMT      BSS       0
         ZR        X3,NF
         EQ        B4,B1,NF        IF AT 63RD ENTRY (END OF INDEX)
         NZ        X2,SFFILE
         SB3       A3              FOUND MATCHING LFN-USE THIS ENTRY
         EQ        REE
NF       NZ        B3,REE 
         SB3       A3+0            USE NEW ENTRY
          SX1       B3-BUF-62      CHECK IF AT END OF INDEX 
          NZ        X1,REE         FOUND EMPTY ENTRY-USE IT 
         EQ        B4,B1,SKP2NDX
         SX7       B1              TO INDICATE ANOTHER INDEX 62 PRUS OUT
         SA7       BUF+62 
         SX7       BUF
         SA7       OUT
         SX7       BUF+63 
         SA7       IN 
         SYSY      640B,R 
         SYSY      224B,R          REWRITE INDEX WITH 1 IN WORD 63
SKP2NDX  BSS       0
         SX4       62              62 FILES PER INDEX-SKIP TO NEXT INDEX
          SYSY      240B,R,4       SKIPF
          SX7       BUF 
          SA7       OUT 
          SA7       IN
          SB3       INDEXSIZ-1     ZERO BUF ARRAY 
          MX7       0 
 CLRLP    BSS       0 
         SA7       BUF+B3 
         SB3       B3-B1
         GE        B3,B0,CLRLP
          EQ        RDINDX
REE      BSS       0
         SX7       B3-BUF 
         SA7       =SWHERE
         GETDEL                    GET DELIMITER
         IS        1R.,CANCEL      JUMP IF CANCEL OPTION
         IS        1R),CANCEL      JUMP IF CANCEL OPTION
         SA6       B3 
          SX5       B1
         NZ        X2,DOWORK
          SX5       B1+B1 
         ZR        X7,FF
          SX4       X7
          SYSY      240B,RCL,4     SKIPF
         SA4       =SWHERE
         SX5       X4+2 
         SA4       =SWHERE
         SX5       X4+2 
FF       BSS       0
          SYSY      010B,RCL       READ 
 DOWORK   BSS       0 
          SYSY      640B,RCL,5     SKIPB TO INDEX (TO REWRITE AT QED) 
         EQ        GETNAME
CANCEL   BSS       0               CANCEL OPTION - FILE(LFN)
         MX7       1               SET SIGN BIT TO CANCEL FILEC INFO
         ZR        X3,CLOSEF       JUMP IF NAME NOT IN INDEX
         BX6       X6+X7
         MX7       59              SET CANCEL OPTION FLAG FOR QED CODE
         SA6       B3 
         SA7       CANCLFLG 
         SYSY      640B,RCL        SKIPB
         EQ        QED             DONE WITH CARD 
NOENT    BSS       0
         GETDEL                    GET DELIMITER
         IS        1R.,CLOSEF      JUMP IF CANCEL OPTION
         IS        1R),CLOSEF      JUMP IF CANCEL OPTION
         SA6       BUF
         TITLE     MAIN LOOP
*#
*         CHECK FOR THE CONSTRUCT LFN=NEWLFN.  IF IT EXISTS THEN FILL IN
*     THE FIRST WORDS OF THE PSEUDO-FIT AND MASK.  IF THE LEFT HAND 
*     FILE NAME IS ALSO A KEYWORD, ISSUE A WARNING MESSAGE INDICATING 
*     THAT THERE MAY BE AN ERROR. 
*#
GETNAME  BSS       0
         SA1       POINTER         RESET SCORE POINTERS 
         MX0       54 
         UX2       X1,B2
         LX2       60-12
         UX1       X2,B4
         SB1       1
         SA4       X1 
         GETDEL 
         NOT       1R=,CKDELIM
* CHANGE FILE NAME
         SA1       SNTXCK 
         PL        X1,SOK 
         MESSAGE   SNTXMSG,,RCL 
SOK      BSS       0
         SB6       NEWNAME
         GETWORD
         ZERO      BADNEWN
         UNDER     1R0,ALPH 
BADNEWN  ERROR     (FILE NAME MISSING OR IMPROPER)
SNTXCK   DATA      0
SNTXMSG  DIS       ,/ CHECK FILE CARD SYNTAX/ 
NEWNAME  BSS       0
         IFC       EQ, "JUSTIFY" R ,1 
         LX6       B.CCT,X6 
         SA6       FIT             NEW FILE NAME
         MX7       42 
         SA7       MASK 
         GETDEL 
*         THE MAIN LOOP STARTS AT -CKDELIM- AND FLOWS RELATIVELY
*     SMOOTHLY TO -JUMPS- WHICH THEN TAKES OFF TO ANY OF SEVERAL PLACES 
*     WHICH THEN GO TO -STUFFIT- (-STUFF- MACRO) WHICH FINALLY JUMPS
*     BACK TO -CKDELIM-.  -CKDELIM- CHECKS THE DELIMITER..
*         . )    ->    -QED- (FINISHED WITH CARD) 
*         + - *    ->    -BADCHAR-
*         OTHERS, PARTICULARLY COMMA,    ->    FALL THROUGH INTO CODE 
*     THAT USES -ALPH- TO GET THE KEYWORD (IT RETURNS VIA B6 TO -GOTKEY-
*     ).  THEN SEARCH -TABLE- FOR THE KEYWORD.  PART OF THE TABLE ENTRY 
*     (SEE ABOVE) SAYS WHERE TO JUMP TO IN ORDER TO HANDLE THE DESIRED
*     PARAMETER.  IF THE KEYWORD IS BY TISELF GO TO -ALONE- BUT IF IT 
*     IS FOLLOWED BY AN EQUAL SIGN CALL WITHER -ALPH- OR -NUM- TO CRACK 
*     THE VALUE.  THEN JUMP TO... 
*#
*     PUT IN RA+1.
*#
CKDELIM  BSS       0
         GETDEL 
CKDELIMA BSS       0
         IS        1R.,QED
         IS        1R),QED
         UNDER     1R/,BADCHAR     ALLOW DELIMETER TO BE ANY SPECIAL
*                                  CHARACTER EXCEPT  +-*.)
* MAIN LOOP 
         SB6       GOTKEY 
         EQ        G.ALPH 
BADCHAR  ERROR     (ILLEGAL CHARACTER            ),X.CHAR 
GOTKEY   BINSRCH   X6,TABLE,4,TBLSIZ,BADKEY 
         SA.T      CURKEYI
         LX6       60-18-6
         SA6       CURKEY+X.T 
         LX6       18+6 
         GETDEL 
         NOT       1R=,ALONE
         SB6       GOTOPT 
         GETWORD
         UNDER     1R0,ALPH 
         UNDER     1R+,NUM
         EQ        BADCHAR
BADKEY   ERROR     (BAD KEYWORD                  ),X6 
* HAVE FOUND ENTRY IN MASTER TABLE, ADDR OF ENTRY IS IN A2
GOTOPT   SA3       A2+1 
         UX.T      X3,B.BITS       BIT POSITION OF FIELD
         SB.WORD   X.T
         AX.T      18 
         SB4       X.T
         TITLE     HANDLE VARIOUS TYPES OF OPTIONS
JUMPS    JP        *+B4 
D        JP        DECIMAL
O        JP        OCTAL
A        JP        ALPHA
OD       JP        OCTDEC 
DM       JP        DECMAX 
L7       JP        LEFT7
L6        JP        LEFT6 
U        JP        USE
OM       JP        OMIT 
  
*#
*         DECIMAL OR OCTAL..  WHICH MAKE SURE IT GOT A NUMBER AND THEN
*     STUFFS IT.
*#
DECIMAL  NOTTYPE        NUMERIC,NOTNUM
         NG        X6,BADNUM
         STUFF     X6 
NOTNUM   BSS       0
BADNUM   ERROR     (EXPECTED NUMBER, DIDNT GET) 
  
OCTAL    NOTTYPE        NUMERIC,NOTNUM
         NG        X7,BADOCT
         STUFF     X7 
BADOCT   ERROR     (BAD OCTAL NUMBER) 
  
* REGS USED IN SEARCH   IN: X16        TEMP: X3   B46   OUT: A3 
          TITLE     SEARCH   MACRO
SEARCH   MACRO
         LOCAL     SFND 
         SB4       X.T             WHERE TO START SEARCHING 
         AX.T      30 
         SB6       X.T             WHERE TO STOP
         SA3       B4 
         IX.T      X3-X6
         ZR        X.T,SFND        JUMP IF FOUND
SLOOP    SA3       A3+2 
         SB4       B4+2 
         IX.T      X3-X6
         ZR        X.T,SFND        JUMP IF FOUND
         LT        B4,B6,SLOOP
         EQ        BADOPT 
SFND     BSS       0
SEARCH   ENDM 
BADOPT   ERROR     (UNFAMILIAR OPTION            ),X6 
  
*     FALL INTO ALPHA 
*#
*         ALPHA..  WHICH EXPECTS A CHARACTER STRING THAT IT HAS TO LOOK 
*     UP IN AN -OPT- TABLE. 
*#
ALPHA    NOTTYPE        ALPHA,BADALPH 
         SA.T      A2+3 
         SEARCH 
         SA3       A3+B1
         STUFF     X3 
BADALPH  ERROR     (BAD ALPHA)
  
  
*#
*         OCTDEC..  PREFERS TO HAVE AN OCTAL NUMBER.
*#
OCTDEC   NOTTYPE   NUMERIC,NOTNUM 
         PL        X7,ODOK
         NG        X6,BADNUM
         BX7       X6 
ODOK     STUFF     X7 
  
*#
*         DECMAX..  EXPECTS A DECIMAL NUMBER BUT -TABLE- HAS AN UPPER 
*     LIMIT ON ITS VALUE. 
*#
DECMAX   NOTTYPE   NUMERIC,NOTNUM 
         NG        X6,BADNUM
         SA3       A2+3 
         IX2       X6-X3
         PL        X2,NUM2BIG 
         STUFF     X6 
NUM2BIG  ERROR     (NUMBER TOO BIG FOR FIELD) 
         SPACE     1
*#
*         LEFT7..  PRODUCES 7 CHARACTERS LEFT JUSTIFIED, ZERO FILL (A 
*     FILE NAME). 
*#
LEFT7    NOTTYPE   ALPHA,BADFILN
         IFC       EQ,/"JUSTIFY"/R/,3 
         SB.CCT    B.CCT-60+42
         LT        B.CCT,B0,BADFILN 
         LX6       X6,B.CCT 
          IFC      EQ,/"JUSTIFY"/L/,1 
         LX6       42 
         STUFF     X6 
LEFT6     NOTTYPE   ALPHA,BADFILN 
          IFC       EQ,/"JUSTIFY"/R/,3
          SB.CCT    B.CCT-60+42 
          LT        B.CCT,B0,BADFILN
          LX6       X6,B.CCT
          IFC       EQ,/"JUSTIFY"/L/,1
          LX6       36
          STUFF     X6
BADFILN  ERROR     (BAD FILE NAME                ),X6 
         SPACE     2
*#
*         USE..  ADD CAPSULE NAMES TO ZZZZZDG FOR STATIC LOADING. 
*#
USE      BSS       0
          SA2       =0LEF$CRM 
          LX7       B0,X2 
          SA7       ERRS
 USE1     BSS       0 
         BINSRCH   X6,STATBL,1,STATBLSZ,BADUSE
         SA2       A2 
         MX7       36              ADD FCN IN LOWER 24 BITS OF TBL ENTRY
         BX7       -X7*X2 
         SA7       EXTA+A2-STATBL 
         SX6       X7-3RGET        IF USE=GET, SET GET$ FLAG
          SA0       FLAGS 
         NZ        X6,UNOTGET 
         SET.RM    GET,1
UNOTGET  BSS       0
          SX6       X7-3RPUT
          NZ        X6,UNOTPUT     IF USE=PUT, SET PUT$ FLAG
          SET.RM    PUT,1 
 UNOTPUT  BSS       0 
         GETDEL                    GET DELIMITER
         NOT       1R/,CKDELIMA    MUST BE / OR NEXT WD IS KEYWD
         GETWORD
         BX6       X4 
          EQ        USE1           PROCESS NEXT USE OPTION (FCN)
BADUSE   ERROR     (BAD MACRO IN USE     ),X6 
         SPACE     2
*#
*         OMIT..  REMOVE CAPSULE NAMES FROM ZZZZZDG TO PREVENT
*     STATIC LOADING. 
*#
OMIT     BSS       0
         BINSRCH   X6,STATBL,1,STATBLSZ,BADOMIT 
         SA2       A2              IF OMIT=GET, CLEAR GET$ FLAG 
         MX7       36 
         BX7       -X7*X2 
         SX6       X7-3RGET 
          SA0       FLAGS 
         NZ        X6,ONOTGET 
         SET.RM    GET,0
ONOTGET  BSS       0
          SX6       X7-3RPUT
          NZ        X6,ONOTPUT     IF OMIT=PUT, CLEAR PUT$ FLAG 
          SET.RM    PUT,0 
 ONOTPUT  BSS       0 
         SX7       B0              CLEAR ZZZZZDG ENTRY
         SA7       EXTA+A2-STATBL 
         GETDEL                    GET DELIMITER
         NOT       1R/,CKDELIMA    MUST BE / OR NEXT WD IS KEYWD
         GETWORD
         BX6       X4 
         EQ        OMIT 
BADOMIT  ERROR     (BAD MACRO IN OMIT     ),X6
         SPACE     2
*#
*         USEDEF..  USE DEFAULT ADDS ALL EXTERNALS TO ZZZZZDG.
*#
USEDEF   BSS       0               DEFAULT USE--PUT ALL EXT IN ZZZZZDG
         SA0       FLAGS
         SET.RM    GET,1
          SET.RM    PUT,1 
          SA2       =0LEF$CRM 
          LX7       B0,X2 
          SA7       ERRS
         SA1       STATBL+STATBLSZ
         SA2       STATBL+STATBLSZ+1
         MX5       36 
         SB3       EXTB-2          DESTINATION
         SB4       B1+B1
UD.LOOP  BSS       0
         SA1       A1-B4
         SA2       A2-B4
         BX6       -X5*X1 
         BX7       -X5*X2 
         SA6       B3 
         SA7       B3+B1
         SB3       B3-B4
         SB5       A1-STATBL
         GT        B5,B1,UD.LOOP   NOT DONE--AT LEAST 2 MORE ENTRIES
         EQ        B5,B0,CKDELIM   DONE--GET NEXT KEYWORD 
         SA1       STATBL 
         BX6       -X5*X1 
         SA6       EXTA 
         EQ        CKDELIM
         SPACE     2
*#
*         OMITDEF..  OMIT DEFAULT CLEARS ALL EXTERNALS IN ZZZZZDG.
*#
OMITDEF  BSS       0               DEFAULT OMIT--REMOVE ALL EXT 
         SA0       FLAGS
         SET.RM    GET,0
          SET.RM    PUT,0 
         SB3       B0 
         SB4       B1+B1
         SX6       B0 
         MX7       0
OD.LOOP  BSS       0
         SA6       EXTA+B3
         SA7       EXTA+1+B3
         SB3       B3+B4
          SB5       B3-STATBLSZ-EXTBSZ+1
         LT        B5,B0,OD.LOOP   IF AT LEAST 2 MORE ENTRIES 
         EQ        B5,B1,CKDELIM   JUMP IF DONE 
         SA6       EXTA+B3
         EQ        CKDELIM
         SPACE     1
*#
*         IF THE KEYWORD HAD BEEN -ALONE- (NO EQUAL SIGN) THEN AN 
*     ATTEMPT IS MADE TO FILL IN A VALUE BY DEFAULT.  -TABLE- MAY HAVE
*     A DEFAULT VALUE IN IT OR THE FIRST ENTRY IN THE ASSOCIATED -OPT-
*     TABLE MAY BE USED.
*#
ALONE    BSS       0
         SA3       A2+1 
         UX.T      X3,B.BITS       BIT POSITION OF FIELD
         SB.WORD   X.T
*                                 ,KEY, 
         SA3       A2+3 
         PL        X3,SMPLDEF      SIMPLE DEFAULT 
         ZR        X3,NODFLT       NO DEFAULT 
         BX3       -X3
         SB3       X3              -ADR OF DEFAULT ROUTINE
         JP        B3 
SMPLDEF  BSS       0
         BX.T      X3 
         AX.T      30 
         ZR        X.T,DOSTF       JUMP IF SIMPLE DEFAULT 
         SA3       X3+B1           ELSE DEFAULT IS FIRST ENTRY
*                                  IN OPTION TABLE
DOSTF    BSS       0
         STUFF     X3 
NODFLT   ERROR     (NO DEFAULT FOR               ),X6 
  
*#
*         -STUFFIT- (TRANSFERRED TO FROM THE -STUFF- MACRO) HAS THE 
*     RESPONSIBILITY OF ACTUALLY FILLING IN THE PSEUDO-FIT AND MASK 
*     AND ALSO OF CHECKING TO SEE IF A PREVIOUS FILE CARD SET THE FIELD 
*     TO A DIFFERENT VALUE.  THE KEYWORD=VALUE  IS NOW COMPLETELY 
*     PROCESSED, GO TO -CKDELIM-. 
*#
STUFFIT  BSS       0
         SA1       FIT+B.WORD 
         SA3       A2+2            THE MASK 
         BX0       X1-X6
         BX7       -X3*X1          GIT RID OF PREVIOUS VALUE
         BX.T      -X3*X6 
          ZR        X.T,NOT.2BIG
          MX0       54             RESTORE THE MASK REGISTER
          EQ        NUM2BIG 
 NOT.2BIG BSS       0 
         BX6       X6+X7
         SA6       A1 
         SA1       MASK+B.WORD     OLD MASK 
         BX7       X3+X1           OR THE TWO MASKS 
         BX6       X3*X1
         SA7       A1 
         BX1       X6*X0
         MX0       54 
         ZR        X1,CKDELIM 
         SA1       CURKEYI
         SX7       X1+B1
         SA7       A1 
         EQ        CKDELIM
CURKEYI 
OVLAP    DIS      3, PREVIOUS FIELD OVERLAPPED BY 
CURKEY   BSSZ      30 
WARN
         SA3       CURKEYI
         ZR        X3,WARN
         SB4       CURKEY+X3
          SB3      CURKEY 
LOOP     SA1       B3 
         LX6       X1,B1     MERGE CHARACTER BITS 
         SB2       B1+B1
         BX4       X1+X6
         LX2       X4,B2
         SA3       AAAAA
         BX6       X2+X4
         LX4       -2 
         BX2       X6+X4
         LX3       3         =10101010101010101010B 
         BX3       X3*X2     SET NON-ZERO CHARACTERS
         AX4       X3,B1     EXPAND TO CHARACTER MASK 
         BX2       X4+X3
         SA3       BLANKS    =10H 
         LX4       X2,B2
         BX6       X2+X4
         AX4       X2,B2
         BX4       X6+X4
         BX3       -X4*X3 
         BX6       X1+X3
         SA6       A1 
         SB3       B3+1 
         NE        B3,B4,LOOP 
         MX4       48 
         BX6       X4*X6
         SA6       A1 
         MESSAGE   OVLAP,,RCL      ISSUE OVERLAP WARNING
         SA3       CURKEYI
         SX4       X3-6 
         NG        X4,WARN
         MESSAGE   CURKEY+5,,RCL
         EQ        WARN 
  
         TITLE     CONTROL CARD CRACKING ROUTINES 
*#
*         -G.ALPH- AND -ALPH- BUILD A CHARACTER STRING (FROM THE CONTROL
*     CARD) BY MEANS OF A SHIFT-MASK-TEST-ADD LOOP.  -ALPH- ASSUMES 
*     THAT THE FIRST CHARACTER HAS BEEN GOTTEN BY -GETCHAR-, -G.ALPH- 
*     ASSUMES NOT.
*     REGISTERS.. 
*             A4,X045,B124 AS IN GETCHAR
*             X17,A7  TEMP
*             X6  OUTPUT
*             B6  RETURN ADDRESS
*             B.CCT (B7)  OUTPUT--POSITION OF STRING IN X6
*#
G.ALPH   GETWORD
ALPH     MX6       -1 
         IX7       X.PARA+X6
         SA.T      =10H5555555555 
         BX6       -X.PARA*X7 
         BX6       X6*X.T 
         CX.T      X6 
         BX7       X7-X7
         BX6       X.PARA 
         SA7       TYPE 
         IX7       X.T+X.T
         LX.T      2
         IX7       X7+X.T 
         SB.CCT    X7 
         JP        B6 
  
*#
*         -NUM- SCANS THE CONTROL CARD AND SIMULTANEOUSLY BUILDS A
*     DECIMAL NUMBER IN X6 AND AN OCTAL NUMBER IN X7.  WHEN THE DIGITS
*     RUN OUT, A SPECIAL CHARACTER SIGNALS RETURNING.  BUT A LETTER IS
*     A RADIX MEANING.. 
*             D  THE NUMBER IS DECIMAL (USE X6) 
*             B  THE NUMBER IS OCTAL (USE X7) 
*             W  THE NUMBER IS DECIMAL, AND MULTIPLY BY 10 (USE X6*10)
*     REGISTERS.. 
*             A4,X045,B124  AS IN GETCHAR 
*             X1  TEMP
*             X67  OUTPUT (AS DESCRIBED ABOVE)
*             B6  RETURN ADDRESS
*#
NUM      SX7       B1 
         SA7       TYPE            1=NUMERIC
         GETCHAR
         BX6       X6-X6           FOR DECIMAL NUMBER 
         BX7       X7-X7           FOR OCTAL NUMBER 
NUMENT   UNDER     1R8,OCT
         MX7       30              -LARGE -> RESULTO
OCT      IX.T      X6+X6           *10
         LX6       3
         SX.CHAR   X.CHAR-1R0 
         IX6       X.T+X6 
         LX7       3               *8 
         IX6       X6+X.CHAR       ADD TO DECIMAL 
         BX7       X7+X.CHAR       ADD TO OCTAL 
NUML     GETCHAR
         ZERO      QEDN 
         OVER      1R9,QEDN 
         OVER      1RZ,NUMENT 
RADIX    NOT       1RD,RB 
         BX7       X6              DECIMAL FORCED 
         EQ        RZ 
RB       NOT       1RB,RW 
         BX6       X7              OCTAL FORCED 
         EQ        RZ 
RW       NOT       1RW,RBAD 
         IX.T      X6+X6
         LX6       3
         IX7       X.T+X6          W (WORDS) -- MULTIPLY BY 10
         BX6       X7              AND FORCE DECIMAL
RZ       GETCHAR
         NZ        X.CHAR,RBAD
QEDN     JP        B6              RETURN 
RBAD     ERROR     (BAD NUMBER, SYMBOL, OR RADIX) 
  
GETWORD 
         SA.PARA   A.PARA+B1
         NZ        X.PARA,SAMECARD
         CONTRLC =SACER,READ,DAYFILE,CRACK
         SA.PARA   2
SAMECARD BSS       0
         MX.T      6
         BX.CHAR   X.T*X.PARA 
         BX.T      -X0*X.PARA 
         LX.CHAR   6
         BX.PARA   X0*X.PARA
         NZ        X.T,GETWORD
         BX7       X.PARA 
         SA.PARA   A.PARA+B1
         MX.T      42 
         LX.PARA   18 
         BX.PARA   -X.T*X.PARA
         BX.PARA   X.PARA+X7
         UNDER     1R0,BADLFN 
         BX.T      -X0*X.PARA 
         ZR        X.T,GETWORD
BADLFN   BSS       0
         ERROR     (SYMBOL TOO LONG               ),X.PARA
         TITLE     PUT OUT ERROR MESSAGES AND ABORT 
*#
*         -SIMPLMES- PRINTS THE DESIRED 2 LINE ERROR MESSAGE ON THE 
*     DAYFILE.  (BUT BEFOREHAND IT CALLS -WARN- TO INDICATE OVERLAPPED
*     FIELDS, IF ANY).  THEN ZZZZZDF IS CLOSED WITH REWIND AND THE JOB
*     IS ABORTED TO AN EXIT(S). 
*#
SIMPLMES BSS       0
         RJ        WARN 
         MESSAGE   X7,,RCL
         SA.PARA   A.PARA 
         MX.T      -12
         BX6       X.T*X.PARA 
         SA6       SECMESS+3
         SX.T      A.PARA-B1
         ZR        X.T,EARLY
         SA.T      X.T
         BX6       -X0*X.T
         BX7       X0*X.T 
         SA.T      DELS+X6         PUT DELIMETER BACK IN
         IX6       X7+X.T 
         SA6       SECMESS+2
          MX0       6 
          SX2       55B 
          LX0       6 
          SB2       B0
          SB3       10
 LOOP.1   BSS       0 
          SB2       B2+B1 
          LX0       54
          LX2       54
          BX1       X6*X0 
          NZ        X1,NOT.00B
          BX6       X6+X2          CONVERT 00B TO 55B 
 NOT.00B  BSS       0 
          EQ        B2,B3,END.LOOP
          EQ        LOOP.1
 END.LOOP BSS       0 
          SA6       A6
EARLY    BSS       0
         MESSAGE   SECMESS,,RCL 
          SA0       "DEFILE"
          SYSY      150B,RCL       CLOSE,REWIND 
         SA1       =4LABTA         GO TO EXIT(S)
         BX6       X1 
+        SA1       1
         NZ        X1,* 
         SA6       1
-        PS 
SECMESS  BSS       0
         DIS       2, AT OR AFTER 
         DATA 0LFILE,0
  
POINTER 
TYPE
         TITLE     CSL -- COMPLETE STATIC LOADING 
*#
*         -CSL-  COMPLETES STATIC LOADING INITIATED BY THE PRESENCE 
*     OF USE OR OMIT KETWORDS.  IF USE/OMIT HAS NOT BEEN SPECIFIED, 
*     EXIT.  OTHERWISE CALL AFO TO ADD $SQ,$WA ETC TO ALL ENTRIES 
*     IN EXTA PORTION OF ZZZZZDG, CALL ABR TO ADD BT/RT CAPSULES
*     FOR GET/PUT IN EXTB PORTION OF FIT, CHANGE THE REGULAR SKIP 
*     CAPSULES TO SBF SKIP CAPSULES IF SBF=YES HAS BEEN SPECIFIED,
*     CLEAR GET/PUT FO/BT ENTRIES IF RT=S, ADD AAM.CTL IF FO=IS/DA/AK,
*     AND CALL CZE TO CLEAR MISC$RM/CAPS$RM IF NO EXTA ENTRIES EXIST. 
*#
CSL      BSSZ      1
          SA1       ERRS           ANY CAPSULE TO BE STATICALLY LOADED
          ZR        X1,CSL.XIT     NO 
          SA1       =0LDF$CRM      IF ANY STATIC LOAD, ADD DF$CRM 
         BX6       X1 
          SA3    =0LRBL$RM         AND RBL$RM 
          LX7       B0,X3 
          SA6       DF
          SA7       RBL 
          SA0       FIT 
          OFF.RM    SBF,CSL.S1
          EQ.RM     RT,#ST#,CSL.AFO,B3
 CSL.S1   BSS       0 
         SA1       EXTA+STATSKBL-STATBL  SKBL NEEDS SKFL AND FLSH 
         ZR        X1,CSL.AFO      JUMP IF NO USE=SKIPBL
          SX7       3RPUT 
          SA2       =0RSKFL 
          BX6       X2
         SA6       EXTA+STATSKFL-STATBL 
         SA7       EXTA+STATPUT-STATBL
CSL.AFO  BSS       0
         RJ        AFO             ADD $FO TO ALL NON-ZERO ENTRIES
          AAM.FO    CSL.AAM 
          EQ.RM     RT,#ST#,CSL.S2,B3 
         OFF.RM    SBF,CSL.SKFL    IF SBF=YES AND USE=SKIPFL
 CSL.S2   BSS       0 
         SA1       EXTA+STATSKFL-STATBL  CLEAR SKFL$SQ AND ADD SKSF$SQ
         SA2       =0LSKSF$SQ 
         ZR        X1,CSL.SBFB     NO USE=SKIPFL
         BX6       X2 
         SA6       A1 
CSL.SBFB BSS       0               IF SBF=YES AND USE=SKIPBL
         SA1       EXTA+STATSKBL-STATBL  CLEAR SKBL$SQ AND ADD SKSB$SQ
         SA2       =0LSKSB$SQ 
         ZR        X1,CSL.SKFL     NO USE=SKIPBL
         BX6       X2 
         SA6       A1 
CSL.SKFL BSS       0
         SA1       EXTA+STATSKFL-STATBL 
          ZR        X1,CSL.RT=S    NO USE = SKIPFL
         SA0       MASK            JUMP IF FO NOT YET SPECIFIED 
         F.RM      FO,X1
         ZR        X1,CSL.RT=S
         SA0       FIT
         F.RM      FO,1,X1,-#SQ#
         NZ        X1,CSL.RT=S     ADD GET CAPSULES ONLY FOR FO=SQ
         SA1       =0LGET$SQ       ADD GET$SQ FOR SKIPFL
         BX6       X1 
         SA6       EXTA+STATGET-STATBL
CSL.RT=S BSS       0               CLEAR FO/BT ENTRIES IF RT=S
          RJ        ABR 
         SA0       FIT
         F.RM      RT,X1,-#ST#
          NZ        X1,CSL.WA 
         SX6       B0 
         MX7       0
         SA6       EXTA+STATGET-STATBL
         SA7       GETBT
          SA6       EXTA+STATGETP-STATBL
          SA7       EXTA+STATFLSH-STATBL
         SA6       EXTA+STATPUT-STATBL
         SA7       PUTBT
          SA6       EXTA+STATPUTP-STATBL
          EQ        CSL.WA
CSL.AAM  BSS       0               ADD AAM.CTL IF FO=IS,DA,AK 
          RJ        ABR            ADD GET/PUT $ BT/RT
         SA1       =0LAAM.CTL 
         BX6       X1 
          SA3       =3R.MP         AAM 1.5
          OFF.RM    ORG,OLDAAM
          SA1       =0LAAM$CTL
          BX6       X1
          SA3       =3R$MP         AAM 2.0
 OLDAAM   BSS       0 
         SA6       AAMCTL 
          F.RM      XN
          ZR        X1,CSL.OPST 
          SA1       EXTA+STATRMK-STATBL 
          ZR        X1,CSL.GMP
          SA2       =0LKDEF 
          SB2       18
          LX4       X3,B2 
          BX7       X2+X4 
          SA7       A1
 CSL.GMP  BSS       0 
          SA1       =0LEXEC 
          SB2       18
          LX4       X3,B2 
          BX6       X1+X4 
          SA6       GETMP          LOAD MIP EXECUTIVE 
          SA1       =0LPUT
          SB2       24
          LX4       X3,B2 
          BX6       X1+X4 
          SA1       EXTA+STATPUT-STATBL 
          ZR        X1,CSL.REP
          SA6       PUTMP 
 CSL.REP  SA1       EXTA+STATREP-STATBL 
          ZR        X1,CSL.DEL
          SA6       PUTMP 
 CSL.DEL  SA1       EXTA+STATDEL-STATBL 
          ZR        X1,CSL.SEK
          SA6       PUTMP 
 CSL.SEK  SA1       =0LSEEK 
          SB2       18
          LX4       X3,B2 
          BX6       X1+X4 
          SA1       EXTA+STATSEK-STATBL 
          ZR        X1,CSL.GNR
          SA6       SEEKMP
 CSL.GNR  SA1       EXTA+STATGNR-STATBL 
          ZR        X1,CSL.OPST 
          SA6       SEEKMP
         EQ        CSL.OPST 
 CSL.WA  BSS       0
         SA0       MASK            JUMP IF FO NOT YET SPECIFIED 
         F.RM      FO,X1
         ZR        X1,CSL.OPST
         SA0       FIT
         F.RM      FO,X1,-#WA#
         NZ        X1,CSL.OPST
         MX6       0
         SX7       B0 
         SA6       GETBT
         SA7       GETRT
         SA6       PUTBT
         SA7       PUTRT
         SA1       EXTA+STATPUT-STATBL
         SA2       EXTA+STATGET-STATBL
         IX0       X1+X2
         ZR        X0,CSL.OPST
         SA1       =0LCOMM$WA 
         BX6       X1 
         SA6       COMM 
CSL.OPST BSS       0
         SA1       EXTA+STATOPEN-STATBL    ADD OPEN$RM FOR OPEN/SETFIT
         SA2       EXTA+STATSTFT-STATBL 
         IX0       X1+X2
          ZR        X0,CSL.LABL    NEITHER OPEN OR SETFIT 
         SA1       =0LOPEN$RM 
         BX6       X1 
         SA6       OPEN 
CSL.LABL BSS       0
         SA1       EXTA+STATCL-STATBL  LOAD LBUF$RM IF ANY LABEL USE
         SA2       EXTA+STATGL-STATBL 
         IX6       X1+X2
         SA3       EXTA+STATPL-STATBL 
         SA4       EXTA+STATWM-STATBL 
         IX7       X3+X4
         BX6       X6+X7
          ZR        X6,CSL.CLO
         SA1       =0LLBUF$RM      PUT UP LBUF$RM EXTERNAL
         BX6       X1 
         SA6       LBUF 
 CSL.CLO  BSS       0 
          SA1       EXTA+STATCLO-STATBL 
          ZR        X1,CSL.CZE
          SA1       =0LCLSF$RM
          BX6       X1
          SA6       CLOSE 
CSL.CZE  BSS       0
         RJ        CZE             CLEAR MISC$RM ETC IF NO ENTRIES"0
CSL.XIT  BSS       0
          SA0       FIT 
          F.RM      FO,A3,+FOMASK  PICK UP BIT MASK FOR FO
          F.RM      XN
          SB2       B0
          ZR        X1,NOMP        IF NOT MIP FILE
          SA1       MPMASK
          BX3       X3+X1          ADD BITS FOR MIP FCNS
 NOMP     BSS       0 
          SB3       STATBLSZ+EXTBSZ  SET LOOP LIMIT 
          SB4       EXTA           INITIALIZE ADDRESS OF FCN
 BLOOP    BSS       0 
          LX2       X3,B2          POSITION FCN BIT 
          SA1       B4+B2          PICK UP FCN WORD 
          AX2       59             FORM MASK
          BX7       X1*X2          CLEAR OR PRESERVE FCN
          SB2       B2+B1          INCREMENT FCN INDEX
          SA7       A1             STORE RESULT BACK
          LE        B2,B3,BLOOP    IF MORE FCN
         EQ        CSL
         TITLE     AFO -- ADD $FO TO ZZZZZDG EXTERNALS
*#
*         -AFO- ADDS $FO TO ALL NON-ZERO ENTRIES IN ZZZZZDG FOR 
*     STATIC LOADING.  IF THE FO PARAMETER HASN-T BEEN SPECIFIED YET, 
*     EXIT. OTHERWISE FORM THE EXTERNAL NAME (E.G. GET$SQ,PUT$IS,ETC.). 
*#
AFO      BSSZ      1
         SB3       B1+B1
         SX5       1R$
         SA0       FIT
          F.RM      FO
          SX3       X1-#IS# 
          PL        X3,AFO.AAM     IF FO=IS/DA/AK 
         SA0       MASK 
         F.RM      FO,3 
          ZR        X3,DEFFO
         SA2       FOBAM            DISPLAY CODE SQ,WA
         EQ        AFO.FO 
 DEFFO    BSS       0 
          MESSAGE   FOMES,,RCL
          SA2       FOBAM 
          SX1       #SQ#
          EQ        AFO.FO
 FOMES    DIS       ,# NO FO SPECIFIED FOR USE, SQ USED#
AFO.AAM  BSS       0
          SA0       MASK           SET FOR MASK AREA
          F.RM      ORG,2          PICK UP MASK OF ORG FIELD
          SA0       FIT            RETORE A0 TO FIT 
          ZR        X2,NEWAAM      IF ORG NEVER SET DEFAULT TO NEW
          F.RM      ORG,2 
          NG        X2,NEWAAM 
          SX5       1R. 
 NEWAAM   BSS       0 
          SA4       EXTA+STATDEL-STATBL 
          SA2       EXTA+STATREP-STATBL 
          BX4       X2+X4 
          ZR        X4,NOPUT       IF NO REPLACE OR DELETE
          SA0       FLAGS 
          SET.RM    PUT,1,,4       SET THE PUT FLAG TO SET PUT$RT 
 NOPUT    BSS       0 
         SA2       FOAAM            DISPLAY CODE IS,DA,AK 
         SX1       X1-#IS#
AFO.FO   BSS       0
         LX3       B3,X1            FO*4
         LX1       3                FO*8
         MX7       48 
         IX1       X1+X3           FO*12 = SHIFT COUNT
         SB2       X1 
         AX2       B2,X2
         BX2       -X7*X2 
         LX5       12               $00 
         BX0       X5+X2            $FO 
         MX7       6
         SB2       STATBLSZ-1 
AFO.LOOP BSS       0
         SA1       EXTA+B2          LOAD NEXT ZZZZZDG EXTERNAL
         ZR        X1,AFO.NDX       NO EXTERNAL 
         BX5       X7*X1
         LX1       18               FORM FCN$FO 
         NZ        X5,AFO.NDX      JUMP IF PROPER EXT ALREADY FORMED
         BX6       X1+X0
         LX6       18              ENSURE LEFT-JUST (6 AND 7 CHAR NAMES)
         BX1       X7*X6
         NZ        X1,AFO.STR 
         LX6       6
AFO.STR  BSS       0
         SA6       A1 
AFO.NDX  BSS       0
         SB2       B2-B1
         GE        B2,B0,AFO.LOOP  ANOTHER ENTRY
         SX5       2RRM 
         MX7       30 
         SA1       EXTA+STATCL-STATBL  CHANGE LABEL SUFFIX TO $RM 
         SA2       EXTA+STATGL-STATBL 
         LX5       18 
         ZR        X1,AFO.GTL       NO USE=CLOSEL 
         BX1       X7*X1
         BX6       X1+X5
         SA6       A1 
AFO.GTL  BSS       0
         ZR        X2,AFO.PTL 
         BX2       X7*X2
         BX6       X2+X5
         SA6       A2 
AFO.PTL  BSS       0
         SA1       EXTA+STATPL-STATBL 
         SA2       EXTA+STATWM-STATBL 
         ZR        X1,AFO.WMK 
         BX1       X7*X1
         BX6       X1+X5
         SA6       A1 
AFO.WMK  BSS       0
          ZR        X2,AFO.GTWR 
         BX2       X7*X2
         BX6       X2+X5
         SA6       A2 
 AFO.GTWR BSS       0 
          SA1       EXTA+STATGTWR-STATBL
          SA2       EXTA+STATPTWR-STATBL
          ZR        X1,AFO.PTWR 
          BX1       X7*X1 
          BX6       X1+X5 
          SA6       A1
 AFO.PTWR BSS       0 
          ZR        X2,AFO.XIT
          BX2       X7*X2 
          BX6       X2+X5 
          SA6       A2
AFO.XIT  BSS       0
          SA0       FIT 
         EQ        AFO
         TITLE     ABR -- ADD GET/PUT BT/RT EXTERNALS TO ZZZZZDG
*#       -ABR- ADDS GET AND PUT BLOCK AND RECORD TYPE CAPSULES
*     TO ZZZZZDG LIST OF EXTERNALS IF USE=GET, USE=GETP, USE=PUT, 
*     OR USE=PUTP WAS SPECIFIED.
*#
ABR      BSSZ      1
          SA0       FLAGS 
          F.RM      GET,3 
          F.RM      PUT,4 
         MX7       48 
          BX0       X3+X4 
          PL        X0,ABR.XIT     IF NEITHER GET OR PUT STATIC LOADED
          SA0       FIT 
          F.RM      FO,X6,-#WA# 
          ZR        X6,ABR.XIT     DONT ADD BT/RT CAPSULES FOR FO=WA
         SB5       B0              BT/RT LOOP INDEX 
         SA0       MASK 
         SA5       BTDC            BT-S IN DISPLAY CODE 
         F.RM      BT,1,B3         IF MASK=0, BT NOT SPECIFIED
         SA0       FIT
         AAM.FO    ABR.NDX         DONT NEED BT ENTRIES FOR AAM 
          EQ.RM     RT,#ST#,ABR.NDX,B2
         F.RM      BT,1,X0         BT VALUE 
          SX7       BTMES          SET FOR BT MESSAGE 
          SX1       #IT#           SET DEFAULT TO BT=I
ABR.LOOP BSS       0
         SB2       B1+B1
          EQ        B3,B0,DEFBTRT  JUMP IF BT/RT NOT SPECIFIED
         SA1       =0LGET$
         SA2       =0LPUT$
         LX7       B2,X0           BT/RT*4
         IX0       X0+X0           BT/RT*2
         IX0       X0+X7           BT/RT*6
         MX7       54 
         SB2       X0 
         AX5       B2              BT/RT IN BITS 0-5
         BX5       -X7*X5 
         LX5       30 
         BX6       X1+X5           ADD TO GET$
         BX7       X2+X5           ADD TO PUT$
          PL        X3,ABR.PUT     USE=GET NOT SPECIFIED
         SA6       GETBT+B5 
ABR.PUT  BSS       0
          PL        X4,ABR.NDX     USE=PUT NOT SPECIFIED
         SA7       PUTBT+B5 
ABR.NDX  BSS       0
         SB5       B5+B1
         NE        B5,B1,ABR.XIT   DID BT, GO DO RT 
         SA0       MASK            IF MASK=0, RT NOT YET SPECIFIED
         F.RM      RT,1,B3
         SA0       FIT
         F.RM      RT,1,X0         RT VALUE 
          SX7       RTMES          SET FOR RT MESSAGE 
          SX1       #WT#           ST DEFAULT TO RT=W 
         SA5       RTDC 
         EQ        ABR.LOOP 
 DEFBTRT  BSS       0 
          BX0       X1
          MESSAGE   X7,,RCL 
          SB3       B1
          EQ        ABR.LOOP
 BTMES    DIS       ,# NO BT SPECIFIED FOR USE, I USED# 
 RTMES    DIS       ,# NO RT SPECIFIED FOR USE, W USED# 
ABR.XIT  BSS       0
          SA0       FIT 
         EQ        ABR
         TITLE     CZE -- CLEAR FOR ZERO ENTRIES
*#
*         -CZE-  CLEARS EXTB ENTRIES IF CORRESPONDING EXTA ENTRY
*     IS ZERO.
*#
CZE      BSSZ      1
         SB2       STATBLSZ-2 
         SX6       0
         MX7       0
          SA2       EXTA+STATPUT-STATBL 
          SA1       EXTA+STATREP-STATBL 
          BX2       X2+X1 
          SA1       EXTA+STATDEL-STATBL 
          BX2       X1+X2 
          NZ        X2,MPN
          SA6       PUTMP          CLEAR MIP PUT
 MPN      BSS       0 
          SA0       FLAGS 
          ON.RM     GET,CZE.PUT 
          SA6       GETBT 
          SA7       GETRT 
 CZE.PUT  BSS       0 
          ON.RM     PUT,CZE.LOOP
          MX7       0              ON.RM ALTERS X7
          SA6       PUTBT 
          SA7       PUTRT 
CZE.LOOP BSS       0
         SA1       EXTA+B2
         SA2       EXTA+1+B2
          NZ        X1,CZE         EXIT WHEN A NON ZERO ENTRY IS FOUND
          NZ        X2,CZE
         SB2       B2-2 
         GE        B2,B1,CZE.LOOP 
         LT        B2,B0,CZE.EXTB  EXTA END--ALL ZERO-CLEAR EXTB
         SA1       EXTA            ONE MORE NETRY 
          NZ        X1,CZE
CZE.EXTB BSS       0
          SA1       GETRT          CHECK FOR PUT$S/GET$S(NO FO ENTRY) 
          SA2       PUTRT 
          IX1       X1+X2 
          NZ        X1,CZE         EXIT  IF AT LEAST ONE PRESENT
          SB3       EXTB+EXTBSZ-2 
CZE.ZERO BSS       0
         SA6       B3 
         SA7       B3+B1
         SB3       B3-2 
         SB4       B3-GETBT+1 
         GE        B4,B1,CZE.ZERO 
          LT        B4,B0,CZE      EXIT WHEN DONE 
         SA6       B3+B1           ONE MORE NETRY 
         EQ        CZE
         TITLE     QED -- WRITE OUT RESULTS 
*#
*         -QED- IS FOR THE SUCCESSFUL COMPLETION OF FILE.  IT WRITES
*     (REWRITES) THE INDEX AND THE ENTRY (DOESNT REWRITE ENTRY IF 
*     CANCEL FLAG IS SET).  -WARN- IS CALLED AND -END- IS WRITTEN IN
*     RA+1 BY THE -ENDRUN- MACRO. 
*#
QED      BSS       0
         RJ        CSL             COMPLETE STATIC LOADING
         SA4       =SWHERE
         SX6       BUF+INDEXSIZ 
         SX7       BUF
         SA6       IN 
         SA7       OUT
         SA1       X4+BUF+1 
          SA0       "DEFILE"
         NZ        X1,UPDATE
         ZR        X4,ONLYF             SEE IF ONLY FILE
 UPDATE   BSS       0 
          SYSY      224B,RCL       REWRITER INDEX 
         ZR        X4,WRITFILE
          SYSY      240B,RCL,4     SKIPF TO FILE
         EQ        WRITFILE 
 ONLYF    BSS       0 
          SYSY      024B,RCL       WRITER INDEX 
WRITFILE BSS       0
         SX6       FIT-2
         SX7       FIT-2+DGSZ.RM   IN=OUT+NO. WDS TO BE WRITTEN 
         SA6       OUT
         SA7       IN 
         SA3       CANCLFLG 
         SA4       WHERE
         NZ        X3,CLOSEF       DONT REWRITE DATA PRU IF CANCEL OPTN 
         SA1       X4+BUF+1 
         SB6       024B                 WRITER
         ZR        X1,LASTF 
         SB6       224B                 REWIRTER
 LASTF    BSS       0 
          SYSY      B6,RCL         (RE)WRITER INFO ON FILE
 CLOSEF   BSS       0 
          SYSY      150B,R         CLOSE,REWIND 
         RJ        WARN 
ENDRUN   ENDRUN 
 CLOSER  BSS       0
          SA0       "DEFILE"
          SYSY      174B,R         CLOSE,RETURN 
         EQ        ENDRUN 
WHERE 
CANCLFLG
 BLANKS   CON       10H 
 AAAAA    CON       01010101010101010101B 
* CALL /CIODRM/ 
*CALL /CIODRM/
          TITLE  MACRO INDEX
*      SYSY   MAC     6RMFILC    19 
*      ERROR    M     6RMFILC    47 
*      NOTTYPE  M     6RMFILC    68 
*      OVER     M     6RMFILC    76 
*      UNDER    M     6RMFILC    80 
*      NOT      M     6RMFILC    84 
*      IS       M     6RMFILC    88 
*               M     6RMFILC    93 
*               M     6RMFILC   100 
*               M     6RMFILC   108 
*      FOPTN          6RMFILC   130 
*      GETCHAR  M     6RMFILC   137 
*      STUFF    M     6RMFILC   149 
*      BINSRCH  M     6RMFILC   155 
*      FILLOUT  M     6RMFILC   176 
*      RCLF     M     6RMFILC   191 
*      HRL      M     6RMFILC   224 
*      SEARCH   M     6RMFILC   451 
         END       FILEC
