*DECK CRFIT 
USETEXT CCTTEXT 
USETEXT DNTEXT
          PROC CRFIT; 
 #        NAME-   CRFIT                                                #
 #                                                                     #
 #        DOES-   CREATES FILE INFORMATION TABLES                      #
 #                                                                     #
 #                                                                     #
          BEGIN 
 #      COMMON DECKS                                                   #
  
*CALL ASSEMOP 
  
*CALL AUXT1 
  
*CALL AUXTVALS
  
  
  
*CALL DNATVALS
  
*CALL FITDEFS 
  
*CALL FNAT1 
  
*CALL FNATVALS
  
*CALL LDSET 
  
*CALL LPOOL 
  
*CALL PLT1
  
*CALL PLTVALS 
  
*CALL PNAT1 
  
*CALL PTCOMMON
  
*CALL TABLETYP
  
*CALL WORKTABS
  
          STATUS FILETYPES
              NULL
          ,   ISAKDA         #INDEXED, DIRECT OR ACTUAL KEY#
          ,   RLWA           #RELATIVE OR WORD ADDRESS# 
          ,   SQ             #SEQUENTIAL# 
          ; 
  
 #      DIAGNOSTICS GIVEN IN CRFIT - PREFIX IS 8                       #
  
          DEF D014  #014#;    #RT FORCED TO F TYPE RECORDS# 
          DEF D015  #015#;    #BT FORCED TO C TYPE BLOCKS#
          DEF D016  #016#;    #RECORDING MODE SWITCHED FROM DEC TO BIN #
         DEF D017  #017#;    #FT RECORD LENGTH < 10 CHARACTERS# 
          DEF D030  #030#;    #NUMERIC FIELD IN USE NON-NUM#
          DEF D031  #031#;    #YES OR NO EXP IN USE - NOT SO# 
          DEF D032  #032#;    #DELIM OF = EXP IN USE# 
          DEF D033  #033#;    #UNRECOG PARAM IN USE#
          DEF D034  #034#;    #UNRECOG VALUE FOR USE PARAM# 
          DEF D035  #035#;    #NUMERIC VALUE OUT OF BOUNDS IN USE#
          DEF D036  #036#;   #FIFO GIVEN FOR ORG=NEW AND REPEATING GRP #
          DEF D037  #037#;   #RT NOT U FOR RELATIVE OR WA FILE         #
          DEF D040  #040#;    #SS DBI AND DATANAME PROPERTIES DIFFER# 
          DEF D041  #041#;    #FDLT/SS RELATION AND QUALIFIER NOT IN
                               COMMON#
          DEF D042  #042#;   #EXD AND SDS NO LONGER SUPPORTED#
 #                                                                     #
 #     DEFINITIONS FOR THIS PROGRAM                                    #
 #                                                                     #
  
          BASED ARRAY ZEROOUT[0:FITV$LFIT]; 
              ITEM ZEROITEM   U(0,0,60);   #USED TO ZERO FIT# 
          ITEM   CURRFNATOFF I=0;  #POINTER TO PLACE IN CURR FNAT BLK#
          XREF ITEM DECLCT I; 
          ITEM BCTMAX     I;
          ITEM BCTMIN     I;
          ITEM CHAROFFSET  I;      #CHARACTER OFFSET FROM BEG OF REC# 
          ITEM DECLFND1   B;
          ITEM DECLFND2   B;
         ITEM EXTFLAG    B=TRUE;   #EXTERNAL FILE WAS LAST# 
          ITEM KEYLENGTH   I;      # KEY LENGTH FOR KEY TABLES         #
          ITEM MAXRECL    I;
          ITEM MINRECL    I;
          ITEM FILETYPE   S:FILETYPES;   #TYPE OF TILE - BASED ON FO   #
          ITEM FIRSTKEY   B;
           ITEM FMAWS C(140); 
          ITEM FSTATPTR    I=0;    #FILE STATUS DNAT INDEX# 
          ITEM INDEX      I;      #INDEX# 
          ITEM LABELPTR   I;       #LABEL TABLE POINTER#
          ITEM LASTNEOFF  I=0;     #LAST NON-EXTERNAL OFFSET# 
          ITEM LFN        C(7);   # LOGICAL FILE NAME # 
          ITEM LINLABEL    I;       #LINAGE TABLE LABEL#
          ITEM LITPTR      I;      #POINTER TO KEY LITERAL# 
          ITEM EXTWORDS    I;     #EXTRA FILE TABLE WORDS FOR THIS FO#
          ITEM FILEORG    U;      #FILE ORGANIZATION# 
          ITEM KEYINDEX    I;   #INDEX TO PRIME KEY#
          ITEM KEYINRFLAG  B;      #KEY IN RECORD FLAG# 
          ITEM KEYLABEL    I;   #LOC LABEL FOR KEY# 
          ITEM KEYTYPE    I;   #TYPE OF A RECORD KEY# 
          ITEM MAXKEYPOS  I;  #MAX KEY POSITION IN RECORD # 
          ITEM OFFSET     U;      #OFFSET FOR DNAT# 
          ITEM RECTYPE    U;      #RECORD TYPE# 
          ITEM SVAUXIND    I;      #SAVE AUX TABLE INDEX# 
          ITEM WORDOFFSET  I;      #WORD OFFSET FROM BEG OF REC#
          ITEM WSALABEL   U;      #LABEL FOR WSA# 
          ITEM VARTYPE    I;       # TYPE OF VARIABLE LEN REC#
          ITEM VARPTR    U; 
             ITEM CHARPTR;
             ITEM EMBEDDED C(1);
             ITEM RECEIVE C(10);
             ARRAY FO [0:6] S(1); #FILE ORGANIZATION# 
                 ITEM FFO C(0, 0, 10) = 
                   ["SQ", 
                    "WA", 
                    "RL", 
                    "IS", 
                    "LB", 
                    "DA", 
                    "AK" ]; 
              ARRAY [0:8] S(1); #RECORD TYPE# 
                  ITEM FRT C(0,0,10) =
                    ["W", "F", "R", "Z", "D", "T", "B", "U",
                     "S"];
              ARRAY [1:4] S(1); #BLOCK TYPE#
                  ITEM FBT C(0, 0, 10) =
                    ["I", "C", "K", "E"]; 
             ARRAY [0:3] S(1); #KEY TYPE# 
                 ITEM FKT C(0, 0, 10) = 
                   ["SK", "AI", "IK", "UK"];
             ITEM     FMAKEYPLT     I;
          SWITCH FILEORGS 
              FOERR    #ZERO - ERROR#,
              FOSQ     #SEQUENTIAL#,
              FOWA     #WORD$ADDR#, 
              FORL     #RELATIVE#,
              FOIS     #INDEXED#, 
              FOERR  #UNUSED ENTRY#,
              FODA     #DIRECT#,
              FOAK     #ACTUAL$KEY#,
              FOERR    #ORGERR#;
  
 #     EQUIVALENTS FOR VARIOUS FILE ORGS - PARALLEL TO FO VALUE        #
          ARRAY FOEQUIVS [0:8] S(1);
              BEGIN 
 #     EQUIVALENTS TO OBJDEF FOR CLOSE EXTERNAL NAMES, ETX             #
 #     THE ORDER IN OBJDEFS IS NOT FO ORDER - IS SPECIAL FOR GIO       #
              ITEM FOEQOBJDEF   U(0,0,6)
                  =[
                  00,        #NOT USED# 
                  4,         #SQ# 
                  5,         #WA# 
                  3,         #RL# 
                  2,         #IS# 
                  0,         #UNUSED# 
                  1,         #DA# 
                  0,         #AK# 
                  ];
              END 
  
          CONTROL FI; 
          XREF BEGIN
              ITEM CBCLOAK; 
              FUNC CONVINT I; 
           FUNC DEC C(10);
              PROC DEFLOCLAB; 
              PROC FINDAUX; 
           ITEM FMAFET; 
              PROC GENLDSET;
              PROC PRINTDIAG; 
              FUNC GETLFN C(7); 
              PROC GETPLST; 
              PROC INTERCEPTOR; 
              ITEM LITBLK     I;    #BLOCK CONTAINING LITERALS# 
              FUNC NEXTLABEL I; 
              PROC OUTPUTBSS; 
              PROC OUTPUTDATA;
              PROC OUTPUTREPL;
              PROC OUTPUTUSE; 
              PROC PRINTVAL;
           PROC PUTSQ;
              PROC RELOCLOWER;
              PROC RELOCUL; 
              PROC RESETLEV;
              FUNC VIRTUAL I; 
              END 
# 
* 
*         DEFAULT VALUES FOR VARIOUS FIT FIELDS 
* 
# 
  
#      BLOCK TYPE            #
          DEF DEFAULTBT      #FITV$CT#;          #C BLOCKS #
  
#      CONVERSION MODE       #
          DEF    DEFAULTCM   #FITV$NO#;          # NO CONVERSION #
  
#      RECORD TYPE           #
          DEF DEFAULTRT      #FITV$FT#;          # FIXED LENGTH # 
  
#      PADDING CHARACTER     #
          DEF DEFAULTPC      #O"76"#; 
  
#      RECORD MARK           #
          DEF DEFAULTRMK     #O"62"#; 
  
 #      FILE ORG ORIENTED DEFAULTS    # 
          ARRAY FILEDEFAULTS [0:7]; 
          BEGIN 
 #     RECORDS PER BLOCK (RB)          #
              ITEM DEFAULTRB  U(0,0,6) =[ 
                  0,   #ERROR#
                  1,   #SQ# 
                  1,   #WA# 
                  1,   #RL# 
                  0,   #IS# 
                  0,   #UNUSED# 
                  2,   #DA# 
                  8,   #AK# 
                  ];
 #     AREAS (RESERVE NN AREAS)   # 
              ITEM DEFAULTAREA  U(0,6,6) =[ 
                  0,   #ERROR#
                  5,   #SQ# 
                  2,   #WA# 
                  2,   #RL# 
                  0,   #IS# 
                  0,   #UNUSED# 
                  0,   #DA# 
                  0,   #AK# 
                  ];
          END 
  
          CONTROL IFNQ CB5$CDCS,"NO"; 
          CONTROL EJECT;
          PROC FINDRORD;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - FINDRORD 
 *
 *        DOES - FINDS (SUB-SCHEMA) ORDINAL OF RECORD DESCRIPTION IN
 *               WHICH KEY IS CONTAINED 
 *
 *        GIVEN - -DNATPTR- = ADDRESS OF KEY DNAT ENTRY 
 *                -KEYINDEX- = POINTER TO KEY DNAT ENTRY
 *                -FNATPTR- = ADDRESS OF FNAT ENTRY 
 *
 *        RETURNS - -KEYTRORD- = RECORD ORDINAL 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          TEMP1 = DNATPTR;
          TEMP2 = KEYINDEX; 
 #     FIND DNAT ENTRY FOR RECORD (01) TO WHICH KEY IS SUBORDINATE# 
          FOR TEMP = TEMP WHILE DN$LEVEL[TEMP1] NQ 1 DO 
              BEGIN 
              TEMP2 = TEMP2 - 1;
              TEMP1 = VIRTUAL(TABLETYPE"DNAT$", TEMP2); 
              END 
 #     FIND SAME RECORD DNAT ENTRY BY SCANNING THRU FNAT AUXTABLE CHAIN 
       OF (DNAT) RECORD POINTERS# 
          TEMP1 = AUXINDEX;  #SAVE TEMPORARILY# 
          AUXINDEX = FN$DRECPTR[FNATPTR]; 
          AUXPTR = VIRTUAL(TABLETYPE"AUX$", AUXINDEX);
          FOR TEMP = TEMP WHILE AX$DATARCNAM[AUXPTR] NQ TEMP2 AND 
                                AUXINDEX NQ 0 DO
              BEGIN 
              FINDAUX(DATARECNAME); 
              AUXINDEX = AX$TNEXTPTR[AUXPTR]; 
              END 
          IF AX$DATARCNAM[AUXPTR] EQ TEMP2
          THEN
              KEYTRORD = AX$DATARCORD[AUXPTR];  #RECORD ORDINAL#
          ELSE
              KEYTRORD = 0;  #NON-IMBEDDED KEY# 
          AUXINDEX = TEMP1;  #RESTORE#
          RETURN; 
          END 
          CONTROL EJECT;
          PROC CDCSREL; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - CDCSREL
 *
 *        DOES - SCANS THE SS/CDCS -RELATION- FNAT (AUXTABLE) CHAIN OF
 *               RELATION QUALIFIERS
 *               SETS -CDCSRELFLAG- 
 *        GIVEN - -FNATPTR- = ADDRESS OF FNAT ENTRY 
 *                FNAT FIELD -FNATSSRQTLST- POINTS TO AUXTABLE CHAIN
 *                EACH AUXTABLE ENTRY CONTAINS
 *                 -AX$DNATSSDBI- - POINTER TO DNAT OF SS (RQT) DBI 
 *                 -AX$DNATSSDN-  - POINTER TO DNAT OF SS (RQT) DATANAME
 *
 *        RETURNS - IF PROPERTIES OF DBI AND DATANAME ARE NOT IDENTICAL,
 *                  SETS FNAT FIELD -FNATABORT- 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM DBITYPE U;    #CONTAIN SS (RQT) DBI PROPERTIES#
          ITEM DBIITMLEN U; 
          ITEM DBINUMLEN U; 
          ITEM DBIPOINT U;
          ITEM DBICHARPOS U;
          ITEM DBISIGNGRP U;
  
          AUXINDEX = FN$SSRQTLST[FNATPTR];
          FOR TEMP = TEMP WHILE AUXINDEX NQ 0 DO
              BEGIN 
              AUXPTR = VIRTUAL(TABLETYPE"AUX$", AUXINDEX);
              DNATPTR = VIRTUAL(TABLETYPE"AUX$", AX$DNATSSDBI[AUXPTR]); 
                             #ADDRESS OF DBI DNAT#
              DBITYPE = DN$TYPE[DNATPTR];  #SAVE DBI DNAT FIELDS# 
              DBIITMLEN = DN$ITMLEN[DNATPTR]; 
              DBINUMLEN = DN$NUMLEN[DNATPTR]; 
              DBIPOINT = DN$POINT[DNATPTR]; 
              DBISIGNGRP = DN$SIGNGRP[DNATPTR]; 
              DNATPTR = VIRTUAL(TABLETYPE"AUX$", AX$DNATSSDN[AUXPTR]);
                             #ADDRESS OF DATANAME DNAT# 
              IF FN$SSFDLT[FNATPTR] EQ 1 #FDLT-DEFINED RELATION#
              THEN
                  BEGIN 
                  IF DN$MAJMSEC[DNATPTR] EQ COMSMSEC
                  THEN
                      GOTO CDCSRELX;
                  ELSE
                      BEGIN 
                      FN$ABORT[FNATPTR] = 1;
                      INTERCEPTOR (253,0,D041,0);  #DIAG - 253 MEANS SS#
                      RETURN; 
                      END 
                  END 
              IF (DBITYPE EQ DN$TYPE[DNATPTR] OR
                  DN$TYPE[DNATPTR] EQ GROUP) AND
                 DBIITMLEN EQ DN$ITMLEN[DNATPTR]
              THEN
                  BEGIN 
                  IF DN$TYPE[DNATPTR] LS ERRTYPE
                  THEN       #NON-NUMERIC#
                      GOTO CDCSRELX;
                  IF DBINUMLEN EQ DN$NUMLEN[DNATPTR] AND
                     DBIPOINT EQ DN$POINT[DNATPTR] AND
                     DBISIGNGRP EQ DN$SIGNGRP[DNATPTR]
                  THEN
                      GOTO CDCSRELX;
                  END 
              FN$ABORT[FNATPTR] = 1;  #SET ABORT FLAG#
              INTERCEPTOR (253,0,D040,0);  #ERROR DIAG - 253 MEANS SS#
              RETURN; 
      CDCSRELX: 
              AUXINDEX = AX$TNEXTPTR[AUXPTR];  #PTR TO NEXT ENTRY IN
                                                 CHAIN# 
              END 
          CDCSRELFLAG = TRUE; 
          RETURN; 
          END 
          CONTROL FI; 
          CONTROL EJECT;
          PROC GENLABT; 
 # * *
 *
 *        PROC GENLABT - GENERATE LABEL TABLE 
 *
 *        NO INPUTS- OUTPUTS TABLE
 *
 *        USES - MOST STUFF 
 *
 * * * #
          BEGIN 
          ITEM LABLIT  I; 
          ITEM LABPTR  I; 
          ITEM LABSIZE I; 
          ITEM LABFIELD I;
          PROC GENLABTENT;  #GENERATE AN ENTRY# 
          BEGIN 
          LABFIELD = LABFIELD + 1;
          IF LABPTR EQ 0
          THEN
              RETURN;     #NO ENTRY IF NO PARAM SPECIFIED#
          IF CCTSUBPROGR AND NOT CCTMAINSUB AND FN$EXTERNAL[FNATPTR]
            EQ 1
          THEN
              BEGIN  # EXTERNAL FILE IN SUBPROG - GEN SPACE FOR BLOCK # 
              OUTPUTBSS (1);
              RETURN; 
              END 
          LABELTITEM = 0; 
          LABELTLTFL = LABFIELD;
          IF LABLIT EQ 1
          THEN
              BEGIN    # LITERAL - ADD IT TO LIT POOL # 
              PLTINDEX = LABPTR;
              POOLLIT;   #POOL THE LITERAL# 
              LABSIZE = PL$LENGTH [PLTPTR]; 
              IF PL$CODE [PLTPTR] EQ PLTINTLIT
              THEN
                  LABELTLTAN = 0;    #SET NUMERIC FIELD#
              ELSE
                  LABELTLTAN = 1;   #SET ALPHANUMERIC FIELD#
              LABELTLTBC = 0; 
              LABELTLTIL = LABSIZE; 
              LABPTR = DNATINDEX; 
              END 
          ELSE
              BEGIN  # DATA NAME #
              DNATPTR = VIRTUAL (TABLETYPE "DNAT$", LABPTR);
              IF DN$TYPE [DNATPTR] EQ NUMERIC 
              THEN
                  LABELTLTAN = 0; 
              ELSE
                  LABELTLTAN = 1; 
              LABELTLTBC = DN$CHARPOS [DNATPTR];
              LABELTLTIL = DN$ITMLEN [DNATPTR]; 
              END 
          RELOCLOWER (LABELTITEM, LABPTR, TABLETYPE "DNAT$"); 
          CURRFNATOFF = CURRFNATOFF + 1;
          RETURN; 
          END 
  
  
  
 #     START MAIN PROCESS # 
          IF NOT (CCTSUBPROGR AND NOT CCTMAINSUB
            AND FN$EXTERNAL [FNATPTR] EQ 1) 
          THEN    # DEFINE START OF TABLE ONLY IF NOT EXT FILE IN SB #
              DEFLOCLAB (LABELPTR); 
          LABFIELD = 0; 
          LABPTR = FN$LABLPTR1 [FNATPTR]; 
          LABLIT = FN$LABLLIT1 [FNATPTR]; 
          GENLABTENT;                            # FILE-ID #
          LABPTR = FN$LABLPTR2 [FNATPTR]; 
          LABLIT = FN$LABLLIT2 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR3 [FNATPTR]; 
          LABLIT = FN$LABLLIT3 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR4 [FNATPTR]; 
          LABLIT = FN$LABLLIT4 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR5 [FNATPTR]; 
          LABLIT = FN$LABLLIT5 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR6 [FNATPTR]; 
          LABLIT = FN$LABLLIT6 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR7 [FNATPTR]; 
          LABLIT = FN$LABLLIT7 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR8 [FNATPTR]; 
          LABLIT = FN$LABLLIT8 [FNATPTR]; 
          GENLABTENT; 
          LABPTR = FN$LABLPTR9 [FNATPTR]; 
          LABLIT = FN$LABLLIT9 [FNATPTR]; 
          GENLABTENT; 
          IF CCTSUBPROGR AND NOT CCTMAINSUB AND FN$EXTERNAL[FNATPTR]
            EQ 1
          THEN
              BEGIN  # EXTERNAL FILE IN SUBPROG - GEN SPACE FOR BLOCK # 
              OUTPUTBSS (1);
              END 
          ELSE
              BEGIN 
              OUTPUTDATA (0); 
              CURRFNATOFF = CURRFNATOFF + 1;
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC GENLINTB;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC GENLINTB - GENERATE LINAGE TABLE 
 *
 *        NO INPUTS - OUTPUTS TABLE 
 *
 *        USES - MISC STUFF 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          ITEM LINLIT I;
          ITEM LINPTR I;
          ITEM LININDEX I;
          BEGIN 
  
          PROC GENLINENT;  #GENERATE AN ENTRY#
  
          BEGIN 
          LINAGETITEM = 0;
          IF CCTSUBPROGR AND NOT CCTMAINSUB AND FN$EXTERNAL[FNATPTR]
            EQ 1
          THEN
              BEGIN  # EXTERNAL FILE IN SUBPROG - GEN SPACE FOR BLOCK # 
              OUTPUTBSS (1);
              RETURN; 
              END 
          IF LINLIT EQ 1
          THEN
              BEGIN   #ITEM IS A LITERAL# 
              LINAGETLIVA = CONVINT (LINPTR);   #CONVERT LITERAL TO BIN#
              OUTPUTDATA (LINAGETITEM);   #OUTPUT ITEM# 
              END 
          ELSE
              BEGIN   #ITEM IS A DATA-NAME# 
              IF LINPTR EQ 0
              THEN
                  OUTPUTDATA (0);   #FILED NOT SPECIFIED# 
              ELSE
                  BEGIN 
                  DNATPTR = VIRTUAL (TABLETYPE "DNAT$", LINPTR);
                  IF DN$TYPE [DNATPTR] EQ COMP1 
                  THEN
                      LINAGETLIC1 = 1;    #ITEM IS A COMP-1 ITEM# 
                  LINAGETLIBC = DN$CHARPOS [DNATPTR]; 
                  LINAGETLISZ = DN$NUMLEN [DNATPTR];
                  RELOCLOWER (LINAGETITEM, LINPTR, TABLETYPE "DNAT$");
                  END 
              END 
          CURRFNATOFF = CURRFNATOFF + 1;
          RETURN; 
          END 
  
 #      START MAIN PROCESS  # 
  
          IF NOT (CCTSUBPROGR AND NOT CCTMAINSUB
            AND FN$EXTERNAL [FNATPTR] EQ 1) 
          THEN    # DEFINE START OF TABLE ONLY IF NOT EXT FILE IN SB #
              DEFLOCLAB (LINLABEL); 
          LINLIT = FN$LINAGLIT [FNATPTR]; 
          LINPTR = FN$LINAGPTR [FNATPTR]; 
          GENLINENT;
          IF FN$FOOTPTR [FNATPTR] NQ 0
          THEN  # IF FOOTING NOT GIVEN LINAGE VALUE IS USED INSTEAD#
              BEGIN 
              LINLIT = FN$FOOTLIT [FNATPTR];
              LINPTR = FN$FOOTPTR [FNATPTR];
              END 
          GENLINENT;
          LINLIT = FN$TOPLIT [FNATPTR]; 
          LINPTR = FN$TOPPTR [FNATPTR]; 
          GENLINENT;
          LINLIT = FN$BOTTLIT [FNATPTR];
          LINPTR = FN$BOTTPTR [FNATPTR];
          GENLINENT;
          LINLIT = 0; 
          LINPTR = FN$DNATPTR [FNATPTR] + 1;  #POINT TO LINAGE COUNTER# 
          GENLINENT;
          RETURN; 
          END 
          CONTROL EJECT;
          PROC GETBCPANDWN; 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         NAME - GETBCPANDWN
* 
*         DOES - GETS BCP, CHARACTER OFFSET AND WORD NUMBER FROM DNAT 
*         RETURNS BCP IN CHARPOS, CHARACTER OFFSET FROM BEGINNING OF
*                RECORD IN CHAROFFSET, AND WORD OFFSET IN WORDOFFSET. 
* 
*         INPUT - NO INPUT.  USES THE CURRENT DNATPTR.
* 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          ITEM TEMPPTR I; 
  
          BEGIN 
          CHAROFFSET = ((DN$WORDOFF [DNATPTR] - CRECOFFSET) * 10) + 
              DN$CHARPOS [DNATPTR]; 
          WORDOFFSET = CHAROFFSET / 10; 
          CHARPOS = CHAROFFSET - (WORDOFFSET * 10); 
          RETURN; 
          END 
          CONTROL EJECT;
          FUNC INREC ((INDNAT)) B;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        FUNC - INREC
 *
 *        DOES - CHECKS TO SEE IF INDNAT IS WITHIN A RECORD OF THE
 *               CURRENT FILE 
 *
 *        RETURNS - TRUE IF IN REC, FALSE IF NOT
 *
 *        INPUT - DNAT OF FIELD TO BE CHECKED 
 *
 *        USES - DNATPTR CHANGED
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM INDNAT I;
          ITEM INTEMP I;
          ITEM TEMPDNAT I;
  
          DNATPTR = VIRTUAL (TABLETYPE"DNAT$", INDNAT); 
          INTEMP = DN$MAJMSEC [DNATPTR];
          IF NOT (INTEMP EQ FDMSEC OR INTEMP EQ SDMSEC) 
          THEN
              BEGIN 
              INREC = FALSE;  # NOT AN FD TYPE - NOT IN FILE RECORD # 
              RETURN; 
              END 
          FOR TEMPDNAT = INDNAT STEP -1 UNTIL 0 DO
              BEGIN  #  GO BACK THRU DNAT LOOKING FOR FD ENTRY #
              DNATPTR = VIRTUAL (TABLETYPE"DNAT$", TEMPDNAT); 
              INTEMP = DN$LEVEL [DNATPTR];
              IF INTEMP EQ FDDESCR
              OR INTEMP EQ SDDESCR
              THEN
                  BEGIN  # IS AN FD ENTRY - SEE IF IT IS CURRENT ONE #
                  TEMPDNAT = 0;    # TERMINATE LOOP # 
                  IF DN$FNATPTR [DNATPTR] EQ FNATINDEX
                  THEN
                      INREC = TRUE;   # IS IN THIS RECORD AREA #
                  ELSE
                      INREC = FALSE;   # NOT IN THIS RECORD AREA #
                  END 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          FUNC KEYINREC ((INDEXIN)) I;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - KEYINREC 
 *
 *        DOES - RETURNS 1 IF THE DNAT ITEM POINTED TO BY INDEXIN IS
 *                IN A RECORD OF THE CURRENT FILE, 0 IF NOT.
 *               ALSO SETS KEYINRFLAG TRUE IF IN REC, FALSE IF NOT
 *
 *        INPUT - INDEXIN - A DNAT POINTER TO THE ITEM IN QUESTION
 *                FNATINDEX - MUST HAVE INDEX OF CURRENT FNAT 
 *
 *        CHANGES - TEMPS 
 *                AUXPTR - SET TO FILE AUX (IF ANY) - VIRTUALIZED 
 *                AUXINDEX - DITTO - NOT VIRTUALIZED
 *                DNATPTR - RESET TO VIRTUAL POINTER OF INDEXIN 
 *               KEYINRFLAG - SET TRUE IF IN REC, FLASE IF NOT
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM INDEXIN I; 
  
          TEMP2 = INDEXIN;
          TEMP1 = VIRTUAL (TABLETYPE "DNAT$", INDEXIN); 
          IF DN$MAJMSEC [TEMP1] NQ FDMSEC 
          THEN
              BEGIN  # NOT AN FD ITEM - OBVIOUSLY NOT IN RECORD # 
              KEYINREC = 0; 
              KEYINRFLAG = FALSE; 
              RETURN; 
              END 
          FOR TEMP = TEMP WHILE DN$LEVEL [TEMP1] NQ 1 DO
                  BEGIN   # FIND 01 LEVEL ITEM #
                  TEMP2 = TEMP2 - 1;
                  TEMP1 = VIRTUAL (TABLETYPE"DNAT$", TEMP2);
                  END 
          AUXINDEX = DN$AUXREF [TEMP1]; 
          FINDAUX (FILENAME); 
          IF AUXINDEX NQ 0
          AND FNATINDEX EQ AX$FNATPTR [AUXPTR]
          THEN
              BEGIN 
              KEYINREC = 1; 
              KEYINRFLAG = TRUE;
              END 
          ELSE
              BEGIN 
              KEYINREC = 0; 
              KEYINRFLAG = FALSE; 
              END 
          DNATPTR = VIRTUAL (TABLETYPE "DNAT$", INDEXIN);  # RESET #
          RETURN; 
          END 
          CONTROL EJECT;
          PROC POOLLIT; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - POOLLIT
 *
 *        DOES - POOLS A LITERAL AND CREATES A DNAT FOR IT. 
 *
 *        INPUT - PLTINDEX - PLT INDEX TO LITERAL IN QUESTION 
 *
 *        OUTPUT - DNATINDEX - DNAT INDEX OF DNAT OF LITERAL
 *                DNAT ENTRY IS SET UP CORRECTLY
 *                PLTPTR IS VIRTUAL POINTER FOR PLT ENTRY OF LIT
 *
 *        USES -  PLTPTR
 *                PLTSTRDATA
 *                DNATPTR 
 *                CCTDNATLEN
 *                TEMP
 *                TEMP1 
 *                TEMP2 
 *                THE VIRTUAL TABLES DNAT AND PLTSTR AND LPOOL ARE
 *                REPOSITIONED SO ANY VIRTUAL POINTERS MAY NOT BE VALID.
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM EQFLAG  B; 
          ITEM LITSIZE  I;
          ITEM POOLINDEX  I;
          ITEM WDSINLIT  I; 
  
          GETPLST (PLTINDEX, LOC(PLTSTRDATA));  #GET LITERAL# 
          PLTPTR = VIRTUAL (TABLETYPE"PLT$", PLTINDEX); 
          LITSIZE = PL$LENGTH [PLTPTR]; 
          WDSINLIT = (LITSIZE + 9) / 10;  #NBR WORDS# 
          EQFLAG = FALSE; 
          TEMP = (CCTLPOOLLEN + 9) / 10;  #NBR WORDS IN POOL# 
          FOR POOLINDEX = 0 STEP 1
          WHILE NOT EQFLAG AND POOLINDEX LS TEMP
              DO BEGIN   #SEARCH POOL FOR MATCH#
              IF LPWORDC [VIRTUAL (TABLETYPE"LPOOL$", POOLINDEX)] 
                  EQ PLTSTRDWORD [0]
              THEN
                  BEGIN 
                  IF POOLINDEX + WDSINLIT GR TEMP THEN TEST POOLINDEX;
                  FOR TEMP1 = 1 STEP 1 WHILE TEMP1 LS WDSINLIT
                      DO BEGIN
                      IF LPWORDC [VIRTUAL(TABLETYPE"LPOOL$",
                          POOLINDEX + TEMP1)] NQ PLTSTRDWORD [TEMP1]
                      THEN
                          BEGIN 
                          TEST POOLINDEX; 
                          END 
                      END 
                  EQFLAG = TRUE;
                  END 
              END 
          IF NOT EQFLAG 
          THEN
              BEGIN   #DUPLICATE NOT FOUND IN POOL# 
              FOR TEMP1 = 0 STEP 1 UNTIL WDSINLIT DO
                  BEGIN   #MOVE LIT TO POOL#
                  LPWORDC [VIRTUAL (TABLETYPE"LPOOL$",
                      POOLINDEX + TEMP1)] = PLTSTRDWORD [TEMP1];
                  END 
              CCTLPOOLLEN = (TEMP + WDSINLIT) * 10; 
              END 
          ELSE
              POOLINDEX = POOLINDEX - 1;   #BACK 1 BECAUSE OF FOR INC#
 #     CREATE A DNAT ENTRY FOR THE LITERAL #
          CCTDNATLEN = CCTDNATLEN + 1;
          DNATINDEX = CCTDNATLEN; 
          DNATPTR = VIRTUAL(TABLETYPE"DNAT$", DNATINDEX); 
          DN$MAJMSEC [DNATPTR] = LITMSEC; 
          DN$SUBMSEC [DNATPTR] = LITBLK;
          DN$WORDOFF [DNATPTR] = POOLINDEX; 
          DN$CHARPOS [DNATPTR] = 0; 
          RETURN; 
          END 
          CONTROL EJECT;
 #
 *        PROCS FOR PROCESSING THE USE LITERAL. 
 *
 *        GETNBR GETS A PARAMETER WHICH SHOULD BE A NUMBER AND CONVERTS 
 *            IT AND RETURNS IT (GETNBR IS A FUNC). 
 *
 *        GETPAR GETS A PARAMATER FROM THE LIST 
 *
 *        GETYESNO GETS A YES OR NO PARAMETER AND RETURNS ANSWER (IT IS 
 *            A FUNC).
 *
 #
          XDEF PROC PROCUSE;
          PROC PROCUSE (NOTPRINTF); 
          BEGIN 
          ITEM NOTPRINTF B;  #TRUE IF NOT PRUF OR PRINTF TEST FROM PT#
  
          DEF NBRPARAMS #31#;    # NUMBER OF PARAMETERS # 
          ARRAY PARAMLIST [1:NBRPARAMS] S(1); 
              BEGIN 
              ITEM PARAMITEM C(0, 0, 10)
                  =[
                  "BBH       ", 
                  "BCK       ", 
                  "BFS       ", 
                  "BT        ", 
                  "CNF       ", 
                  "CPA       ", 
                  "DFC       ", 
                  "DP        ", 
                  "EFC       ", 
                  "EO        ", 
                  "ERL       ", 
                  "EXD       ", 
                  "FF        ", 
                  "FLM       ", 
                  "FWI       ", 
                  "HB        ", 
                  "IBL       ", 
                  "IP        ", 
                  "MUL       ", 
                  "NL        ", 
                  "ORG       ", 
                  "OVF       ", 
                  "PC        ", 
                  "PRINTF    ", 
                  "PRUF      ", 
                  "RMK       ", 
                  "RT        ", 
                  "SBF       ", 
                  "SDS       ", 
                  "SPR       ", 
                  "TRC       ", 
                  ];
              END 
  
          SWITCH PARAMSWITCH
                 NULLPAR     #NOT USED# 
              ,   BBH        #BUFFER BEFORE HHA#
              ,   BCK        #BLOCK CHECKSUM# 
              ,   BFS        #BUFFER SIZE#
              ,   BT         #BLOCK TYPE# 
              ,   CNF        #CONNECT FILE FLAG#
              ,   CPA        #COMPRESSION/ENCRIPTION ROUTINE# 
              ,   DFC        #DAYFILE CONTROL#
              ,   DP         #DATA BLOCK PADDING# 
              ,   EFC        #ERROR FILE CONTROL# 
              ,   EO         #ERROR OPTION# 
              ,   ERL        #ERROR LIMIT#
              ,   EXD        #EXTEND DIAGNOSTICS# 
              ,   FF         #FLUSH FLAG# 
              ,   FLM        #FILE LIMITS#
              ,   FWI        #FORCED WRITE INDICATOR# 
              ,   HB         #HOME BLOCKS#
              ,   IBL        #INDEX BLOCK LENGTH# 
              ,   IP         #INDEX BLOCK PADDING#
              ,   MUL        #MULT OF CHARS PER BLOCK#
              ,   NL         #NUMBER OF INDEX LEVELS# 
              ,   ORG        #OLD/NEW FOR FLAG# 
              ,   OVF        #STORAGE OF OVERFLOW RECS IN DA FILES# 
              ,   PC         #PADDING CHARACTER#
              ,   PRINTF     #PRINT FILE# 
              ,   PRUF       #PRU ALIGNED FILE# 
              ,   RMK        #RECORD MARK CHARACTER#
              ,   RT         #RECORD TYPE#
              ,   SBF        #SUPPRESS BUFFERING# 
              ,   SDS        #DAYFILE STATS#
              ,   SPR        #SUPPRESS READ AHEAD#
              ,   TRC        #TRACE ACTIONS#
              ; 
  
          ITEM GETNBRNOGP B=FALSE;
          ITEM LITCOLUMN I; 
          ITEM LITLINE I; 
          ITEM LITSTRING C(240);
          ITEM LITLENGTH I; 
          ITEM PARAM C(10); 
          ITEM PARAMCHAR C(1);
          ITEM PARAMINDEX I;
          ITEM PARAMOCTAL B;
  
  
          FUNC GETNBR I;
 #
 *        GETNBR RETURNS AN EXPECTED NUMBER FROM THE USE STRING 
 *        IF A NUMBER IS NOT FOUND, ZERO IS RETURNED AND A DIAG 
 *        IS GIVEN. 
 *        IF THE NUMBER IS SUFFIXED BY B, IT IS OCTAL, OTHERWISE, 
 *        IT IS DECIMAL.
 *
 #
          BEGIN 
  
          ITEM MULTIPLIER I;
          ITEM INTCHAR  I = 0;
          ITEM GETNINDEX  I;
          ITEM NUMBER I = 0;
  
          IF GETNBRNOGP 
          THEN
              GETNBRNOGP = FALSE;   #DONT GET PARAM - CLEAR FLAG# 
          ELSE
              GETPAR;  #GET PARAM#
          PARAMCHAR = C<PARAMINDEX - 1, 1> PARAM;  #GET LAST CHAR#
          IF PARAMCHAR EQ "B" 
          THEN
              BEGIN 
              PARAMINDEX = PARAMINDEX - 1;   #DO NOT PROC B#
              MULTIPLIER = 8; 
              PARAMOCTAL = TRUE;
              END 
          ELSE
              BEGIN 
              MULTIPLIER = 10;
              PARAMOCTAL = FALSE; 
              END 
          NUMBER = 0; 
          FOR GETNINDEX = 0 STEP 1 UNTIL PARAMINDEX - 1 DO
              BEGIN 
              NUMBER = NUMBER * MULTIPLIER; 
              PARAMCHAR = C<GETNINDEX, 1> PARAM;
              IF PARAMCHAR LS "0" 
              OR PARAMCHAR GR "9" 
              THEN
                  BEGIN   #ERROR - NON NUMERIC CHAR#
                  LITCOLUMN = LITCOLUMN + GETNINDEX;   #PT TO COL FOR N#
                  PROCUSEERR (D030);
                  PARAMCHAR = 0;
                  RETURN; 
                  END 
              C<9, 1> INTCHAR = PARAMCHAR;
              INTCHAR = INTCHAR - O"33";   #REMOVE BIAS#
              NUMBER = NUMBER + INTCHAR;
              END 
          GETNBR = NUMBER;
          RETURN; 
          END 
  
  
          FUNC GETNBRBOUNDS (LBOUND, UPBOUND);
 #
 *        GETNBRBOUNDS GETS A NUMBER AND CHECKS TO SEE IF IT IS 
 *        WITHIN REQUIRED BOUNDS
 #
          BEGIN 
          ITEM LBOUND I;
          ITEM UPBOUND I; 
  
          TEMP = GETNBR;
          IF TEMP LS LBOUND 
          OR TEMP GR UPBOUND
          THEN
              BEGIN 
              PROCUSEERR (D035);
              TEMP = 0; 
              END 
          GETNBRBOUNDS = TEMP;
          RETURN; 
          END 
  
  
          PROC GETPAR;
 #
 *        GETPAR GETS THE NEXT PARAMETER FROM THE INPUT STRING
 *        IT IS PUT INTO PARAM. 
 *        PARAMINDEX WILL POINT TO THE NEXT AVAIL CHAR POS IN PARAM 
 *        INDEX WILL POINT TO THE NEXT PLACE TO GET A CHAR. 
 *
 #
          BEGIN 
  
          PARAMINDEX = 0; 
          PARAM = "          "; 
          LITCOLUMN = PL$COLUMN [PLTPTR] + INDEX;  #POINT TO COLUMN#
          FOR PARAMINDEX = 0 STEP 1 UNTIL 9 DO
              BEGIN 
              PARAMCHAR = C<INDEX - 1, 1> LITSTRING;
              INDEX = INDEX + 1;
              IF PARAMCHAR EQ "=" 
              OR PARAMCHAR EQ "," 
              OR PARAMCHAR EQ "." 
              THEN
                  RETURN; 
              IF PARAMCHAR EQ " " 
              THEN
                  BEGIN 
                  PARAMINDEX = PARAMINDEX - 1;
                  IF PARAMINDEX EQ -1 
                  THEN
                      LITCOLUMN = LITCOLUMN + 1;  #SKIP BLANKS# 
                  TEST PARAMINDEX;   #BYPASS BLANKS#
                  END 
              C<PARAMINDEX, 1> PARAM = PARAMCHAR; 
              END 
          RETURN; 
          END 
  
  
          FUNC GETYESNO I;
 #
 *        GETYESNO PICKS UP THE NEXT PARAMETER AND SEES IF IT IS YES
 *        OR NO.  IF SO, RETURNS FITV$YES OR FITV$NO. 
 *        IF NOT, A DIAG IS GIVEN AND NO IS RETURNED. 
 *
 #
  
          BEGIN 
          GETPAR;  #GET NEXT PARAMETER# 
          IF PARAM EQ "YES" 
          THEN
              BEGIN 
              GETYESNO = FITV$YES;
              RETURN; 
              END 
          ELSE
              BEGIN 
              IF PARAM EQ "NO"
              THEN
                  BEGIN 
                  GETYESNO = FITV$NO; 
                  RETURN; 
                  END 
              END 
          PROCUSEERR (D031);  #NEITHER YES OR NO# 
          RETURN; 
          END 
  
          PROC PROCUSEERR (DIAGNBR);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC PROCUSEERR - PUT OUT USE LITERAL DIAGS 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
  
          ITEM DIAGNBR I; 
  
          IF NOTPRINTF
          THEN   #GIVE DIAG ONLY IF NOT LOOKING FOR PRINTF=YES FM PROCT#
              INTERCEPTOR (LITCOLUMN,LITLINE, DIAGNBR, 1);
          RETURN; 
          END 
          CONTROL EJECT;
 #      BEGIN MAIN PROCEDURE OF PROCUSE                                #
  
          GETPLST (PLTINDEX, LOC(LITSTRING));  #GET USE LIT#
          PLTPTR = VIRTUAL (TABLETYPE "PLT$", PLTINDEX);
          LITLINE = PL$LINE [PLTPTR]; 
          LITLENGTH = PL$LENGTH [PLTPTR]; 
          C<LITLENGTH, 1> LITSTRING = ".";   #PUT IN A TERMINATOR#
          FOR INDEX = 1 WHILE INDEX LQ LITLENGTH DO 
              BEGIN 
              GETPAR;   #GET NEXT PARAMETER#
              IF PARAMCHAR NQ "=" 
              THEN
                  BEGIN   #ERROR - DELIMITER NOT = #
                  LITCOLUMN = PL$COLUMN [PLTPTR] + INDEX; #PT TO COL# 
                  PROCUSEERR (D032);
                  GOTO GOTOCOMMA;   #SKIP TO NEXT COMMA#
                  END 
              FOR PARAMINDEX = 1 STEP 1 UNTIL NBRPARAMS DO
                  BEGIN   #FIND PARAMETER IN LIST OF PARAMS#
                  IF PARAM EQ PARAMITEM [PARAMINDEX]
                  THEN
                      GOTO PARAMSWITCH [PARAMINDEX];  #GO TO PROCESSOR# 
                  END 
 #     PARAMETER NOT FOUND - MUST BE A BAD ONE                         #
              PROCUSEERR (D033);
  
 GOTOCOMMA:   #SKIP TO NEXT COMMA#
              FOR PARAMINDEX = PARAMINDEX WHILE PARAMCHAR NQ "," DO 
                  BEGIN 
                  GETPAR; 
                  END 
              TEST INDEX; 
 NULLPAR: 
 BBH:     #BUFFER BEFORE HHA# 
          FIT$BBH = GETYESNO; 
          IF PARAM EQ "YES" 
          THEN
              GENLDSET (LDSETVAL"USE", "CMM.AGR");  #LOAD CMM MODULE# 
          TEST INDEX;   #EXIT#
  
  
 BCK:     #BLOCK CHECKSUM#
          FIT$BCK = GETYESNO;   #YES OR NO ALLOWED# 
          TEST INDEX;   #EXIT#
  
 BFS:     #BUFFER SIZE# 
          FIT$BFS = GETNBRBOUNDS (0,64000); 
          TEST INDEX;   #EXIT#
  
 BT:   #BLOCK TYPE PROCESS# 
          DEF NBRBTPARS  #4#;   #NUMBER OF BLOCK TYPES# 
          ARRAY BTPARLIST [1: NBRBTPARS] S(1);
              BEGIN 
              ITEM BTPARNAME  C(0,0,1)
                  =[
                  "C",
                  "E",
                  "I",
                  "K",
                  ];
              ITEM BTPARVAL  I(0,6,6) 
                  =[
                  FITV$CT,
                  FITV$ET,
                  FITV$IT,
                  FITV$KT,
                  ];
              END 
  
          GETPAR;   #GET BLOCK TYPE#
          FOR TEMP = 1 STEP 1 UNTIL NBRBTPARS DO
              BEGIN 
              IF BTPARNAME [TEMP] EQ PARAM
              THEN
                  BEGIN 
                  FIT$BT [0] =  BTPARVAL [TEMP];
                  TEMP = 10000;   #TERMINATE LOOP#
                  END 
              END 
          IF TEMP NQ 10001
          THEN
              GOTO BADPAR;   #ERROR - BAD PARAMETER#
          TEST INDEX; 
  
 CNF:     #CONNECT FILE FLAG ROUTINE# 
          FIT$CNF = GETYESNO; 
          TEST INDEX;   #EXIT#
  
 CPA:     #COMPRESSION/ENCRIPTION ROUTINE#
          FIT$CPA = GETNBRBOUNDS (0,63);
          TEST INDEX;   #EXIT#
  
 DFC:     #DAYFILE CONTROL FOR ERRORS#
          FIT$DFC = GETNBRBOUNDS (0,3); 
          TEST INDEX;   #EXIT#
  
 DP:      #DATA PADDING#
          FIT$DP = GETNBRBOUNDS (0, 99);
          TEST INDEX;   #EXIT#
  
 EFC:     #ERROR FILE CONTROL#
          FIT$EFC = GETNBRBOUNDS (0,3); 
          TEST INDEX;   #EXIT#
  
 EO:      #ERROR OPTION#
          DEF NBREOPARS  #6#; 
          ARRAY EOLIST [1: NBREOPARS] S(1); 
              BEGIN 
              ITEM EOPARNAME C(0,0,2) 
                  =[
                  "T",
                  "TD", 
                  "D",
                  "A",
                  "DD", 
                  "AD", 
                  ];
              ITEM EOPARVAL  U(0,12,6)
                  =[
                  FITV$T, 
                  FITV$TD,
                  FITV$D, 
                  FITV$A, 
                  FITV$DD,
                  FITV$AD,
                  ];
              END 
  
          GETPAR;   #GET ERROR OPTION#
          FOR TEMP  = 1 STEP 1 UNTIL NBREOPARS DO 
              BEGIN 
              IF EOPARNAME [TEMP] EQ PARAM
              THEN
                  BEGIN 
                  FIT$EO = EOPARVAL [TEMP]; 
                  TEST INDEX;   #EXIT#
                  END 
              END 
              GOTO BADPAR;   #PARAM NOT FOUND#
  
 ERL:     #ERROR LIMIT# 
          FIT$ERL = GETNBRBOUNDS (1, 511);
          TEST INDEX;   #EXIT#
  
 EXD:     #EXTENDED DIAGNOSTICS#
          PROCUSEERR (D042);   #NO LONGER SUPPORTED IN CRM# 
          TEST INDEX;   #EXIT#
  
 FF:      #FLUSH FLAG#
          FIT$FF = GETYESNO;
          TEST INDEX;   #EXIT#
  
 FLM:     #FILE LIMITS# 
          FIT$FLM = GETNBRBOUNDS (0, 5000000);
          TEST INDEX;   #EXIT#
  
 FWI:     #FORCED WRITE INDICATOR#
          FIT$FWI = GETYESNO;   #YES OR NO ALL ALLOWED# 
          TEST INDEX;   #EXIT#
  
 HB:      #USER HEADER OPTION#
          FIT$HB = GETYESNO;   #YES OR NO ALLOWED#
          TEST INDEX;   #EXIT#
  
 IBL:     #INDEX BLOCK LENGTH#
          FIT$IBL = GETNBRBOUNDS (0, 1310700);
          TEST INDEX;   #EXIT#
  
 IP:      #INDEX PADDING# 
          FIT$IP = GETNBRBOUNDS (0, 99);
          TEST INDEX;   #EXIT#
  
 MUL:     #MULTIPLE OF CHARS IN BLOCK#
          FIT$MUL = GETNBRBOUNDS (0, 63); 
          TEST INDEX;   #EXIT#
  
 NL:      #NUMBER OF INDEX LEVELS#
          FIT$NL = GETNBRBOUNDS (0, 63);
          TEST INDEX;   #EXIT#
  
 ORG:     #OLD/NEW FILE ORGANIZATION FLAG - OLD OR NEW ALLOWED# 
          GETPAR;            #GET OPTIONS#
          IF PARAM EQ "OLD       "
          THEN
              FIT$ORG = FITV$OLD; 
          ELSE
              BEGIN 
              IF PARAM EQ "NEW       "
              THEN
                  FIT$ORG = FITV$NEW; 
              ELSE
                  GOTO BADPAR;     #UNRECOGNIZED PARAM# 
              END 
          TEST INDEX;  #EXIT# 
  
 OVF:     #OVERFLOW FLAG# 
          DEF NBROVFPARS #3#; 
          ARRAY OVFPARLIST [1: NBROVFPARS] S(1);
              BEGIN 
              ITEM OVFPARNAME C(0,0,3)
                  =[
                  "OVB",
                  "OVO",
                  "OVH",
                  ];
              ITEM OVFPARVAL  U(0,18,6) 
                  =[
                  2,   #NO MNEMONIC VALUES EXIST IN IOTEXT# 
                  1,
                  3,
                  ];
              END 
  
          GETPAR;  #GET FLAG# 
          FOR TEMP = 1 STEP 1 UNTIL NBROVFPARS DO 
              BEGIN 
              IF OVFPARNAME [TEMP] EQ PARAM 
              THEN
                  BEGIN 
                  FIT$OVF = OVFPARVAL [TEMP]; 
                  TEST INDEX;   # EXIT# 
                  END 
              END 
          GOTO BADPAR;   #ERROR#
  
 PC:      #PADDING CHARACTER# 
          TEMP = GETNBR;   #0 TO 77B ALLOWED# 
          IF PARAMOCTAL 
          AND TEMP LS 64
          THEN
              FIT$PC = TEMP;
          ELSE
              GOTO BADPAR;
          TEST INDEX;   #EXIT#
  
  
 PRINTF:     #PRINT FILE# 
          TEMP = GETYESNO;
          IF TEMP NQ FITV$YES 
          THEN
              GOTO BADPAR;
          FN$PRINTF [FNATPTR] = 1;     #FLAG AS PRINT FILE# 
          TEST INDEX; 
  
 PRUF:    #PRU ORIENTED RELATIVE FILE#
          IF NOTPRINTF
          THEN
              XWD$PRUF = GETYESNO;   # NOT TESTING FOR PRINTF OR PRUF # 
          ELSE
              BEGIN   # TESTING FOR PRUF FROM PROCTAB # 
              TEMP = GETYESNO;
              IF TEMP NQ 0
              THEN
                  BEGIN 
                  FN$ACCUMMAX [FNATPTR] =(((FN$ACCUMMAX [FNATPTR] + 649)
                    / 640) * 640) - 10;  # MULT OF PRUS - 10 #
                  FN$RCTMAX [FNATPTR] = 0;
                  FN$RCTMIN [FNATPTR] = 0;  # IGNORE BOTH # 
                  END 
              END 
          TEST INDEX;   #EXIT#
  
 RMK:     #RECORD MARK# 
          GETPAR;  #GET THE PARAMETER#
          IF C<0,2>PARAM EQ "1R"
          AND PARAMINDEX LS 4 
          THEN
              TEMP = B<12,6>PARAM;    #CHAR IS SPECIFIED VIA 1RX# 
          ELSE
              BEGIN 
              IF PARAMINDEX EQ 1
              AND C<0,1>PARAM EQ "0"
              THEN
                  TEMP = O"62";   #REC MARK IS 62B - RT BRACKET#
              ELSE
                  BEGIN 
                  GETNBRNOGP = TRUE;  #TELL GETNBR NOT TO FETCH PARAM#
                  TEMP = GETNBRBOUNDS (0, 63);
                  END 
              END 
          FIT$RMK = TEMP; 
          TEST INDEX;   #EXIT#
  
 RT:   #RECORD TYPE PROCESS#
          DEF NBRRTPARS  #9#;    #NUMBER OF RECORD TYPES# 
          ARRAY RTPARLIST [1: NBRRTPARS] S(1);
              BEGIN 
              ITEM RTPARNAME  C(0,0,1)
                  =[
                  "B",
                  "D",
                  "F",
                  "R",
                  "S",
                  "T",
                  "U",
                  "W",
                  "Z",
                  ];
              ITEM RTPARVAL  I(0,6,6) 
                  =[
                  FITV$BT,
                  FITV$DT,
                  FITV$FT,
                  FITV$RT,
                  FITV$ST,
                  FITV$TT,
                  FITV$UT,
                  FITV$WT,
                  FITV$ZT,
                  ];
              END 
  
          GETPAR;   #GET RECORD TYPE# 
          FOR TEMP = 1 STEP 1 UNTIL NBRRTPARS DO
              BEGIN 
              IF RTPARNAME [TEMP] EQ PARAM
              THEN
                  BEGIN 
                  RECTYPE = RTPARVAL [TEMP];
                  TEMP = 10000;   #TERMINATE LOOP#
                  END 
              END 
          IF TEMP NQ 10001
          THEN
              GOTO BADPAR;   #ERROR - BAD PARAMETER#
          # USER MUST NOT FORCE RELATIVE OR WA FILES                   #
          # TO RECORD TYPE OTHER THAN U                                #
          IF ( FILEORG EQ RELATIVE )
                       OR 
             ( FILEORG EQ WORD$ADDR) THEN 
              IF RECTYPE NQ FITV$UT THEN
                  BEGIN 
                  PROCUSEERR(D037); 
                  RECTYPE = FITV$UT;
                  END 
          TEST INDEX; 
 SBF:     #SUPPRESS BUFFERING#
          FIT$SBF = GETYESNO; 
          TEST INDEX;   #EXIT#
  
 SDS:     #DAYFILE STATS# 
          PROCUSEERR (D042);   #NO LONGER SUPPORTED IN CRM# 
          TEST INDEX;   #EXIT#
  
 SPR:     #SUPPRESS READ AHEAD# 
          FIT$SPR = GETYESNO; 
          TEST INDEX;   #EXIT#
  
 TRC:     #TRACE# 
          FIT$TRC = GETNBRBOUNDS (0, 63); 
          TEST INDEX;   #EXIT#
  
 BADPAR:  
          PROCUSEERR (D034);
          GOTO GOTOCOMMA; 
          END   #END OF INDEX FOR LOOP# 
          RETURN; 
          END   #END OF USE PROCESS#
             PROC PUTRCVE(LOCN);
  #THIS PROCEDURE DETERMINES THE SIZE OF THE NUMBER IN RECEIVE# 
             ITEM LOCN I; 
             BEGIN
             FOR LOCN = 0 WHILE 
               C<LOCN,1>RECEIVE NQ " " DO 
                 LOCN = LOCN + 1; 
               RETURN;
             END; 
             PROC DUMPKEY;
            # THIS PROCEDURE DUMPS ALTERNATE KEY INFO FOR FILE# 
              BEGIN 
                ITEM     WDSINLIT    I; 
                ITEM     SVAUXIDX    I; 
                ITEM     SVAUXPTR    I; 
              C<0,140>FMAWS = " ";
              C<0,3>FMAWS = "KEY"; #INDICATES ALTERNATE KEY#
              C<3,2>FMAWS = FKT[KEYTKT];
              C<5,7>FMAWS = "0000000";
              RECEIVE = DEC(KEYTWORDNB);
              PUTRCVE(CHARPTR); 
              C<12-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
              C<12,2>FMAWS = "00";
              RECEIVE = DEC(KEYTBCP); 
              PUTRCVE(CHARPTR); 
              C<14-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
              C<14,3>FMAWS = "000"; 
              RECEIVE = DEC(KEYTKL);
              PUTRCVE(CHARPTR); 
              C<17-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
              C<34, 7>FMAWS = "0000000";
              RECEIVE = DEC(KEYTKG);
              PUTRCVE(CHARPTR); 
              C<41-CHARPTR, CHARPTR>FMAWS = C<0, CHARPTR>RECEIVE; 
              C<41, 7>FMAWS = "0000000";
              RECEIVE = DEC(KEYTKC);
              PUTRCVE(CHARPTR); 
              C<48-CHARPTR, CHARPTR>FMAWS = C<0, CHARPTR>RECEIVE; 
              IF C<41, 7>FMAWS NQ "0000000" THEN
                C<33, 1>FMAWS = "T";
              ELSE
                C<33, 1>FMAWS = "F";
              C<17, 1>FMAWS = EMBEDDED; 
              RECEIVE = DEC(KEYINDEX);
              C<48, 5>FMAWS = "0000000";
              PUTRCVE(CHARPTR); 
              C<53-CHARPTR, CHARPTR>FMAWS = C<0, CHARPTR>RECEIVE; 
              IF KEYTKS EQ FITV$ASCEN THEN      #IF DUPLICATES# 
                C<18,15>FMAWS = "TPRIMARY KEY"; #ASCENDING# 
              IF KEYTKS EQ FITV$FIFO THEN       #IF DUPLICATES# 
                C<18,15>FMAWS = "T1STIN1STOUT"; #NOT ASCENDING# 
              IF KEYTKS EQ FITV$NODUPL THEN     #IF NO DUPLICATES#
                C<18,1>FMAWS = "F"; 
              IF KEYTSKOMIT EQ 1 THEN           #OMITTED SPECIFIED# 
                C<53,1>FMAWS = "T"; 
              ELSE C<53,1>FMAWS = "F";
              IF KEYTSPACES EQ 1 THEN           #OMITTED SPACES#
                C<54,1>FMAWS = "T"; 
              ELSE C<54,1>FMAWS = "F";
              IF KEYTZEROS EQ 1 THEN            #OMITTED ZEROS# 
                C<55,1>FMAWS = "T"; 
              ELSE C<55,1>FMAWS = "F";
              IF FMAKEYPLT NQ 0 THEN            #OMITTED LITERAL# 
                BEGIN 
                GETPLST (FMAKEYPLT, LOC(PLTSTRDATA)); 
                WDSINLIT = (KEYTLITLEN + 9) / 10; 
                FOR TEMP1 = 0 STEP 1 WHILE TEMP1 LS WDSINLIT DO 
                  C<56,10>FMAWS = C<0,10>PLTSTRDWORD [TEMP1]; 
                END 
              SVAUXIDX = AUXINDEX;
              SVAUXPTR = AUXPTR;
              AUXINDEX = FN$ALTKPTR [FNATPTR];
              FINDAUX (AUXALTKEYDN2); 
              IF AUXINDEX NQ 0 THEN 
                BEGIN 
                RECEIVE = DEC(AX$AKDN2DNAT [AUXPTR]); 
                PUTRCVE(CHARPTR); 
                C<92,5>FMAWS = "00000"; 
                C<97-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
                END 
              AUXINDEX = SVAUXIDX;
              AUXPTR = SVAUXPTR;
              PUTSQ(FMAFET, LOC(FMAWS), 140); 
              RETURN; 
              END 
            PROC DMPFMA;
             BEGIN
  
             C<0,140>FMAWS = " "; 
             C<0,3>FMAWS = "170"; #INDICATES 170 COMPILER#
             C<3,7>FMAWS = LFN; 
             FOR CHARPTR = 3 STEP 1 UNTIL 9 DO
               IF C<CHARPTR,1>FMAWS LS "A" THEN 
                 C<CHARPTR,1>FMAWS = " "; 
             C<34,7>FMAWS = "0000000";
             RECEIVE = DEC(FIT$MRL);
             PUTRCVE(CHARPTR);
             C<41-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE;
             C<41,7>FMAWS = "0000000";
             RECEIVE = DEC(FIT$MNR);
             PUTRCVE(CHARPTR);
             C<48-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE;
             C<48,7>FMAWS = "0000000";
             RECEIVE = DEC(FIT$MBL);
             PUTRCVE(CHARPTR);
             C<55-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE;
             C<55,7>FMAWS = "0000000";
             RECEIVE = DEC(FIT$MNB);
             PUTRCVE(CHARPTR);
             C<62-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE;
             C<62,2>FMAWS = FFO[FIT$FO];
             C<64,1>FMAWS = FRT[FIT$RT];
             C<99,5>FMAWS = "00000";    #ZERO OUT DEPENDING DNAT# 
             IF C<64,1>FMAWS EQ "R" THEN#IF RECORD TYPE R, MUST # 
               BEGIN                    #DUMP RECORD MARK CHARACTER#
               RECEIVE = DEC(FIT$RMK);
               PUTRCVE(CHARPTR);
               C<113-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
               END
             IF C<62,2>FMAWS EQ "IS" THEN#IF INDEXED SEQUENTIAL FILE,#
               BEGIN                     #MUST DUMP INDEX FILE NAME # 
               C<113,7>FMAWS = FIT$XN;
               FOR CHARPTR = 113 STEP 1 UNTIL 120 DO #DROP SPURIOUS#
                 IF C<CHARPTR,1>FMAWS LS "A" THEN #"@D", IF NECESSARY#
                   C<CHARPTR,1>FMAWS = " "; 
               RECEIVE = DEC(FIT$NL);       #INDEX LEVELS#
               PUTRCVE(CHARPTR);
               C<104,7>FMAWS = "0000000"; 
               C<111-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
               END
             IF C<64,1>FMAWS EQ "D" THEN#IF RECORD TYPE D, MUST DUMP# 
               BEGIN
               RECEIVE = DEC(FIT$LL);   #DEPENDING FIELD LENGTH#
               PUTRCVE(CHARPTR);
               C<120,3>FMAWS = "000"; 
               C<123-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
               RECEIVE = DEC(FIT$LP);   #DEPENDING FIELD POSITION#
               PUTRCVE(CHARPTR);
               C<123,7>FMAWS = "0000000"; 
               C<130-CHARPTR,CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
               IF FIT$SB EQ 1 THEN      #DEPENDING FIELD SIGNED#
                 C<130,1>FMAWS = "T"; 
               ELSE C<130,1>FMAWS = "F";
               IF FIT$C1 EQ 1 THEN      #DEPENDING FIELD COMP1# 
                 C<131,1>FMAWS = "T"; 
               ELSE C<131,1>FMAWS = "F";
               END
             C<65,1>FMAWS =FBT[FIT$BT]; 
             RECEIVE = DEC(FNATINDEX);
             C<97, 2>FMAWS = "00";
             PUTRCVE(CHARPTR);
             C<99-CHARPTR, CHARPTR>FMAWS = C<0,CHARPTR>RECEIVE; 
             PUTSQ(FMAFET, LOC(FMAWS), 140);
             RETURN;
             END; 
          CONTROL EJECT;
 #     BEGIN CRFIT MAIN PROCEDURE                                      #
  
          P<ZEROOUT> = LOC (FIT); 
          FOR INDEX = 0 STEP 1 UNTIL FITV$LFIT - 1 DO 
              ZEROITEM [INDEX] = 0;    #ZERO OUT FIT# 
          P<ZEROOUT> = LOC (COBFIT);
          FOR INDEX = 0 STEP 1 UNTIL FITV$CFLEN - 1 DO
              ZEROITEM [INDEX] = 0;    #ZERO OUT COBOL FIT# 
          P<ZEROOUT> = LOC(COBFITXTWD); 
          FOR INDEX = 0 STEP 1 UNTIL COBFITXTWDLE  DO 
              ZEROITEM [INDEX] = 0; 
          FNATPTR = VIRTUAL (TABLETYPE "FNAT$", FNATINDEX);  #SET PTR#
          IF FN$ABORT [FNATPTR] EQ 1
          THEN
              RETURN;    # DO NOT PROCESS FNAT IF IT IS BAD#
         CONTROL IFNQ CB5$CDCS,"NO";
          IF FN$SSRELATN[FNATPTR] EQ 1     #IF A CDCS -RELATION-# 
          THEN
              BEGIN 
              CDCSREL;       #CHECK CDCS RELATION QUALIFIERS# 
              RETURN; 
              END 
         CONTROL FI;
          CRECOFFSET = WORK2RECOFF [VIRTUAL (TABLETYPE "WORK2$",
              FN$SMSECNO [FNATPTR])];  #RECORD OFFSET#
         LFN = FN$LFN [FNATPTR];
          IF FN$EXTERNAL[FNATPTR] EQ 1
          THEN BEGIN
             BLOCKNUMBER = FN$BLOCKNBR [FNATPTR] ;
             CURRFNATOFF = FN$RECOFF [FNATPTR]; 
             OUTPUTUSE (FALSE); 
             EXTFLAG = TRUE;
             END
         ELSE 
             BEGIN
             IF EXTFLAG 
             THEN 
                    BEGIN   # EXT FILE WAS LAST - REDEFINE STUFF# 
                    EXTFLAG = FALSE;
                    BLOCKNUMBER = FITBLOCK; 
                    OUTPUTUSE (FALSE);
                    CURRFNATOFF = LASTNEOFF;
                    END 
             END
          DNATPTR = VIRTUAL (TABLETYPE"DNAT$", FN$DNATPTR [FNATPTR]); 
          DN$WORDOFF [DNATPTR] = CURRFNATOFF;  #SET OFFSET IN DNAT# 
          DN$SUBMSEC [DNATPTR] = BLOCKNUMBER;  #SUB M-SEC TO FIT# 
          KEYINDEX = 0; 
  
 #     SET FIELDS IN REGULAR FIT                                       #
  
          FIT$LFN = LFN;
          FILEORG = FN$ORG [FNATPTR]; 
 #     COMMON PROCESSING                                               #
 #       DEFAULTS                                                      #
          FIT$BT = DEFAULTBT; 
          FIT$CM = DEFAULTCM; 
          RECTYPE = DEFAULTRT;
          FIT$RMK = DEFAULTRMK; 
  
 #       MISCELLANEOUS FIELDS                                          #
          FIT$CDST = DN$ANTYPE  [VIRTUAL (TABLETYPE "DNAT$",
              FN$CODEPTR [FNATPTR])];    # SET CODE SET TYPE #
          IF FIT$CDST EQ ANUNI
          THEN
              BEGIN   # UNIVAC CODE-SET SELECTED - LOAD ROUTINES #
              GENLDSET (LDSETVAL"USE", "C.XTAB"); 
              GENLDSET (LDSETVAL"USE", "C.UNICY");
              END 
CONTROL IFNQ CB5$CDCS,"NO"; 
          IF FN$SSCHEMA [FNATPTR] NQ 1
          THEN
              FIT$LNG = FITV$CBL; 
CONTROL FI; 
CONTROL IFEQ CB5$CDCS,"NO"; 
          FIT$LNG = FITV$CBL; 
CONTROL FI; 
 #       MAX RECORD LENGTH AND BLOCK SIZES                             #
         MAXRECL = FN$RCTMAX [FNATPTR]; 
         MINRECL = FN$RCTMIN [FNATPTR]; 
         IF MAXRECL EQ 0
         THEN 
             MAXRECL = FN$ACCUMMAX [FNATPTR]; 
         IF MINRECL EQ 0
         THEN 
             MINRECL = FN$ACCUMMIN [FNATPTR];  # MIN NOT GIVEN #
         IF FIT$CDST EQ ANASC64 OR
            FIT$CDST EQ ANSTANDARD1 OR
            FIT$CDST EQ ANEBCDIC
         THEN 
             BEGIN  #DOUBLE RECORD SIZE AND LOAD ROUTINES FOR ASCII-64# 
             MAXRECL = MAXRECL + MAXRECL;           #AND EBCDIC FILES#
              GENLDSET (LDSETVAL"USE", "C.6TO12");
              GENLDSET (LDSETVAL"USE", "C.12TO6");
             END
          BCTMAX = FN$BCTMAX [FNATPTR]; 
          BCTMIN = FN$BCTMIN [FNATPTR]; 
          FIT$MRL [0] = MAXRECL;
          FIT$MNR [0] = MINRECL;
          FIT$RLWD [0] = (MAXRECL + 9) / 10;   #SIZE OF REC IN WORDS# 
          IF FN$BLKCTREC [FNATPTR] EQ 1 
          THEN
              BEGIN 
              FIT$RB = BCTMAX;
              FIT$BCTC = FITV$YES;   #SET THAT BLK CONT SPECIFIED#
              IF BCTMAX EQ BCTMIN  #TRUE IF NOT BLC CNT X TO Y# 
              OR BCTMIN EQ 0
              THEN
                  FIT$BT = FITV$KT;    #K BLOCKS# 
              ELSE
                  FIT$BT = FITV$ET;    #E BLOCKS# 
              END 
          ELSE
              BEGIN 
              FIT$MBL = BCTMAX; 
              IF FILEORG EQ SEQUENTIAL
              THEN
                  FIT$MNB = BCTMIN; 
              FIT$BT = FITV$ET;    #ASSUME E TYPE BLOCKING# 
              IF BCTMAX EQ 0
              THEN
                  BEGIN      #NO BLOCK CLAUSE - RB = 1, BT = K# 
                  FIT$BT = FITV$KT; 
                  FIT$RB = DEFAULTRB [FILEORG];  #SET TO DEFAULT# 
                  END 
              ELSE
                  FIT$BCTC = FITV$YES;   #SET THAT BLOCK CONT SPECIFIED#
              END 
 #     LABEL TYPE#
          IF FN$LABELREC [FNATPTR] EQ STANDARD
          THEN
              BEGIN 
              FIT$LT = FITV$S;     #SET STD LABELS# 
              FIT$ULP = FITV$FP;   #SET LABEL PROCESSING TO FILE# 
              END 
          ELSE
              BEGIN 
              FIT$LT = FITV$UL;    #SET AS UNLABELED IF NOT STD#
              FIT$ULP = FITV$NOP;  #SET NO LABEL PROCESSING#
              END 
          FIT$LABT [0] = FITV$UL; 
          IF FN$OPTIONAL [FNATPTR] EQ 1 
          THEN
              FIT$OPFL [0] = FITV$YES;
          ELSE
              FIT$OPFL [0] = FITV$NO; 
          FIT$RERP = FN$RRUNREC [FNATPTR];
          TEMP = FN$RESAREA [FNATPTR];
          IF TEMP EQ 0
          THEN
               TEMP = DEFAULTAREA [FILEORG];
          FIT$REAR = TEMP;
          FSTATPTR = FN$STATPTR [FNATPTR];  #FILE STATUS DNAT INDEX#
          IF FSTATPTR NQ 0
          THEN
              BEGIN 
 #     GET BYTE OFFSET FROM DNAT TO COMPUTE FILE STAT STUFF            #
              OFFSET = DN$CHARPOS [VIRTUAL (TABLETYPE "DNAT$",
                  FSTATPTR)]; 
              FIT$FSSC [0] = 48 - (6 * OFFSET);  #SHIFT COUNT#
              IF OFFSET EQ 9
              THEN
                  FIT$FSSC [0] = 54;  #USE 54 IF CROSS WORD BOUND#
              END 
  
 #     RECORD TYPE PROCESS                                             #
  
          VARTYPE = FN$VARTYPE [FNATPTR]; 
          VARPTR = FN$RCDEPPTR [FNATPTR]; 
          IF VARPTR EQ 0
          THEN
              BEGIN          # NO RECORD CONTAINS DEPENDING ON #
              IF FN$RCTMAX [FNATPTR] NQ 0 
              AND (FN$RCTMIN [FNATPTR] EQ 0 
                  OR FN$RCTMIN [FNATPTR] EQ FN$RCTMAX [FNATPTR])
              THEN                           # REC CONT NN SPECIFIED #
                  RECTYPE = FITV$FT;             # F - FIXED LEN #
              ELSE
                  BEGIN      # NO REC CONTAINS OR MIN NQ MAX #
                  IF VARTYPE EQ FNML
                  OR VARTYPE EQ FNVGMS
                  THEN
                      RECTYPE = FITV$WT;         # W - CONTROL WORD # 
                  ELSE
                      BEGIN 
                      IF VARTYPE EQ FNVGSS
                      THEN
                          BEGIN 
                          RECTYPE = FITV$TT;     # T - TRAILERS # 
                          DNATPTR = VIRTUAL (TABLETYPE "DNAT$", 
                              FN$FRECPTR [FNATPTR]);
                          AUXINDEX = DN$AUXREF [DNATPTR]; 
                          FINDAUX (SUBOCCDEP);
                          VARPTR = AX$DEPNAM [AUXPTR];
                          IF INREC (VARPTR) 
                          THEN
                              BEGIN # COUNT FIELD IS IN RECORD #
                              DNATPTR = VIRTUAL(TABLETYPE"DNAT$", 
                                AX$OCCNAM [AUXPTR]);
                              FIT$TL = DN$ITMLEN [DNATPTR]; 
                              GETBCPANDWN;
                              FIT$HL = CHAROFFSET;
                              END 
                          ELSE
                              RECTYPE = FITV$WT;  # NOT IN REC - IS W # 
                          END 
                      ELSE
                          BEGIN 
                          IF FN$RCTMIN [FNATPTR] EQ 0 
                          AND FN$RCTMAX [FNATPTR] EQ 0
                          THEN               # REC CONT NOT SPECIFIED  #
                              RECTYPE = FITV$FT; # F - FIXED #
                          ELSE               # REC CONT NN TO MM SPEC  #
                              RECTYPE = FITV$WT; # W - CONTROL WORD # 
                          END 
                      END 
                  END 
              END 
          ELSE
                  BEGIN                      # REC CONT DEP ON SPEC # 
                  FIT$MNR = FN$RCTMIN [FNATPTR];
                  FIT$MRL = FN$RCTMAX [FNATPTR];
                  IF NOT INREC (VARPTR) 
                  THEN                         # DN NOT IN REC #
                      RECTYPE = FITV$WT;         # W - CONTROL WORD # 
                  ELSE                         # DN IN REC #
                      RECTYPE = FITV$DT;         # D - DEC COUNT #
                  END 
          IF RECTYPE EQ FITV$DT 
          OR RECTYPE EQ FITV$TT 
          THEN
              BEGIN 
              DNATPTR = VIRTUAL (TABLETYPE "DNAT$", VARPTR);
              FIT$CL = DN$ITMLEN [DNATPTR]; 
              GETBCPANDWN;
              FIT$CP = CHAROFFSET;
              IF DN$TYPE [DNATPTR] EQ COMP1 
              THEN
                  BEGIN 
                  FIT$CL = 6;  #SET COUNT FIELD TO 6, NOT 10# 
                  FIT$CP = FIT$CP + 4;  #ADJUST BCP ACCORDINGLY#
                  FIT$C1 = FITV$YES;
                  END 
              ELSE
                  BEGIN 
                  IF DN$TYPE [DNATPTR] EQ COMP4 
                  THEN
                      FIT$C1 = FITV$YES;
                  END 
              END 
  
 #
       DECLARATIVES PROCESSING
 #
          DECLCT = 1; 
          FOR I = 1 STEP 1 UNTIL CCTDCLUPPBND DO
              BEGIN 
              PNATPTR = VIRTUAL (TABLETYPE"PNAT$", I);
              IF PN$PROCKIND [PNATPTR] EQ 1 
              AND PN$DECLARATV [PNATPTR] EQ 1 
              THEN
                  BEGIN   #FOUND A DECLARATIVE SECTION - SET FIT PTR# 
                  DECLFND1 = FALSE; 
                  AUXINDEX = PN$AUXREF [PNATPTR]; 
                  FOR AUXINDEX = AUXINDEX WHILE AUXINDEX NQ 0 DO
                      BEGIN 
                      AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
                      TEMP = AX$TTYPE [AUXPTR]; 
                      DECLFND2 = TRUE;
                      IF TEMP EQ AUXINPUTDCL
                      THEN
                          FIT$USOI = DECLCT;   #USE ON INPUT# 
                      ELSE
                          IF TEMP EQ AUXOUTPUTDCL 
                          THEN
                              FIT$USOO = DECLCT;  #USE ON OUTPUT# 
                          ELSE
                              IF TEMP EQ AUXIODCL 
                              THEN
                                  FIT$USOM = DECLCT;  #USE ON I-O#
                              ELSE
                                  IF TEMP EQ AUXEXTENDDCL 
                                  THEN
                                      FIT$USOE = DECLCT;  #USE EXTEND#
                                  ELSE
                                      IF TEMP EQ AUXFILEDCL 
                                      THEN
                                          BEGIN 
                                          IF AX$FDPTR [AUXPTR] EQ 
                                              FN$DNATPTR [FNATPTR]
                                          THEN
                                              FIT$USFN = DECLCT;
                                          END 
                                      ELSE
                                          IF TEMP EQ AUXHASH
                                          THEN
                                              BEGIN 
                                              IF AX$FDPTR [AUXPTR] EQ 
                                              FN$DNATPTR [FNATPTR]
                                              THEN
                                                  FIT$USHA = DECLCT;
                                              END 
                                         CONTROL IFEQ CB5$CDCS,"CDCS2"; 
                                          ELSE
                                            IF TEMP EQ AUXREALMS
                                            THEN
                                              FIT$USDL = DECLCT;
                                            ELSE
                                              IF TEMP EQ AUXREALMNAME 
                                              THEN
                                                BEGIN 
                                                IF AX$FDPTR [AUXPTR] EQ 
                                                  FN$DNATPTR [FNATPTR]
                                                THEN
                                                  FIT$USDL = DECLCT;
                                                END 
                                         CONTROL FI;
                                              ELSE
                                              DECLFND2 = FALSE; 
                      AUXINDEX = AX$TNEXTPTR [AUXPTR];
                      IF DECLFND2 
                      THEN
                          DECLFND1 = TRUE;
                      END 
                  IF DECLFND1 
                  THEN
                      DECLCT = DECLCT + 1;  #FOUND I-O DECL - BMP CT# 
                  END 
              END 
          DECLCT = DECLCT - 1;   #GIVE ACTUAL COUNT OF DECL FOR I-O#
  
 #     FILE SPECIFIC FIELDS                                            #
  
          EXTWORDS = 1;   #DEFAULT EXTRA WORDS# 
          GOTO FILEORGS [FILEORG];
 #
       ERROR - SHOULD NOT GO HERE 
 #
 FOERR: 
          $BEGIN
          PRINTVAL (3, "PROCTAB", FNATINDEX); 
          $END
          GOTO FOSQ;   #TREAT IT AS A SEQ FILE# 
  
 #
       ACTUAL KEY 
 #
 FOAK:  
          FIT$FO = FITV$AK; 
          KEYINDEX = FN$RECPTR [FNATPTR]; 
          FILETYPE = S"ISAKDA"; 
          CONTROL IFEQ CB5$AKOLDNEW,"NEW";
          FIT$ORG = FITV$NEW;    # SET ORG TO NEW FORMAT #
          CONTROL FI; 
          CONTROL IFNQ CB5$AKOLDNEW,"NEW";
          FIT$ORG = FITV$OLD;      #DEFAULT TO OLD AK ORG#
          CONTROL FI; 
          GOTO FIXKEYS; 
 #
       DIRECT 
 #
 FODA:  
          FIT$FO = FITV$DA; 
          KEYINDEX = FN$RECPTR [FNATPTR]; 
          FILETYPE = S"ISAKDA"; 
          CONTROL IFEQ CB5$DAOLDNEW,"NEW";
          FIT$ORG = FITV$NEW;    # SET ORG TO NEW FORMAT #
          CONTROL FI; 
          CONTROL IFNQ CB5$DAOLDNEW,"NEW";
          FIT$ORG = FITV$OLD;      #DEFAULT TO OLD DA ORG#
          CONTROL FI; 
          GOTO FIXKEYS; 
 #
       INDEXED
 #
 FOIS:  
          FIT$FO = FITV$IS; 
          KEYINDEX = FN$RECPTR [FNATPTR]; 
          FILETYPE = S"ISAKDA"; 
          CONTROL IFEQ CB5$ISOLDNEW,"NEW";    #CHECK FOR OLD OR NEW IS #
          FIT$ORG = FITV$NEW; 
          CONTROL FI; 
          CONTROL IFNQ CB5$ISOLDNEW,"NEW";
          FIT$ORG = FITV$OLD; 
          CONTROL FI; 
          GOTO FIXKEYS; 
 #
       RELATIVE 
 #
 FORL:  
          FIT$FO = FITV$WA;   #SET FILE ORG TO WORD ADDRESS#
          FIT$RLWD = FIT$RLWD + 1;   #BUMP BY 1 FOR RECORD KEY# 
          EXTWORDS = RELXTWDS;   #NUMBER OF EXTRA FIT WORDS#
          FIT$RLFG = FITV$YES;  # SET AS RELATIVE FILE #
          IF FIT$RLWD GR 5
          THEN
              FIT$MRL = FIT$RLWD * 10;   #MAX REC SIZE# 
          ELSE
              FIT$MRL = 50;    #SIZE OF VERSION 4 HEADER# 
          RECTYPE = FITV$UT;   #SET U TYPE RECORDS# 
          FILETYPE = S"RLWA"; 
          GOTO CALCWABFS; 
  
 #     SEQUENTIAL                                                      #
  
 FOSQ:  
 #     SEQUENTIAL DEFAULTS #
          FIT$PC = DEFAULTPC; 
  
 #     TEST FOR SYSTEM FILES #
          ITEM LFNOUTPUT I = O"17252420252400000000"; 
          ITEM LFNINPUT  I = O"11162025240000000000"; 
          ITEM LFNPUNCH  I = O"20251603100000000000"; 
          ITEM LFNPUNCHB I = O"20251603100200000000"; 
          TEMP = 0; 
          B<0,42> TEMP = B<0,42> LFN; 
          IF TEMP EQ LFNOUTPUT
          OR TEMP EQ LFNINPUT 
          OR TEMP EQ LFNPUNCH 
          OR TEMP EQ LFNPUNCHB
          OR FN$RPTPTR [FNATPTR] NQ 0  #REPORT FILES ARE C-Z, TOO#
          THEN
              BEGIN 
              RECTYPE = FITV$ZT;
              FIT$BT [0] = FITV$CT;   #BT = C AND RT = Z FOR SYSTEM FLS#
              END 
          FIT$FO = FITV$SQ; 
          IF FN$RECMODE [FNATPTR] EQ BINMODE
              THEN
                  FIT$CM [0] = FITV$NO;   #NO CONVERSION# 
              ELSE
                  FIT$CM = FITV$YES;   #CONVERSION - SEQUENTIAL DEFAULT#
          IF FN$RPTPTR [FNATPTR] NQ 0 
          THEN
              BEGIN   #REPORTS ARE PRESENT# 
              AUXINDEX = DN$AUXREF [VIRTUAL (TABLETYPE "DNAT$", 
                  FN$FRECPTR [FNATPTR])]; 
              FINDAUX (FILENAME);   #GET FILE AUX FOR REP REC#
              IF AX$CODECL [AUXPTR] EQ 1
              THEN
                  XWD$RWCD = 1;   #THERE IS A CODE CLAUSE - SET FLAG# 
              END 
          FIT$FF = FITV$YES;  # SET FLUSH FLAG - OS WILL FLUSH BUFF # 
 #     IF LINES AT TOP OR BOTTOM ARE GIVEN, NO CARRIAGE CONTROL USED   #
          IF FN$TOPLIT [FNATPTR] NQ 0 
          OR FN$TOPPTR [FNATPTR] NQ 0 
          OR FN$BOTTLIT [FNATPTR] NQ 0
          OR FN$BOTTPTR [FNATPTR] NQ 0
          THEN
              XWD$LITB = FITV$YES;   #SET FLAG FOR LINES AT TOP OR BOT# 
          FILETYPE = S"SQ"; 
          GOTO TRYUSE;
 #
       WORD ADDRESS 
 #
 FOWA:  
          RECTYPE = FITV$UT;    #ALWAYS U TYPE RECORDS# 
          FIT$FO = FITV$WA; 
          FILETYPE = S"RLWA"; 
 CALCWABFS: 
 #     COMPUTE BUFFER SIZE FOR WA AND RELATIVE FILES                   #
          TEMP = (FIT$MRL - 1) / 640;   #NBR PRUS - 1 IN MAX RECORD # 
          FIT$BFS = (FIT$REAR + TEMP) * 64 + 2 ;
          GOTO SETPM; 
 #
       FIX UP KEYS FOR LATER PROCESS
 #
 FIXKEYS: 
          IF KEYINREC ((KEYINDEX)) EQ 0 
          THEN
              BEGIN   # KEY NOT IN RECORD # 
              FIT$EMK = 0;   # SET AS NON-EMBEDDED KEY #
                EMBEDDED = "F"; 
              END 
          ELSE
              BEGIN 
              FIT$EMK = 1;   # SET AS EMBEDDED KEY #
                EMBEDDED = "T"; 
              END 
          AUXINDEX = FN$ALTKPTR [FNATPTR];
CONTROL IFEQ CB5$CDCS,"NO"; 
          IF AUXINDEX EQ 0
          THEN
              FIT$MINF = FITV$NO; 
          ELSE
 #     MULT INDEXED FILE PROCESS                                       #
              BEGIN 
 #     GET ALT INDEX FILE NAME                                         #
              BLOCKNAME = GETLFN (FN$2DPLTPTR [FNATPTR]); 
              FIT$MINF = FITV$YES;
              FIT$XN = BLOCKNAME; 
              END 
CONTROL FI; 
CONTROL IFNQ CB5$CDCS,"NO"; 
          IF AUXINDEX EQ 0 AND FN$SSMIPFIL [FNATPTR] EQ 0 
          THEN
             FIT$MINF = FITV$NO;
          ELSE
    #  MULTIPLE-INDEXED FILE PROCESSING          #
             BEGIN
             BLOCKNAME = GETLFN (FN$2DPLTPTR [FNATPTR]);
             FIT$MINF = FITV$YES; 
             FIT$XN = BLOCKNAME;
             END
CONTROL FI; 
 #
       SET PROCESSING MODE
 #
 SETPM: 
              IF FN$ACCESS [FNATPTR] EQ SEQACCESS 
          AND FILETYPE NQ S"ISAKDA" 
              THEN
                  FIT$PM [0] = FITV$SPM;
              ELSE
                  FIT$PM [0] = FITV$RPM;
  
 #     PROCESS THE USE DATA IF THERE IS ANY                            #
 TRYUSE:  
          PLTINDEX = FN$USLITPTR [FNATPTR]; 
          IF PLTINDEX NQ 0
          THEN
              PROCUSE (TRUE);   #GO PROCESS USE LITERAL#
          IF FN$PRINTF [FNATPTR] EQ 1 
          THEN
              BEGIN 
              FIT$BT = FITV$CT;     #SET BT TO C AND RT TO Z# 
              RECTYPE = FITV$ZT;
              END 
 #     PROCESS THE MULTI-FILE NAME IF ANY                              #
          IF FN$MFILPOS[FNATPTR] NQ 0 
          THEN
              BEGIN 
              FIT$PNO = FN$MFILPOS [FNATPTR]; 
              IF CCTOSISNOS 
              THEN   # IF OPERATING SYSTEM IS NOS, MFN IS 1ST 6 CH LFN# 
                  FIT$MFN = C<0,6>FIT$LFN;
              ELSE
                  BEGIN  #IF NOS/BE, IS IN FILE-SET-ID OF LABEL # 
                  IF FN$LABLLIT2 [FNATPTR] EQ 1 
                  THEN
                      BEGIN 
                      FIT$MFN = GETLFN (FN$LABLPTR2[FNATPTR]);
                      END 
                  ELSE
                      FIT$MFN = "      ";  # F-S-ID IS DN - MFN UNKNOWN#
                  END 
              END 
 #
      IF CODESET CLAUSE IS ASCII-64, EBCDIC, OR STANDARD-1 THEN THE FIT 
      MUST BE SET FOR F TYPE RECORDS AND C TYPE BLOCKS
      IF THEY ARE NOT ISSUE W DIAGNOSTICS AND FORCE THEM TO BE
                                                                      # 
          IF FIT$CDST NQ 0
          THEN
              BEGIN 
              IF FIT$CDST EQ ANASC64 OR 
                 FIT$CDST EQ ANEBCDIC OR
                 FIT$CDST EQ ANSTANDARD1
              THEN
                  BEGIN 
                  IF RECTYPE NQ FITV$FT 
                  THEN
                       BEGIN
                       RECTYPE = FITV$FT;   #FORCE RECORD TYPE TO F # 
                      PRINTDIAG(D014,FN$DNATPTR[FNATPTR]);
                       END
                  IF FIT$BT NQ FITV$CT
                  THEN
                       BEGIN
                       FIT$BT = FITV$CT;   #FORCE BLOCK TYPE TO C # 
                      PRINTDIAG(D015,FN$DNATPTR[FNATPTR]);
                       END
                  END 
              END 
         IF RECTYPE EQ FITV$FT
         THEN 
             BEGIN
             IF (FN$ACCUMMAX[FNATPTR] LS 10)
             THEN 
                 BEGIN
                 PRINTDIAG(D017,FN$DNATPTR[FNATPTR]); 
                 END
             END
 #     PUT RECORD TYPE INTO FIT  #
          FIT$RT = RECTYPE; 
          FN$RECTYPE[FNATPTR]=RECTYPE;
 #     PROCESS ANY ITEMS WHICH DEPEND ON THINGS WHICH MAY BE SET BY USE#
  
 #         CONVERSION MODE DEPENDS ON RECORD TYPE W OR BLOCK TYPE I    #
  
          IF RECTYPE EQ FITV$WT 
          OR FIT$BT EQ FITV$IT
          THEN
              BEGIN 
              IF FN$RECMODE [FNATPTR] EQ DECMODE
              THEN
                 # ERROR - USER SAID DECIMAL BUT MUST BE BINARY # 
                  PRINTDIAG(D016,FN$DNATPTR[FNATPTR]);
              FIT$CM = FITV$NO; 
              END 
  
 #         MBL DEPENDS ON BT AND RT (IF W OR Z RECORDS)                #
  
          IF RECTYPE EQ FITV$WT 
          THEN
 #     FOR W RECS, SIZE INCLUDES CONTROL WORD AND IS ROUNDED TO WORDS  #
              TEMP = (FIT$RLWD + 1) * 10;  #REC INCLUDES CTL WORD#
          ELSE
              IF RECTYPE EQ FITV$ZT 
              THEN
 #     FOR Z RECORDS, SIZE IS ONE EXTRA WORD IF ECP = 9 OR 10          #
                  TEMP = ((MAXRECL + 11) / 10) * 10;
              ELSE
                  IF RECTYPE EQ FITV$ST 
                  THEN
 #     FOR S RECORDS SIZE IS A MULT OF WORDS                           #
                      TEMP = FIT$RLWD * 10; 
                  ELSE
                      TEMP = MAXRECL;   #FOR ALL OTHER RTS, SIZE IS MAX#
          IF FIT$MBL EQ 0 
          AND FILEORG EQ SEQUENTIAL 
          THEN
              BEGIN 
 #     BLOCK CONTAINS NN CHARS NOT GIVEN FOR SQ FO (BT = K)            #
              IF FIT$BT EQ FITV$KT
              THEN   # K BLOCKS - SIZE IS REC SIZE TIMES RECS / BLOCK # 
                  BEGIN 
                  FIT$MBL = TEMP * FIT$RB;
                  FIT$MNB = MINRECL * FIT$RB; 
                  END 
              ELSE
                  BEGIN 
                  IF FIT$BT EQ FITV$ET
                  THEN
                      BEGIN   #E BLOCKS - MAX AND MIN AS SHOWN# 
                      FIT$MBL = TEMP * FIT$RB;
                      FIT$MNB = MINRECL * BCTMIN; 
                      END 
                  END 
              END 
 #     PROCESS ANY ITEMS DEPENDENT ON FILE TYPE  #
  
 #       SET LABELS TO UNDEFINED IF NOT A SEQUENTIAL FILE # 
          IF FILETYPE NQ S"SQ"
          THEN
              FIT$LT = FITV$UL; 
          CONTROL IFNQ CB5$CDCS,"NO"; 
 #     FILL IN THE CDCS-RELATED FIELDS                                 #
          IF FN$SSCHEMA[FNATPTR] NQ 0  #IF CDCS I/O FILE# 
          THEN
              BEGIN 
              FIT$DBFO = FN$AREAORD[FNATPTR];  #AREA (FILE) ORDINAL#
              IF FIT$FO NQ FITV$SQ  #IF RANDOM FILE#
              THEN
                  BEGIN 
                  CONTROL IFEQ CB5$CDCS,"CDCS1";
                  FIT$ORG = FITV$OLD;  # ORG = OLD FOR CDCS1 FILES #
                  CONTROL FI; 
                  FIT$DBKO = FN$RKEYORD[FNATPTR];  #PRIME KEY ORDINAL#
                  DNATPTR = VIRTUAL(TABLETYPE"DNAT$", KEYINDEX);
                  FINDRORD;  #FIND ORDINAL OF RECORD CONTAINING KEY#
                  FIT$DBRO = KEYTRORD;  #RECORD ORDINAL#
                  KEYTRORD = 0;  #FOR SUBSEQUENT ALT KEY CALCULATIONS#
                  END 
              END 
          CONTROL FI; 
 #     DUMP OUT THE FIT                                                #
#  IF DUMP REQUIRED FOR FMA, DO IT NOW #
                IF CCTDUMPDATA THEN 
                  DMPFMA; 
  
          IF CCTSUBPROGR
          AND NOT CCTMAINSUB
          AND FN$EXTERNAL [FNATPTR] EQ 1
          THEN
 #     IF AN EXTERNAL FILE IN A SUBPROGRAM, DO NOT GEN FIT - GEN SPACE #
              BEGIN 
              TEMP = FITV$TLFIT + FITV$CFLEN + EXTWORDS;
              OUTPUTBSS (TEMP);  # GEN SPACE FOR FITS ET AL # 
              IF FN$LINAGPTR [FNATPTR] NQ 0 
              THEN
                  GENLINTB;  # SPACE FOR LINAGE TABLE # 
              IF FIT$LT EQ FITV$S 
              THEN
                  GENLABT;   # SPACE FOR LABEL TABLE #
              IF KEYINDEX NQ 0
              THEN
                  BEGIN  # GEN BSS FOR KEY TABLE #
                  OUTPUTBSS (4);  # 2 FOR PRIMARY KEY, 2 TERMINATOR # 
                  AUXINDEX = FN$ALTKPTR [FNATPTR];
                  FOR AUXINDEX = AUXINDEX WHILE AUXINDEX NQ 0 DO
                      BEGIN  # MORE FOR EACH ALT KEY #
                      FINDAUX (ALTKEYNAME); 
                      IF AUXINDEX NQ 0
                      THEN
                          BEGIN 
                          OUTPUTBSS (2);
                          AUXINDEX = AX$TNEXTPTR [AUXPTR];
                          END 
                      END 
                  AUXINDEX = FN$ALTKPTR [FNATPTR];
                  FINDAUX (AUXALTKEYDN2); 
                  IF AUXINDEX NQ 0
                  THEN
                      OUTPUTBSS (2);  # TWO MORE FOR SPARSE KEY WDS # 
                  END 
              RETURN; 
              END 
          NOGENFLAG = FALSE;   #SET TO GENERATE CODE# 
          P<ZEROOUT> = LOC (FIT); 
          FOR INDEX = 0 STEP 1 UNTIL FITV$TLFIT - 1 DO
              BEGIN 
              IF INDEX EQ 20
              AND KEYINDEX NQ 0 
              THEN
 #     RELOCATE PKA - PRIME KEY ADDRESS                                #
                  BEGIN 
                  RELOCLOWER (ZEROITEM [INDEX], KEYINDEX, 
                      TABLETYPE"DNAT$");
                  TEST; 
                  END 
              OUTPUTDATA (ZEROITEM [INDEX]);
              END 
          P<ZEROOUT> = LOC (COBFIT);
          FOR INDEX = 0 STEP 1 UNTIL FITV$CFLEN - 1 DO
              BEGIN 
              IF INDEX EQ 0 
              THEN
                  BEGIN 
 #     RELOCATE WSA POINTER     # 
                  WSALABEL = WORK2RECLAB [VIRTUAL (TABLETYPE "WORK2$",
                      FN$SMSECNO [FNATPTR])];  #REC AREA LABEL# 
                  RELOCLOWER (ZEROITEM [INDEX], WSALABEL, TABLETYPE 
                      "LOCAL$");
                  TEST; 
                  END 
          IF INDEX EQ 1 
          AND FIT$LT EQ FITV$S
          THEN
              BEGIN 
              LABELPTR = NEXTLABEL; 
 #     RELOCATE LVOT (LABEL VALUE OF TABLE POINTER                     #
              RELOCLOWER (ZEROITEM [INDEX], LABELPTR, TABLETYPE 
                  "LOCAL$");
              TEST; 
              END 
              IF INDEX EQ 3 
              AND FSTATPTR NQ 0 
              THEN
                  BEGIN 
 #     RELOCATE FILE-STATUS POINTER                                    #
                  RELOCLOWER (ZEROITEM [INDEX], FSTATPTR, 
                      TABLETYPE "DNAT$"); 
                  TEST; 
                  END 
              IF INDEX EQ 4 
              THEN
                  BEGIN 
 #     RELOCATE CLOA (CLOSE ROUTINE ADDRESS)                           #
 #     THIS IS DONE IN FIT TO FORCE LOADING IN 0,0 OVERLAY             #
                  TEMP1 = FOEQOBJDEF [FILEORG] + CBCLOAK; 
                  RELOCLOWER (ZEROITEM [INDEX], TEMP1, TABLETYPE"OBJ$");
                  TEST; 
                  END 
              OUTPUTDATA (ZEROITEM [INDEX]);
              END 
  
 #     OUTPUT FILE SPECIFIC STUFF                                      #
  
          P<ZEROOUT> = LOC (COBFITXTWD);
          FOR INDEX = 0 STEP 1 UNTIL EXTWORDS - 1 DO
              BEGIN 
              IF INDEX EQ 0 
              THEN
                  BEGIN 
                  IF FN$LINAGPTR [FNATPTR] NQ 0 
                  THEN
                      BEGIN  #RELOCATE LINAGE TABLE POINTER # 
                      LINLABEL = NEXTLABEL; 
                      RELOCLOWER (ZEROITEM [INDEX], LINLABEL, 
                          TABLETYPE"LOCAL$"); 
                      TEST; 
                      END 
                  ELSE
                      IF KEYINDEX NQ 0
                      THEN
                          BEGIN 
                          KEYLABEL = NEXTLABEL; 
 #     RELOCATE KEY TABLE POINTER - KEYT #
                          RELOCLOWER (ZEROITEM [INDEX], KEYLABEL, 
                              TABLETYPE"LOCAL$"); 
                          TEST; 
                          END 
                  END 
              OUTPUTDATA (ZEROITEM [INDEX]); #NOT RELOCATABLE - OP IT#
              END 
 #     COMPUTE SIZE SO FAR AND BUMP OFFSET BY IT# 
          CURRFNATOFF = FITV$LFIT + FITV$LFET + FITV$CFLEN + EXTWORDS 
              + CURRFNATOFF;
          IF FN$LINAGPTR [FNATPTR] NQ 0 
          THEN
              GENLINTB;    #GENERATE LINAGE TABLE IF LINAGE PRESENT#
          IF FIT$LT EQ FITV$S 
          THEN
              GENLABT;     #GENERATE LABEL TABLE IF PRESENT#
          IF KEYINDEX NQ 0
          THEN
              BEGIN 
 #     PUT OUT THE KEY TABLE                                           #
              DEFLOCLAB (KEYLABEL);   #DEFINE LABEL#
              AUXINDEX = FN$ALTKPTR [FNATPTR];
              FIRSTKEY = TRUE;
              MAXKEYPOS = 1;   #MINIMUM CHARS IN REC IS 1#
              FOR AUXINDEX = AUXINDEX WHILE NOT (AUXINDEX EQ 0
              AND KEYINDEX EQ 0) DO 
                  BEGIN 
                  DNATPTR = VIRTUAL (TABLETYPE "DNAT$", KEYINDEX);
                  KEYTITEM = 0; 
                  KEYTITEM2 = 0;
                  LITPTR = 0; 
                  SVAUXIND = AUXINDEX;
                  GETBCPANDWN;
                  KEYTBCP = CHARPOS;
                  KEYTWORDNB = WORDOFFSET;
                  IF NOT KEYINRFLAG 
                  AND FIRSTKEY
                  THEN
                      BEGIN  # KEY NOT IN RECORD #
                      KEYTWORDNB = 0;   #WORD = 0#
                      KEYTBCP = DN$CHARPOS [DNATPTR]; 
                      END 
                  ELSE
                      BEGIN 
                      #  COMPUTE ENDING POSITION OF KEY # 
                      TEMP = CHAROFFSET + DN$ITMLEN [DNATPTR];
                      IF TEMP GR MAXKEYPOS
                      THEN
                          MAXKEYPOS = TEMP;  #NEW LAST KEY IN REC#
                      END 
                  KEYTYPE = DN$TYPE [DNATPTR];  #GET TYPE OF KEY# 
                  IF KEYTYPE GR LOWNUMRESULT
                  AND KEYTYPE LQ HINUMOPERND
                  THEN
                      BEGIN                      #KEY IS NUMERIC# 
                      IF KEYTYPE EQ COMP1 
                      OR KEYTYPE EQ COMP2 
                      THEN
                          BEGIN                  #KEY IS COMP-1 OR 2# 
                          IF FIRSTKEY 
                          THEN
                              KEYTKT = FITV$IKT;  #INTEGER - PRIME# 
                          ELSE
                              KEYTKT = FITV$AIKT; #INTEGER - ALT# 
                          KEYLENGTH = 10;        # SIZE ALWAYS 10 # 
                          END 
                      ELSE                       #NUMERIC NON COMP# 
                          BEGIN 
                          IF FIRSTKEY 
                          THEN
                              KEYTKT = FITV$UKT;  #UNCOLLATED - PRIME#
                          ELSE
                              KEYTKT = FITV$AUKT; #UNCOLLATED - ALT#
                          IF KEYTYPE EQ COMP4 
                          THEN
                              KEYLENGTH = DN$ITMLEN [DNATPTR];
                          ELSE
                              KEYLENGTH = DN$NUMLEN [DNATPTR];
                          END 
                      END 
                  ELSE                           #KEY IS NON-NUMERIC# 
                      BEGIN 
                      KEYLENGTH = DN$ITMLEN [DNATPTR];  #USE REG LEN# 
                      KEYTKT = FITV$SKT;         #USE SYMBOLIC KEY TYPE#
                      END 
                  IF FILEORG EQ ACTUAL$KEY
                  AND FIRSTKEY
                  THEN
                      #  AK PRIME KEY MUST BE ACTUAL CHARS #
                      BEGIN 
                      IF KEYTYPE EQ COMP4 
                      THEN
                          BEGIN 
                          KEYLENGTH = DN$ITMLEN [DNATPTR];
                          KEYTCOMP4 = 1;
                          END 
                      ELSE
                          BEGIN 
                          KEYTCOMP4 = 0;
                          KEYLENGTH = DN$NUMLEN [DNATPTR];
                          END 
                      END 
                  IF NOT FIRSTKEY 
                  THEN
                      BEGIN                      #SPECIAL ALT KEY PROC# 
                      IF AX$DUPLFLG [AUXPTR] EQ 1 
                      THEN
                          BEGIN                  #DUPLICATES# 
                          IF AX$DUPLASC [AUXPTR] EQ 1 
                          THEN                   #DUPES - ASCENDING#
                              KEYTKS = FITV$ASCEN;
                          ELSE                   #DUPES - FIFO# 
                              BEGIN 
                              IF FIT$ORG EQ FITV$NEW
                              AND DN$SDEPTH [DNATPTR] EQ 1
                              THEN
                                  BEGIN 
                                  #  ERROR - NO FIFO ON ORG = NEW # 
                                  PRINTDIAG(D036,FN$DNATPTR[FNATPTR]);
                                  KEYTKS = FITV$ASCEN;  # CHG TO ASCEN #
                                  DNATPTR = VIRTUAL(TABLETYPE"DNAT$", 
                                      KEYINDEX);  # RESET DNATPTR # 
                                  END 
                              ELSE
                                  KEYTKS = FITV$FIFO; 
                              END 
                          END 
                      ELSE                       #NO DUPLICATES#
                          KEYTKS = FITV$NODUPL; 
                      END 
                  ELSE
                      KEYTKS = FITV$NODUPL;      #PRIME KEY - NO DUPL#
                  KEYTKL = KEYLENGTH;   #PUT LENGTH OF KEY IN TABLE#
                  IF NOT FIRSTKEY 
                  THEN
                      BEGIN 
                      IF DN$SDEPTH [DNATPTR] EQ 1 
                      THEN             #ALTERNATE KEY WITHIN -OCCURS-#
                          BEGIN 
                          AUXINDEX = DN$AUXREF [DNATPTR]; 
                          FINDAUX (MAXOCCUR); 
                          KEYTKG = AX$OCCLEN [AUXPTR];  #SIZE OF OCCURS 
                                                         GROUP# 
                          KEYTKC = AX$MAXOCCNO [AUXPTR];  #NBR OCCURS#
                          DNATPTR = VIRTUAL (TABLETYPE"DNAT$",
                              FN$FRECPTR [FNATPTR]);
                          AUXINDEX = DN$AUXREF [DNATPTR]; 
                          FINDAUX(SUBOCCDEP);  #SEE IF OCC DEP ON#
                          IF AUXINDEX NQ 0
                          THEN
                              BEGIN 
                              IF AX$OCCNAM [AUXPTR] LQ KEYINDEX 
                              THEN
                                  KEYTKC = 0;  # WITHIN ODO - KC = 0 #
                              END 
                          AUXINDEX = SVAUXIND;  #RESTORE AUX INDEX# 
                          AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); 
                          END 
                      KEYTSKOMIT = AX$OMITTED [AUXPTR]; 
                      KEYTSPACES = AX$KEYSPACES [AUXPTR]; 
                      KEYTZEROS = AX$KEYZEROES [AUXPTR];
                      FMAKEYPLT = 0;
                      IF AX$ALTKEYLIT [AUXPTR] NQ 0 
                      AND FN$SSCHEMA[FNATPTR] EQ 0
                      THEN
                          BEGIN    #DN CONTAINS CHAR FROM LIT GIVEN#
                          PLTINDEX = AX$ALTKEYLIT [AUXPTR]; 
                          FMAKEYPLT = PLTINDEX; 
                          POOLLIT;   #POOL THE LITERAL# 
                          LITPTR = DNATINDEX;   #POINT TO LITERAL#
                          KEYTLITLEN = PL$LENGTH [PLTPTR];
                          KEYTLITBCP = DN$CHARPOS [DNATPTR];
                          END 
                      END 
          CONTROL IFNQ CB5$CDCS,"NO"; 
                  IF FN$SSCHEMA[FNATPTR] NQ 0  #IF CDCS I/O FILE# 
                  THEN
                      BEGIN 
                      IF FIRSTKEY 
                      THEN
                          BEGIN 
                          IF FN$2DPLTPTR[FNATPTR] NQ 0
                          THEN
                              CDCSIXFNFLAG = TRUE;
                          KEYTKORD = FN$RKEYORD[FNATPTR];  #PRIME KEY 
                                                              ORDINAL#
                          END 
                      ELSE
                          KEYTKORD = AX$ALTKEYORD[AUXPTR]; #ALT KEY ORD#
            DNATPTR = VIRTUAL(TABLETYPE"DNAT$",KEYINDEX); 
                      FINDRORD;  #RECORD ORDINAL TO -KEYTRORD-# 
                  AUXPTR = VIRTUAL (TABLETYPE"AUX$", AUXINDEX); #RESET# 
                      END 
          CONTROL FI; 
                  OUTPUTDATA (KEYTITEM);
                  IF LITPTR NQ 0
                  THEN
                      RELOCLOWER (KEYTITEM2, LITPTR, TABLETYPE"DNAT$"); 
                  ELSE
                      OUTPUTDATA (KEYTITEM2); 
 #IF DUMP OF KEYS REQUIRED FOR FMA, DO IT NOW#
               IF CCTDUMPDATA THEN
                 DUMPKEY; 
               EMBEDDED = "T";
                  CURRFNATOFF = CURRFNATOFF + 2;
                  IF FIRSTKEY 
                  THEN
                      FIRSTKEY = FALSE; 
                  ELSE
                      AUXINDEX = AX$TNEXTPTR [AUXPTR];
                  FINDAUX (ALTKEYNAME);    #GET NEXT ALT KEY NAME#
                  IF AUXINDEX NQ 0
                  THEN
                      BEGIN 
                      KEYINDEX = AX$ALTKEY [AUXPTR];
                      END 
                  ELSE
                      KEYINDEX = 0; 
              END    #END OF KEY TABLE GENERATION LOOP# 
  
              AUXINDEX = FN$ALTKPTR [FNATPTR];
              FINDAUX (AUXALTKEYDN2);   #SEE IF DATANAME GIVEN# 
              IF AUXINDEX NQ 0
              THEN
                  BEGIN   #HAVE DATAN CONTAINS CHAR FROM LIT# 
 #      CREATE EXTRA KEY TABLE ITEM FOR SCC POINTER # 
                  KEYTITEM = 1;   #FLAG AS NOT LAST ITEM# 
                  KEYTITEM2 = 0;
                  DNATPTR = VIRTUAL(TABLETYPE"DNAT$", 
                      AX$AKDN2DNAT [AUXPTR]); 
                  GETBCPANDWN;
                  KEYTBCP = CHARPOS;
                  KEYTWORDNB = WORDOFFSET;
                  KEYTKL = 0;  #FLAGS AS SCC# 
                  OUTPUTDATA (KEYTITEM);
                  RELOCLOWER (KEYTITEM2, AX$AKDN2DNAT [AUXPTR], 
                      TABLETYPE"DNAT$");
                  CURRFNATOFF = CURRFNATOFF + 2;
                  END 
              OUTPUTDATA (0);  #PUT OUT A LIST TERMINATOR#
              OUTPUTDATA (MAXKEYPOS);   #WORD WITH END OF KEYS IN REC#
              CURRFNATOFF = CURRFNATOFF + 2;
              END 
          RESETLEV;   #FLUSH STUFF OUT# 
          IF FN$EXTERNAL [FNATPTR] EQ 0 
          THEN
              LASTNEOFF = CURRFNATOFF;  # SAVE PLACE FOR NON EXT FILES# 
          RETURN; 
          END 
          TERM
