*DECK MODPFP                                                            058400
USETEXT TCYBDEF                                                         058500
USETEXT TENVIRN                                                         058600
USETEXT TOPTION                                                         058700
USETEXT TPFMDEF                                                         058800
USETEXT TXSTD                                                           058900
#----------------------------------------------------------------------#059000
#                                                                      #059100
#     M O D P F P                                                      #059200
#                                                                      #059300
#     THIS PROCEDURE ACCEPTS INPUT TO CHANGE PERMANENT FILE PARAMETERS #059400
#     FOR ANY OF THE AREA FILES OR THE SUBSCHEMA FILE INVOLVED WITH    #059500
#     A CREATE/INVOKE/USE/VERSION DIRECTIVE.  THE EXPECTED INPUT IS    #059600
#     OF THE FORMAT:                                                   #059700
#                                                                      #059800
#         PFN,[KW,VALUE][,KW,VALUE]...                                 #059900
#                                                                      #060000
#     *PFN* IS ANY VALID PERM FILE NAME.  IT MUST MATCH THAT OF ONE    #060100
#     OF THE FILES AT AREA-TABLE-BUILDING TIME, BUT THIS GETS CHECKED  #060200
#     IN *USE*, NOT NOW, AS NAMES OF THE AREAS WITHIN THE SUBSCHEMA    #060300
#     ARE NOT KNOWN NOW.                                               #060400
#                                                                      #060500
#     *KW* IS ANY OF THE FOLLOWING PERM FILE KEYWORDS:                 #060600
#                                                                      #060700
#         NOS/BE - ID, PW, SN, CY, LC, MR, RW                          #060800
#         NOS    - UN, PW, PN,  R,  M                                  #060900
#                                                                      #061000
#     *VALUE* IS THE VALUE ASSOCIATED WITH *KW* IMMEDIATELY            #061100
#     PRECEDING.  FOR NOS/BE, *PW* MAY BE FOLLOWED BY 1-5 VALUES.      #061200
#     IF ZERO VALUES, ANY PREVIOUSLY MENTIONED PASSWORDS ARE REMOVED.  #061300
#                                                                      #061400
#----------------------------------------------------------------------#061500
                                                                        061600
      PROC MODPFP;                                                      061700
      BEGIN                                                             061800
                                                                        061900
#----------------------------------------------------------------------#062000
#   S T A R T   O F   X R E F S                                        #062100
                                                                        062200
      XREF ITEM  DIAGLEV B;        # DIAG FULL/PART FLAG               #062300
      XREF ITEM  DUMMY I;          # SCRATCH VARIABLE                  #062400
      XREF ITEM  INTERIN B;        # TRUE IF USER INPUT NOT TO BE      #062500
                                   # COPIED TO TERMINAL                #062600
      XREF ITEM  MODIFYFLAG B;     # TRUE IF TO REQUEST PF PARAM CHGS  #062700
      XREF ITEM  MXTRNLG I;        # MAXIMUM TRANSMISSION LENGTH       #062800
      XREF ITEM  PFPTR I;          # POINTER TO 1ST *PFTABLE* ENTRY    #062900
      XREF ITEM  PRINT B;          # TRUE IF INPUT SHOULD GO TO TRACE  #063000
      XREF ITEM  PROMTYPE I;       # QU PROMPT/POSITION INDICATOR      #
                                                                        063100
      XREF FUNC  CMM$ALF;          # ALLOCATE FIXED BLOCK              #063200
                                                                        063300
      XREF PROC  CMM$FRF;          # FREE FIXED BLOCK                  #063400
      XREF PROC  DIAG;             # ISSUE QU DIAGNOSTIC               #063500
      XREF PROC  LEXINIT;          # INITIALIZE SCANNER ON NEW LINE    #063600
      XREF PROC  LEXSCAN;          # SCAN TO NEXT LINE                 #063700
      XREF PROC  READ;             # REQUEST QU INPUT                  #063800
      XREF PROC RECYES;            # YES RETURN IF RECORDING           #
      XREF PROC  WRITE;            # REQUEST QU OUTPUT                 #063900
      XREF PROC  WRITEBL;          # MOVE OUTPUT LINE TO BUFFER        #064000
                                                                        064100
                                                                        064200
                                                                        064300
                                                                        064400
#----------------------------------------------------------------------#064500
#   S T A R T   O F   D E F S                                          #064600
                                                                        064700
      DEF $BLANKS$     #"          "#;                                  064800
                                                                        064900
                                                                        065000
                                                                        065100
                                                                        065200
#----------------------------------------------------------------------#065300
#   S T A R T   O F   L O C A L   I T E M S                            #065400
                                                                        065500
      ITEM  CHAR I;                # ONE 6 BIT CHARACTER               #065600
      ITEM  DIAGSV B;              # TEMP TO SAVE *DIAGLEV*            #065700
      ITEM  DUMMY1 I;              # TEMP ITEM                         #065800
      ITEM  DUMMY2 I;              # TEMP ITEM                         #065900
      ITEM  HIGH I;                # HIGH VALUE                        #066000
      ITEM  HYPHENS B;             # TRUE IF HYPHENS IN NAME           #066100
      ITEM  LASTENTRY I;           # PREVIOUS TABLE ADDRESS            #066200
      ITEM  LASTKW C(10);          # LAST PF KEYWORD ENCOUNTERED       #066300
      ITEM  LASTKX C(10);          # KEYWORD SAVE AREA FOR DIAGS       #066400
      ITEM  LOW I;                 # LOW VALUE                         #066500
      ITEM  PKEEP B;               # HOLDER OF OUTPUT FLAG, *PRINT*    #066600
      ITEM  RC I;                  # FLAG FOR RETURN CODES             #066700
      ITEM  SAVEPOS I;             # TO SAVE POSITION IN ARRAY         #066800
      ITEM  TBLPOS I;              # ORDINAL WITHIN *PFTABLE*          #066900
      ITEM  XNSIZE I;              # SIZE IN WORDS OF LONGEST ENTRY    #067000
      ITEM  XNTEMP I;              # TEMP                              #067100
                                                                        067200
                                                                        067300
                                                                        067400
                                                                        067500
#----------------------------------------------------------------------#067600
#   S T A R T   O F   L O C A L   A R R A Y S                          #067700
                                                                        067800
      ARRAY  AREANAME [0:2] S(1);  # TEMP AREA FOR AREA NAMES          #067900
        BEGIN                                                           068000
        ITEM  AREANAMEC     C(00,00,30);  # 30-CHAR NAME               #068100
        ITEM  AREANAMEI     I(00,00,60);  # FULL WORD                  #068200
        END                                                             068300
                                                                        068400
                                                                        068500
                                                                        068600
                                                                        068700
#----------------------------------------------------------------------#068800
#   S T A R T   O F   L O C A L   B A S E D   A R R A Y S              #068900
                                                                        069000
      BASED ARRAY  GIVEA;          # GENERAL PURPOSE                   #069100
        BEGIN                                                           069200
        ITEM  GIVECHAR      C(00,00,30);  # 30-CHAR NAME               #069300
        ITEM  GIVEITEM      I(00,00,60);  # ONE FULL WORD              #069400
        END                                                             069500
                                                                        069600
                                                                        069700
      BASED ARRAY XNBUF;           # BUFFER FOR OUTPUTTING ENTRY       #069800
        BEGIN                                                           069900
        ITEM XNWORD C(0,0,240);    # CHAR STORE AREA                   #070000
        END                                                             070100
CONTROL EJECT;                                                          070200
#----------------------------------------------------------------------#070300
#                                                                      #070400
#     C H K H Y P H E N S                                              #070500
#                                                                      #070600
#     THIS PROC EXAMINES THE CONTENTS OF *CURWORD* TO SEE IF           #070700
#     THERE ARE ANY HYPHENS PRESENT.  IF SO, THE FLAG *HYPHENS*        #070800
#     IS SET = TRUE.                                                   #070900
#                                                                      #071000
#----------------------------------------------------------------------#071100
                                                                        071200
      PROC  CHKHYPHENS;                                                 071300
      BEGIN                                                             071400
      ITEM  CHARPOS I;             # SCRATCH VARIABLE FOR CHAR POSITION#071500
      ITEM  HYP1 I;                # TEMP                              #071600
      ITEM  HYP2 I;                # TEMP                              #071700
                                                                        071800
      HYPHENS = FALSE;             # ASSUME NO HYPHENS                 #071900
      HYP1 = 0;                    # SET STARTING WORD                 #072000
      HYP2 = 0;                    # SET STARTING CHAR                 #072100
      FOR CHARPOS = 1 STEP 1       # FOR EACH CHAR POSITION            #072200
        UNTIL CURLENG              # UP TO THE LENGTH                  #072300
      DO                                                                072400
        BEGIN                                                           072500
        IF C<HYP2,1>ICW[HYP1] EQ "-"                                    072600
        THEN                       # IF A HYPHEN WAS FOUND             #072700
          BEGIN                                                         072800
          HYPHENS = TRUE;          # FOUND A HYPHEN IN CURWORD         #072900
          RETURN;                  # DONT HAVE TO CHECK FURTHER        #073000
          END                                                           073100
                                                                        073200
        HYP2 = HYP2 + 1;           # ADVANCE CHAR POSITION             #073300
        IF HYP2 EQ 10                                                   073400
        THEN                       # ADVANCE TO NEXT WORD              #073500
          BEGIN                                                         073600
          HYP1 = HYP1 + 1;                                              073700
          HYP2 = 0;                                                     073800
          END                                                           073900
        END                                                             074000
                                                                        074100
      RETURN;                                                           074200
      END                          # ----- CHKHYPHENS                  #074300
CONTROL EJECT;                                                          074400
#----------------------------------------------------------------------#074500
#                                                                      #074600
#     D I A G U                                                        #074700
#                                                                      #074800
#  THIS PROCEDURE IS NEEDED TO INSURE THAT TYPEINS THAT ARE DIAGNOSED  #074900
#  WITHIN *MODPFP* WILL GET LISTED COMPLETELY.  IT SCANS THRU TO THE   #075000
#  END OF THE INPUT (VIA *LEXSCAN*) AND MOVES EVERYTHING TO THE        #075100
#  OUTPUT, WHILE CHECKING FOR THE PRESENCE OF PF PASSWORDS, SO AS TO   #075200
#  BLOT THEM OUT.                                                      #075300
#                                                                      #075400
#----------------------------------------------------------------------#075500
                                                                        075600
      PROC DIAGU (DIAGVAL, DIAGPM1);                                    075700
      BEGIN                                                             075800
                                                                        075900
      ITEM CLSAVE U;               # SAVE AREA FOR CURLENG             #076000
      ITEM DIAGPM1 C(10);          # 1ST PARAMETER PASSED TO *DIAG*    #076100
      ITEM DIAGVAL U;              # DIAGNOSTIC NUMBER PASSED TO *DIAG*#076200
      ITEM DIAGTEMP U;             # COUNT OF ITEMS PICKED UP          #076300
                                                                        076400
      ARRAY CWSAVE [0:2] S(1);     # SAVE AREA FOR CURWORD             #076500
        BEGIN                                                           076600
        ITEM ICWSV C(0,0,10);                                           076700
        END                                                             076800
                                                                        076900
                                                                        077000
                                   # SAVE CONTENTS OF *CURWORD* AND    #077100
                                   # *CURLENG* AND THEN RESTORE THEM   #077200
                                   # PRIOR TO ISSUING THE DIAG.  THIS  #077300
                                   # IS DONE IN CASE THE DIAG HAS A <C>#077400
                                   # INSERTION, AS SOME OF THE ONES    #077500
                                   # CALLED BY *MODPFP* DO THIS.       #077600
      CLSAVE = CURLENG;                                                 077700
      ICWSV[0] = ICW[0];                                                077800
      ICWSV[1] = ICW[1];                                                077900
      ICWSV[2] = ICW[2];                                                078000
                                   # SCAN THRU ALL REMAINING ITEMS     #078100
                                   # IN ENTRY.  THERE MIGHT BE NONE,   #078200
                                   # SO THE FOLLOWING MUST BE A        #078300
                                   # -SLOWLOOP-.                       #078400
      DIAGTEMP = 0;                # RESET COUNT OF ITEMS              #078500
      FOR XNTEMP = XNTEMP                                               078600
        WHILE INW[0] NQ $BLANKS$                                        078700
      DO                                                                078800
        BEGIN                                                           078900
        LEXSCAN;                   # GET NEXT ITEM                     #079000
        DIAGTEMP = DIAGTEMP + 1;   # ADVANCE COUNT OF ITEMS FETCHED    #079100
        IF PKEEP                   # IF OUTPUT TO BE WRITTEN           #079200
        THEN                                                            079300
          BEGIN                                                         079400
          IF LASTKW NQ "PW"        # IF NOT WITHIN PW VALUES           #079500
          THEN                                                          079600
            BEGIN                  # MOVE ITEM INTO OUTPUT LINE        #079700
            C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICW[0];              079800
                                   # ADVANCE TO ALLOW 1 BLANK BETWEEN  #079900
            CHAR = CHAR + CURLENG + 1;                                  080000
            IF CURTYPE EQ 100      # IF THIS IS A PF KEYWORD           #080100
            THEN                                                        080200
              BEGIN                                                     080300
              LASTKW = ICW[0];     # UPDATE MOST RECENT KEYWORD        #080400
              END                                                       080500
            END                                                         080600
                                                                        080700
          ELSE                     # WITHIN PW VALUES                  #080800
            BEGIN                                                       080900
            IF CURTYPE NQ 100      # IF NOT NOW AT A KEYWORD (OR =)    #081000
            THEN                   # INSERT *---* INSTEAD OF VALUE     #081100
              BEGIN                                                     081200
              C<CHAR,5>XNWORD[0] = "*---*";                             081300
              CHAR = CHAR + 6;                                          081400
              END                                                       081500
                                                                        081600
            ELSE                   # AT A KEYWORD                      #081700
              BEGIN                # INSERT THE KEYWORD                #081800
              C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICW[0];            081900
              CHAR = CHAR + CURLENG + 1;                                082000
              IF ICW[0] NQ "="     # IF NOT THE OPTIONAL =             #082100
              THEN                                                      082200
                BEGIN                                                   082300
                LASTKW = ICW[0];   # UPDATE MOST RECENT KEYWORD        #082400
                END                                                     082500
              END                                                       082600
            END                                                         082700
          END                                                           082800
        END                                                             082900
                                                                        083000
      IF PKEEP                     # IF OUTPUT TO BE WRITTEN           #083100
      THEN                                                              083200
        BEGIN                                                           083300
                                   # OUTPUT THE COMPLETED LINE         #083400
        INTERIN = TRUE;            # SET FOR NO OUTPUT TO TERMINAL     #083500
        WRITEBL (XNWORD[0], CHAR, XNTEMP);                              083600
        INTERIN = FALSE;                                                083700
        CHAR = 0;                  # PREVENT LINE FROM BEING REWRITTEN #083800
        END                                                             083900
                                                                        084000
      ICW[0] = ICWSV[0];           # RESTORE CURWORD AND CURLENG       #084100
      ICW[1] = ICWSV[1];                                                084200
      ICW[2] = ICWSV[2];                                                084300
      CURLENG = CLSAVE;                                                 084400
      CURLENW = (CURLENG + 9) / 10;                                     084500
      DIAG (DIAGVAL, DIAGPM1);     # ISSUE DIAGNOSTIC                  #084600
      IF DIAGTEMP NQ 0             # IF SOMETHING WAS SKIPPED          #084700
      THEN                                                              084800
        BEGIN                                                           084900
        DIAG (376);                # REST OF ENTRY SKIPPED             #085000
        END                                                             085100
                                                                        085200
      RETURN;                                                           085300
      END                          # ----- DIAGU                       #085400
CONTROL EJECT;                                                          085500
#----------------------------------------------------------------------#085600
#                                                                      #085700
#     G E T P F V A L U E                                              #085800
#                                                                      #085900
#  THIS PROCEDURE DOES THE FOLLOWING:                                  #086000
#     1) GETS THE NEXT LEXICAL ITEM, WHICH IS EXPECTED TO BE A VALUE   #086100
#        FOR ONE OF THE PF KEYWORDS.                                   #086200
#     2) SKIPS OVER THE OPTIONAL =, IF PRESENT.                        #086300
#     3) IF OUTPUT IS REQUESTED (I.E., THE SAVED VALUE OF *PRINT*,     #086400
#        *PKEEP* = TRUE), THE ITEM IS PLACED IN THE OUTPUT LINE BUFFER.#086500
#----------------------------------------------------------------------#086600
                                                                        086700
      PROC GETPFVALUE;                                                  086800
      BEGIN                                                             086900
      LEXSCAN;                     # POSITION TO NEXT INPUT ITEM       #087000
      IF PKEEP                     # IF OUTPUT REQUESTED               #087100
      THEN                                                              087200
        BEGIN                                                           087300
                                   # MOVE ITEM INTO OUTPUT LINE        #087400
        C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICW[0];                  087500
                                   # ADVANCE TO ALLOW 1 BLANK BETWEEN  #087600
        CHAR = CHAR + CURLENG + 1;                                      087700
        END                                                             087800
                                                                        087900
      IF ICW[0] EQ "="             # SKIP OVER OPTIONAL =              #088000
      THEN                                                              088100
        BEGIN                                                           088200
        LEXSCAN;                   # POSITION TO NEXT INPUT ITEM       #088300
        IF PKEEP                   # IF OUTPUT REQUESTED               #088400
        THEN                                                            088500
          BEGIN                                                         088600
                                   # MOVE ITEM INTO OUTPUT LINE        #088700
          C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICW[0];                088800
                                   # ADVANCE TO ALLOW 1 BLANK BETWEEN  #088900
          CHAR = CHAR + CURLENG + 1;                                    089000
          END                                                           089100
        END                                                             089200
                                                                        089300
      RETURN;                                                           089400
      END                          # ----- GETPFVALUE                  #089500
CONTROL EJECT;                                                          089600
                                                                        089700
CONTROL IFEQ  OS$NAME,SCOPE;                                            089800
#----------------------------------------------------------------------#089900
#                                                                      #090000
#     S E T C Y                                                        #090100
#                                                                      #090200
#     PROC TO STORE THE -CY- KEYWORD AND VALUE.                        #090300
#                                                                      #090400
#----------------------------------------------------------------------#090500
                                                                        090600
      PROC  SETCY;                                                      090700
      BEGIN                                                             090800
      GETPFVALUE;                  # GET NEXT ITEM                     #090900
                                   # TEST TO BE SURE THAT VALUE IS     #091000
                                   # AN INTEGER                        #091100
      IF CURTYPE NQ O"153"                                              091200
      THEN                                                              091300
        BEGIN                                                           091400
        DIAGU (290, "CY");         # NON-INTEGER FOR CYCLE NUMBER      #091500
        RETURN;                                                         091600
        END                                                             091700
                                                                        091800
                                   # SCAN DOWN THE FDB ENTRIES         #091900
                                   # LOOKING FOR THE  -CY-  ENTRY      #092000
      FOR DUMMY2 = DUMMY2                                               092100
        WHILE PFKEY[TBLPOS] NQ 0                                        092200
      DO                                                                092300
        BEGIN                                                           092400
        IF PFKEY[TBLPOS] EQ FDBVAL$CY                                   092500
        THEN                       # -CY- ENTRY FOUND                  #092600
          BEGIN                                                         092700
          PFVALUE[TBLPOS] = ICW[5];  # PLACE IN THE CY NUMBER          #092800
          RETURN;                                                       092900
          END                                                           093000
        ELSE                                                            093100
                                                                        093200
          BEGIN                                                         093300
          TBLPOS = TBLPOS + 1;     # MOVE TO NEXT ENTRY                #093400
          END                                                           093500
        END                                                             093600
                                                                        093700
                                   # ADD A -CY- ENTRY AT END           #093800
      PARAMWORD[TBLPOS] = FDBVAL$CY;                                    093900
      PFVALUE[TBLPOS] = ICWI[5];   # SET IN THE CY NUMBER              #094000
      RETURN;                                                           094100
      END                          # ----- SETCY                       #094200
CONTROL EJECT;                                                          094300
#----------------------------------------------------------------------#094400
#                                                                      #094500
#     S E T I D                                                        #094600
#                                                                      #094700
#     PROC TO STORE THE -ID- KEYWORD AND VALUE.                        #094800
#                                                                      #094900
#----------------------------------------------------------------------#095000
                                                                        095100
      PROC  SETID;                                                      095200
      BEGIN                                                             095300
      GETPFVALUE;                  # GET NEXT ITEM                     #095400
      IF CURLENG GR 9              # TEST FOR NAME OF 1-9 CHARS        #095500
        OR CURLENG LS 1                                                 095600
      THEN                                                              095700
        BEGIN                                                           095800
        DIAGU (185, CURWORD);      # ILLEGAL LENGTH NAME               #095900
        RETURN;                    # GET THE NEXT INPUT                #096000
        END                                                             096100
                                                                        096200
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #096300
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #096400
      THEN                                                              096500
        BEGIN                                                           096600
        DIAGU (215, "ID");         # HYPHENS ILLEGAL IN NAME           #096700
        RETURN;                                                         096800
        END                                                             096900
                                                                        097000
                                   # SEARCH FOR AN -ID- ENTRY          #097100
      FOR DUMMY2 = DUMMY2                                               097200
        WHILE PFKEY[TBLPOS] NQ 0                                        097300
      DO                                                                097400
        BEGIN                                                           097500
        IF PFKEY[TBLPOS] EQ FDBVAL$ID                                   097600
        THEN                       # -ID- FOUND IN TABLE               #097700
          BEGIN                                                         097800
          PFVALUE[TBLPOS] = 0;     # ZERO OUT PREVIOUS VALUE           #097900
                                   # MOVE THE VALUE INTO THE FDB       #098000
          C<9-CURLENG,CURLENG>PFVALUE[TBLPOS] = C<0,CURLENG>ICW[0];     098100
          RETURN;                                                       098200
          END                                                           098300
                                                                        098400
        ELSE                                                            098500
          BEGIN                                                         098600
                                   # MOVE TO THE NEXT PRAMETER         #098700
          TBLPOS = TBLPOS + 1;     # ADVANCE IN TABLE                  #098800
          END                                                           098900
        END                                                             099000
                                                                        099100
                                   # ADD AN -ID- ENTRY AT END OF TABLE #099200
      PARAMWORD[TBLPOS] = FDBVAL$ID;                                    099300
      C<9-CURLENG,CURLENG>PFVALUE[TBLPOS] = C<0,CURLENG>ICW[0];         099400
      RETURN;                                                           099500
      END                          # ----- SETID                       #099600
CONTROL EJECT;                                                          099700
#----------------------------------------------------------------------#099800
#                                                                      #099900
#     S E T L C                                                        #100000
#                                                                      #100100
#     PROC TO STORE THE -LC- KEYWORD AND VALUE.                        #100200
#                                                                      #100300
#----------------------------------------------------------------------#100400
                                                                        100500
      PROC  SETLC;                                                      100600
      BEGIN                                                             100700
      GETPFVALUE;                  # GET NEXT ITEM                     #100800
      IF CURTYPE NQ O"153"         # IF PARAMETER NOT AN INTEGER       #100900
      THEN                                                              101000
        BEGIN                                                           101100
        DIAGU (290, "LC");         # NON-INTEGER FOR *LC* PARAM        #101200
        RETURN;                                                         101300
        END                                                             101400
                                                                        101500
      FOR DUMMY2 = DUMMY2          # SEARCH FOR AN -LC- ENTRY          #101600
        WHILE PFKEY[TBLPOS] NQ 0                                        101700
      DO                                                                101800
        BEGIN                                                           101900
        IF PFKEY[TBLPOS] EQ FDBVAL$LC                                   102000
        THEN                       # -LC- ENTRY HAS BEEN FOUND         #102100
          BEGIN                                                         102200
          PFVALUE[TBLPOS] = ICWI[5];  # REPLACE WITH NEW VALUE         #102300
          RETURN;                                                       102400
          END                                                           102500
                                                                        102600
        TBLPOS = TBLPOS + 1;       # MOVE TO NEXT ENTRY                #102700
        END                                                             102800
                                                                        102900
                                   # ADD AN -LC- ENTRY AT END OF TABLE #103000
      PARAMWORD[TBLPOS] = FDBVAL$LC;                                    103100
      PFVALUE[TBLPOS] = ICWI[5];   # INSERT SPECIFIED INTEGER VALUE    #103200
      RETURN;                                                           103300
      END                          # ----- SETLC                       #103400
CONTROL EJECT;                                                          103500
#----------------------------------------------------------------------#103600
#                                                                      #103700
#     S E T M R                                                        #103800
#                                                                      #103900
#     PROC TO STORE -MR- KEYWORD AND VALUE.                            #104000
#                                                                      #104100
#----------------------------------------------------------------------#104200
                                                                        104300
      PROC  SETMR;                                                      104400
      BEGIN                                                             104500
      GETPFVALUE;                  # GET NEXT ITEM                     #104600
      IF CURTYPE NQ O"153"         # IF PARAMETER NOT AN INTEGER       #104700
      THEN                                                              104800
        BEGIN                                                           104900
        DIAGU (290, "MR");         # NON-INTEGER FOR *MR* PARAM        #105000
        RETURN;                                                         105100
        END                                                             105200
                                                                        105300
      FOR DUMMY2 = DUMMY2                                               105400
        WHILE PFKEY[TBLPOS] NQ 0                                        105500
      DO                                                                105600
        BEGIN                                                           105700
        IF PFKEY[TBLPOS] EQ FDBVAL$MR                                   105800
        THEN                       # AN -MR- ENTRY HAS BEEN FOUND      #105900
          BEGIN                                                         106000
          PFVALUE[TBLPOS] = ICWI[5];  # REPLACE WITH NEW VALUE         #106100
          RETURN;                                                       106200
          END                                                           106300
                                                                        106400
        TBLPOS = TBLPOS + 1;       # MOVE TO NEXT ENTRY                #106500
        END                                                             106600
                                                                        106700
                                   # ADD AN -MR- ENTRY AT END          #106800
      PARAMWORD[TBLPOS] = FDBVAL$MR;                                    106900
      PFVALUE[TBLPOS] = ICWI[5];   # INSERT NEW VALUE                  #107000
      RETURN;                                                           107100
      END                          # ----- SETMR                       #107200
CONTROL EJECT;                                                          107300
#----------------------------------------------------------------------#107400
#                                                                      #107500
#     S E T P W                                                        #107600
#                                                                      #107700
#     PROC TO STORE THE -PW- KEYWORD AND VALUE.                        #107800
#                                                                      #107900
#----------------------------------------------------------------------#108000
                                                                        108100
      PROC  SETPW;                                                      108200
      BEGIN                                                             108300
                                                                        108400
      ITEM  PWDUM1 I;              # DUMMY LOOP COUNTER                #108500
                                                                        108600
      IF INW[0] EQ "="             # CHECK FOR OPTIONAL =              #108700
      THEN                                                              108800
        BEGIN                                                           108900
        IF PKEEP                   # PUT = IN OUTPUT LINE, IF OUTPUT   #109000
        THEN                       # IS REQUESTED                      #109100
          BEGIN                                                         109200
          C<CHAR,1>XNWORD[0] = "=";                                     109300
          CHAR = CHAR + 2;                                              109400
          END                                                           109500
                                                                        109600
        LEXSCAN;                   # GET NEXT INPUT ITEM               #109700
        END                                                             109800
                                                                        109900
      IF INW[0] EQ $BLANKS$        # CHECK FOR NO VALUES AFTER -PW-    #110000
        OR NEXTYPE EQ 100          # IF SO, IT MEANS TO DELETE ALL     #110100
      THEN                         # PASSWORDS CURRENTLY SPECIFIED     #110200
        BEGIN                                                           110300
        FOR DUMMY2 = DUMMY2        # FIND ALL -PW- ENTRIES IN TABLE    #110400
          WHILE PFKEY[TBLPOS] NQ 0                                      110500
        DO                                                              110600
          BEGIN                                                         110700
          IF PFKEY[TBLPOS] GQ FDBVAL$PWL                                110800
            AND PFKEY[TBLPOS] LQ FDBVAL$PWH                             110900
          THEN                     # A -PW- HAS BEEN FOUND             #111000
            BEGIN                                                       111100
                                   # DELETE IT BY MOVING ENTRIES UP    #111200
            SAVEPOS = TBLPOS;      # SAVE CURRENT POSITION             #111300
            FOR DUMMY2 = DUMMY2                                         111400
              WHILE PFKEY[TBLPOS] NQ 0                                  111500
            DO                                                          111600
              BEGIN                                                     111700
              PARAMWORD[TBLPOS] = PARAMWORD[TBLPOS+1];                  111800
              TBLPOS = TBLPOS + 1;                                      111900
              END                                                       112000
                                                                        112100
            TBLPOS = SAVEPOS - 1;  # RESTORE POSITION                  #112200
            END                                                         112300
                                                                        112400
                                   # GO LOOK FOR ANOTHER -PW-          #112500
          TBLPOS = TBLPOS + 1;                                          112600
          END                                                           112700
                                                                        112800
        PFDELPW[0] = TRUE;         # INDICATE EXISTING PASSWORDS TO    #112900
                                   # BE DELETED FROM FDB               #113000
        RETURN;                    # ALL PASS WORDS DELETED            #113100
        END                                                             113200
                                                                        113300
      FOR PWDUM1 = PWDUM1          # ADD PASSWORDS TO THE CURRENT ONES #113400
        WHILE INW[0] NQ $BLANKS$   # IN THE FDB                        #113500
          AND NEXTYPE NQ 100                                            113600
      DO                                                                113700
        BEGIN                                                           113800
        LEXSCAN;                   # POSITION TO THE NEXT INPUT        #113900
        IF PKEEP                   # IF OUTPUT DESIRED                 #114000
        THEN                       # REPLACE VALUE OF PW WITH *---*    #114100
          BEGIN                                                         114200
          C<CHAR,5>XNWORD[0] = "*---*";                                 114300
          CHAR = CHAR + 6;                                              114400
          END                                                           114500
                                                                        114600
        IF CURLENG GR 9            # TEST FOR VALUE = 1-9 CHARS        #114700
          OR CURLENG LS 1                                               114800
        THEN                                                            114900
          BEGIN                                                         115000
          DIAGU (187, CURWORD);    # ILLEGAL LENGTH NAME               #115100
          RETURN;                  # GET THE NEXT INPUT                #115200
          END                                                           115300
                                                                        115400
        CHKHYPHENS;                # CHECK FOR EMBEDDED HYPHENS        #115500
        IF HYPHENS                 # IF EMBEDDED HYPHENS FOUND         #115600
        THEN                                                            115700
          BEGIN                                                         115800
          DIAGU (215, "PW");       # HYPHENS ILLEGAL IN NAME           #115900
          RETURN;                                                       116000
          END                                                           116100
                                                                        116200
                                   # SCAN TABLE TO FIND THE            #116300
                                   # HIGHEST PW CODE VALUE             #116400
        HIGH = FDBVAL$PWL - 1;     # SET HIGHEST VALUE FOUND           #116500
        FOR DUMMY2 = DUMMY2                                             116600
          WHILE PFKEY[TBLPOS] NQ 0                                      116700
        DO                                                              116800
          BEGIN                                                         116900
          IF PFKEY[TBLPOS] GQ FDBVAL$PWL                                117000
            AND PFKEY[TBLPOS] LQ FDBVAL$PWH                             117100
          THEN                     # A -PW- ENTRY HAS BEEN FOUND       #117200
            BEGIN                                                       117300
            IF HIGH LS PFKEY[TBLPOS]                                    117400
            THEN                   # SAVE NEW HIGH VALUE               #117500
              BEGIN                                                     117600
              HIGH = PFKEY[TBLPOS];                                     117700
              END                                                       117800
            END                                                         117900
                                                                        118000
          TBLPOS = TBLPOS + 1;     # MOVE TO NEXT ENTRY                #118100
          END                                                           118200
                                                                        118300
                                   # CHECK IF ROOM FOR ANOTHER -PW-    #118400
        IF HIGH GQ FDBVAL$PWH                                           118500
        THEN                       # MAXIMUM NUMBER PRESENT ALREADY    #118600
          BEGIN                                                         118700
          DIAGU (329, AREANAME[0]);  # NO ROOM FOR MORE THAN 5 PW VALS #118800
          RETURN;                                                       118900
          END                                                           119000
                                                                        119100
                                   # THERE IS ROOM FOR THIS PASSWORD   #119200
        PARAMWORD[TBLPOS] = HIGH + 1;  # USE NEXT PW CODE              #119300
                                   # MOVE IN THE PASSWORD VALUE        #119400
        C<9-CURLENG,CURLENG>PFVALUE[TBLPOS] = C<0,CURLENG>ICW[0];       119500
        END                                                             119600
                                                                        119700
      RETURN;                                                           119800
      END                          # ----- SETPW                       #119900
CONTROL EJECT;                                                          120000
#----------------------------------------------------------------------#120100
#                                                                      #120200
#     S E T R W                                                        #120300
#                                                                      #120400
#     PROC TO STORE THE -RW- KEYWORD AND VALUE.                        #120500
#                                                                      #120600
#----------------------------------------------------------------------#120700
                                                                        120800
      PROC  SETRW;                                                      120900
      BEGIN                                                             121000
      GETPFVALUE;                  # GET NEXT ITEM                     #121100
      IF CURTYPE NQ O"153"         # IF PARAMETER NOT AN INTEGER       #121200
      THEN                                                              121300
        BEGIN                                                           121400
        DIAGU (290, "RW");         # NON-INTEGER FOR *RW* PARAM        #121500
        RETURN;                                                         121600
        END                                                             121700
                                                                        121800
      FOR DUMMY2 = DUMMY2                                               121900
        WHILE PFKEY[TBLPOS] NQ 0                                        122000
      DO                                                                122100
        BEGIN                                                           122200
        IF PFKEY[TBLPOS] EQ FDBVAL$RW                                   122300
        THEN                       # AN -RW- ENTRY HAS BEEN FOUND      #122400
          BEGIN                                                         122500
          PFVALUE[TBLPOS] = ICWI[5];  # REPLACE WITH NEW VALUE         #122600
          RETURN;                                                       122700
          END                                                           122800
                                                                        122900
        TBLPOS = TBLPOS + 1;       # MOVE TO NEXT ENTRY                #123000
        END                                                             123100
                                                                        123200
                                   # ADD AN -RW- ENTRY AT END          #123300
      PARAMWORD[TBLPOS] = FDBVAL$RW;                                    123400
      PFVALUE[TBLPOS] = ICWI[5];   # INSERT NEW VALUE                  #123500
      RETURN;                                                           123600
      END                          # ----- SETRW                       #123700
CONTROL EJECT;                                                          123800
#----------------------------------------------------------------------#123900
#                                                                      #124000
#     S E T S N                                                        #124100
#                                                                      #124200
#     PROC TO STORE THE -SN- KEYWORD AND VALUE.                        #124300
#                                                                      #124400
#----------------------------------------------------------------------#124500
                                                                        124600
      PROC  SETSN;                                                      124700
      BEGIN                                                             124800
      GETPFVALUE;                  # GET NEXT ITEM                     #124900
      IF CURLENG GR 7                                                   125000
        OR CURLENG LS 1                                                 125100
      THEN                                                              125200
        BEGIN                                                           125300
        DIAGU (250, CURWORD);      # ILLEGAL LENGTH NAME               #125400
        RETURN;                                                         125500
        END                                                             125600
                                                                        125700
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #125800
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #125900
      THEN                                                              126000
        BEGIN                                                           126100
        DIAGU (215, "SN");         # HYPHENS ILLEGAL IN NAME           #126200
        RETURN;                                                         126300
        END                                                             126400
                                                                        126500
                                   # SCAN DOWN THE FDB TO FIND         #126600
                                   # THE  -SN- ENTRY                   #126700
      FOR DUMMY2 = DUMMY2                                               126800
        WHILE PFKEY[TBLPOS] NQ 0                                        126900
      DO                                                                127000
        BEGIN                                                           127100
        IF PFKEY[TBLPOS] EQ FDBVAL$SN                                   127200
        THEN                       # -SN- ENTRY FOUND                  #127300
          BEGIN                                                         127400
          PFVALUE[TBLPOS] = 0;     # STORE NEW VALUE                   #127500
          C<0,CURLENG>PFVALUE[TBLPOS] = C<0,CURLENG>ICW[0];             127600
          RETURN;                                                       127700
          END                                                           127800
                                                                        127900
        ELSE                                                            128000
          BEGIN                                                         128100
                                   # MOVE TO THE NEXT PARAMETER WORD   #128200
          TBLPOS = TBLPOS + 1;                                          128300
          END                                                           128400
        END                                                             128500
                                                                        128600
                                   # ADD NEW -SN- ENTRY TO TABLE       #128700
      PARAMWORD[TBLPOS] = FDBVAL$SN;                                    128800
      C<0,CURLENG>PFVALUE[TBLPOS] = C<0,CURLENG>ICW[0];                 128900
      RETURN;                                                           129000
      END                          # ----- SETSN                       #129100
                                                                        129200
CONTROL ENDIF;                                                          129300
CONTROL EJECT;                                                          129400
                                                                        129500
CONTROL IFEQ  OS$NAME,NOS;                                              129600
#----------------------------------------------------------------------#129700
#                                                                      #129800
#     S E T M                                                          #129900
#                                                                      #130000
#     PROC TO STORE THE -M- KEYWORD AND VALUE.                         #130100
#                                                                      #130200
#----------------------------------------------------------------------#130300
                                                                        130400
      PROC  SETM;                                                       130500
      BEGIN                                                             130600
      GETPFVALUE;                  # GET NEXT ITEM                     #130700
      IF CURLENG GR 2                                                   130800
        OR CURLENG LS 1                                                 130900
      THEN                                                              131000
        BEGIN                                                           131100
        DIAGU (303);               # ILLEGAL VALUE FOR *M*             #131200
        RETURN;                                                         131300
        END                                                             131400
                                                                        131500
                                   # TRANSLATE VALUE GIVEN FOR M PARAM #131600
                                   # INTO NOS PF MODE VALUE.           #131700
      PFVALUE[$FDBM$] = 0;         # IF THIS STAYS = 0, ERROR          #131800
      IF ICW[0] EQ "W"             # WRITE PERMISSION                  #131900
      THEN                                                              132000
        BEGIN                                                           132100
        PFVALUE[$FDBM$] = NOSPFM$W + O"40";    # PF CODE + BIAS        #132200
                                   # BIAS NEEDED FOR ATTACH TO WORK    #132300
        END                                                             132400
                                                                        132500
      IF ICW[0] EQ "M"             # MODIFY PERMISSION                 #132600
      THEN                                                              132700
        BEGIN                                                           132800
        PFVALUE[$FDBM$] = NOSPFM$M + O"40";                             132900
        END                                                             133000
                                                                        133100
      IF ICW[0] EQ "RM"            # READ-MODIFY PERMISSION            #133200
      THEN                                                              133300
        BEGIN                                                           133400
        PFVALUE[$FDBM$] = NOSPFM$RM + O"40";                            133500
        END                                                             133600
                                                                        133700
      IF ICW[0] EQ "RA"            # READ-APPEND PERMISSION            #133800
      THEN                                                              133900
        BEGIN                                                           134000
        PFVALUE[$FDBM$] = NOSPFM$RA + O"40";                            134100
        END                                                             134200
                                                                        134300
      IF ICW[0] EQ "R"             # READ PERMISSION                   #134400
      THEN                                                              134500
        BEGIN                                                           134600
        PFVALUE[$FDBM$] = NOSPFM$R + O"40";                             134700
        END                                                             134800
                                                                        134900
      IF PFVALUE[$FDBM$] EQ 0                                           135000
      THEN                         # INVALID MODE GIVEN                #135100
        BEGIN                                                           135200
        DIAGU (303);                                                    135300
        RETURN;                    # EXIT WITHOUT CHANGING MODE        #135400
        END                                                             135500
                                                                        135600
      PFKEY[$FDBM$] = $DDLM$;      # STORE -M- ID                      #135700
      RETURN;                                                           135800
      END                          # ----- SETM                        #135900
CONTROL EJECT;                                                          136000
#----------------------------------------------------------------------#136100
#                                                                      #136200
#     S E T P N                                                        #136300
#                                                                      #136400
#     PROC TO STORE THE -PN- KEYWORD AND VALUE.                        #136500
#                                                                      #136600
#----------------------------------------------------------------------#136700
                                                                        136800
      PROC  SETPN;                                                      136900
      BEGIN                                                             137000
      GETPFVALUE;                  # GET NEXT ITEM                     #137100
      IF CURLENG GR 7                                                   137200
        OR CURLENG LS 1                                                 137300
      THEN                                                              137400
        BEGIN                                                           137500
        DIAGU (291);               # ILLEGAL LENGTH PACK NAME          #137600
        RETURN;                                                         137700
        END                                                             137800
                                                                        137900
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #138000
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #138100
      THEN                                                              138200
        BEGIN                                                           138300
        DIAGU (215, "PN");         # HYPHENS ILLEGAL IN NAME           #138400
        RETURN;                                                         138500
        END                                                             138600
                                                                        138700
                                   # STORE -PN- ENTRY                  #138800
      PARAMWORD[$FDBPN$] = $DDLPN$;                                     138900
                                   # STORE -PN- ID                     #139000
      C<0,CURLENG>PFVALUE[$FDBPN$] = C<0,CURLENG>ICW[0];                139100
      RETURN;                                                           139200
      END                          # ----- SETPN                       #139300
CONTROL EJECT;                                                          139400
#----------------------------------------------------------------------#139500
#                                                                      #139600
#     S E T P W                                                        #139700
#                                                                      #139800
#     PROC TO STORE THE -PW- KEYWORD AND VALUE.                        #139900
#                                                                      #140000
#----------------------------------------------------------------------#140100
                                                                        140200
      PROC  SETPW;                                                      140300
      BEGIN                                                             140400
      LEXSCAN;                     # GET THE NEXT ITEM INTO CURWORD    #140500
      IF ICW[0] EQ "="             # CHECK FOR OPTIONAL =              #140600
      THEN                                                              140700
        BEGIN                                                           140800
        IF PKEEP                   # IF OUTPUT REQUESTED               #140900
        THEN                       # REPLACE VALUE OF PW WITH *---*    #141000
          BEGIN                                                         141100
          C<CHAR,7>XNWORD[0] = "= *---*";                               141200
          CHAR = CHAR + 8;                                              141300
          END                                                           141400
                                                                        141500
        LEXSCAN;                   # GET NEXT ITEM                     #141600
        END                                                             141700
                                                                        141800
      ELSE                                                              141900
        BEGIN                                                           142000
        IF PKEEP                   # IF OUTPUT REQUESTED               #142100
        THEN                       # REPLACE VALUE OF PW WITH *---*    #142200
          BEGIN                                                         142300
          C<CHAR,5>XNWORD[0] = "*---*";                                 142400
          CHAR = CHAR + 6;                                              142500
          END                                                           142600
        END                                                             142700
                                                                        142800
      IF CURLENG GR 7                                                   142900
        OR CURLENG LS 1                                                 143000
      THEN                                                              143100
        BEGIN                                                           143200
        DIAGU (145);               # ILLEGAL LENGTH PASSWORD           #143300
        RETURN;                                                         143400
        END                                                             143500
                                                                        143600
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #143700
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #143800
      THEN                                                              143900
        BEGIN                                                           144000
        DIAGU (215, "PW");         # HYPHENS ILLEGAL IN NAME           #144100
        RETURN;                                                         144200
        END                                                             144300
                                                                        144400
                                                                        144500
                                   # STORE -PW- ENTRY                  #144600
      PARAMWORD[$FDBPW$] = $DDLPWL$;                                    144700
      C<0,CURLENG>PFVALUE[$FDBPW$] = C<0,CURLENG>ICW[0];
      RETURN;                                                           144900
      END                          # ----- SETPW                       #145000
CONTROL EJECT;                                                          145100
#----------------------------------------------------------------------#145200
#                                                                      #145300
#     S E T R                                                          #145400
#                                                                      #145500
#     PROC TO STORE THE -R- KEYWORD AND VALUE.                         #145600
#                                                                      #145700
#----------------------------------------------------------------------#145800
                                                                        145900
      PROC SETR;                                                        146000
      BEGIN                                                             146100
      ITEM  UNIT I;                # TEMP FOR UNIT NUMBER              #146200
                                                                        146300
      GETPFVALUE;                  # GET NEXT ITEM                     #146400
      IF CURLENG GR 3                                                   146500
        OR CURLENG LS 2            # TOO MANY / FEW CHARACTERS         #146600
      THEN                                                              146700
        BEGIN                                                           146800
        DIAGU (292);               # ILLEGAL LENGTH DEVICE SPEC.       #146900
        RETURN;                                                         147000
        END                                                             147100
                                                                        147200
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #147300
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #147400
      THEN                                                              147500
        BEGIN                                                           147600
        DIAGU (215, "R ");         # HYPHENS ILLEGAL IN NAME           #147700
        RETURN;                                                         147800
        END                                                             147900
                                                                        148000
      UNIT =  0;                                                        148100
      IF CURLENG EQ 3                                                   148200
      THEN                                                              148300
        BEGIN                                                           148400
        UNIT = B<12,6>ICWI[0] - O"33" ;   # CONVERT TO OCTAL           #148500
        IF UNIT LQ 0                                                    148600
          OR UNIT GR 8             # IF INVALID UNIT NUMBER            #148700
        THEN                                                            148800
          BEGIN                                                         148900
          DIAGU (292);             # INVALID DEVICE SPEC.              #149000
          RETURN;                                                       149100
          END                                                           149200
        END                                                             149300
                                                                        149400
      PARAMWORD[$FDBR$] = $DDLR$;    # STORE THE *R* KEY VALUE         #149500
      B<0,12>PARAMWORD[$FDBR$] = B<0,12>ICW[0];    # DEVICE TYPE       #149600
      B<12,6>PARAMWORD[$FDBR$] = UNIT;    # NUMBER OF UNITS            #149700
      RETURN;                                                           149800
      END                          # ----- SETR                        #149900
CONTROL EJECT;                                                          150000
#----------------------------------------------------------------------#150100
#                                                                      #150200
#     S E T U N                                                        #150300
#                                                                      #150400
#     PROC TO STORE THE -UN- KEYWORD AND VALUE.                        #150500
#                                                                      #150600
#----------------------------------------------------------------------#150700
                                                                        150800
      PROC  SETUN;                                                      150900
      BEGIN                                                             151000
      GETPFVALUE;                  # GET NEXT ITEM                     #151100
      IF CURLENG GR 7                                                   151200
        OR CURLENG LS 1                                                 151300
      THEN                                                              151400
        BEGIN                                                           151500
        DIAGU (247);               # ILLEGAL LENGTH USER NAME          #151600
        RETURN;                                                         151700
        END                                                             151800
                                                                        151900
      CHKHYPHENS;                  # CHECK FOR EMBEDDED HYPHENS        #152000
      IF HYPHENS                   # IF EMBEDDED HYPHENS FOUND         #152100
      THEN                                                              152200
        BEGIN                                                           152300
        DIAGU (215, "UN");         # HYPHENS ILLEGAL IN NAME           #152400
        RETURN;                                                         152500
        END                                                             152600
                                                                        152700
                                   # STORE -UN- ENTRY                  #152800
      PARAMWORD[$FDBUN$] = $DDLUN$;                                     152900
                                   # STORE VALUE                       #153000
      C<0,CURLENG>PFVALUE[$FDBUN$] = C<0,CURLENG>ICW[0];                153100
      RETURN;                                                           153200
      END                          # ----- SETUN                       #153300
                                                                        153400
CONTROL ENDIF;                                                          153500
CONTROL EJECT;                                                          153600
#----------------------------------------------------------------------#153700
#                                                                      #153800
#     M O D P F P  -  MAIN ROUTINE.                                    #153900
#                                                                      #154000
#----------------------------------------------------------------------#154100
                                                                        154200
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF NOT MODIFYFLAG                                                 154300
      THEN                         # CHANGES WERE NOT REQUESTED        #154400
        BEGIN                                                           154500
        STDYES;                                                         154600
        END                                                             154700
                                                                        154800
      DIAGSV = DIAGLEV;            # SAVE DIAG FULL/PART FLAG          #154900
      DIAGLEV = TRUE;              # SET TO DIAG FULL                  #155000
      PKEEP = PRINT;               # SAVE CURRENT VALUE OF OUTPUT FLAG #155100
      PRINT = FALSE;               # SET FOR NO TRACE OUTPUT           #155200
      XNSIZE = 0;                  # SET INIT. BUFFER LENGTH           #155300
                                   # SET UP THE LOOP TO DO THE I/O     #155400
      FOR DUMMY = DUMMY STEP 1                                          155500
      DO                                                                155600
        BEGIN                                                           155700
        PROMTYPE = 42;             # INSERT OCTAL 13 AT BIT 42 FOR NOS #
                                   # TO ACCEPT INPUT ON SAME LINE      #
        WRITE (" >>>", 4, RC);     # SEND THE STARTING MESSAGE         #155800
                                   # DO THE INPUT                      #155900
        READ  (QUIWSA, QUIRL, MXTRNLG, RC);                             156000
                                                                        156100
                                   # TEST TO SEE IF END OF MODIFY      #156200
        IF C<0,4>INWORD[0] EQ "*END"                                    156300
        THEN                                                            156400
          BEGIN                                                         156500
          INTERIN = TRUE;          # SET FOR NO OUTPUT TO TERMINAL     #156600
                                   # OUTPUT THE *END                   #156700
          WRITEBL ("          *END", 14, XNTEMP);                       156800
          INTERIN = FALSE;                                              156900
          DIAGLEV = DIAGSV;        # RESET DIAG FULL/PART FLAG         #157000
          PRINT = PKEEP;           # RESET PREVIOUS OUTPUT FLAG        #157100
          IF XNSIZE NQ 0           # IF BUFFER ALLOCATED FOR OUTPUT    #157200
          THEN                                                          157300
            BEGIN                                                       157400
            CMM$FRF(P<XNBUF>);     # FREE OUTPUT BUFFER                #157500
            END                                                         157600
                                                                        157700
          STDYES;                  # END OF MODIFY OPTIONS  RETURN     #157800
          END                                                           157900
                                                                        158000
                                   # MORE INPUT TO BE PROCESSED        #158100
        IF PKEEP                   # IF OUTPUT REQUESTED               #158200
        THEN                                                            158300
          BEGIN                                                         158400
                                   # SET WORD SIZE NEEDED FOR MOST     #158500
                                   # RECENT INPUT                      #158600
          XNTEMP = (QUIRL + 9) / 10 + 4;                                158700
          IF XNTEMP GR XNSIZE      # IF LARGER BUFFER NEEDED           #158800
          THEN                                                          158900
            BEGIN                                                       159000
            IF XNSIZE NQ 0         # IF A PREVIOUS BUFFER EXISTS       #159100
            THEN                                                        159200
              BEGIN                                                     159300
              CMM$FRF (P<XNBUF>);  # FREE PREVIOUS BUFFER              #159400
              END                                                       159500
                                                                        159600
            XNSIZE = XNTEMP;       # SET NEW BLOCK SIZE                #159700
                                   # ALLOC. BLOCK FOR NEW BUFFER       #159800
            P<XNBUF> = CMM$ALF (XNSIZE, 0, 0);                          159900
            END                                                         160000
                                                                        160100
          CHAR = 10;               # INIT. CHAR POSITION FOR STORING   #160200
                                   # PRESET BUFFER TO BLANKS           #160300
          C<0,XNSIZE*10>XNWORD[0] = $BLANKS$;                           160400
          END                                                           160500
                                                                        160600
        WP = 0;                    # SIGNAL NEW LINE TO LEXSCAN        #160700
        LEXINIT;                   # INITIALIZE LEXICAL SCAN           #160800
        LEXSCAN;                   # GET FIRST INPUT IN ICW            #160900
        IF PKEEP                   # IF OUTPUT REQUESTED               #161000
        THEN                                                            161100
          BEGIN                                                         161200
          LASTKW = "  ";           # RESET LAST KEYWORD                #161300
                                   # MOVE ITEM INTO OUTPUT LINE        #161400
          C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICWC[0];               161500
                                   # ADVANCE TO ALLOW 1 BLANK BETWEEN  #161600
          CHAR = CHAR + CURLENG + 1;                                    161700
          END                                                           161800
        CHKHYPHENS;                # CHECK LEGAL AREA NAME             #161900
        IF HYPHENS                                                      162000
          OR CURLENG GR PFN$LTH                                         162100
        THEN                       # NOT A VALID AREA NAME             #162200
          BEGIN                                                         162300
          DIAG (20);                                                    162400
          TEST DUMMY;                                                   162500
          END                                                           162600
                                                                        162700
        AREANAMEI[0] = 0;          # MOVE AREA NAME TO TEMP AREA       #162800
        AREANAMEI[1] = 0;                                               162900
        AREANAMEI[2] = 0;                                               163000
        C<0,CURLENG>AREANAMEC[0] = C<0,CURLENG>ICWC[0];                 163100
        RC = 1;                    # SET FOR NAME NOT FOUND, BUT AT    #163200
                                   # LEAST ONE TABLE PRESENT           #163300
        IF PFPTR EQ 0                                                   163400
        THEN                       # NO TABLES PRESENT                 #163500
          BEGIN                                                         163600
          RC = 0;                                                       163700
          END                                                           163800
                                                                        163900
        ELSE                       # SEARCH TABLES FOR CURRENT NAME    #164000
          BEGIN                                                         164100
          P<PFTABLE> = PFPTR;      # POINT TO FIRST TABLE              #164200
          FOR DUMMY1 = 0           # FIND TABLE WITH THIS NAME,        #164300
            WHILE P<PFTABLE> NQ 0  # IF PRESENT                        #164400
          DO                                                            164500
            BEGIN                                                       164600
            IF C<0,30>AREANAMEC[0] EQ C<0,30>PFPFN[0]                   164700
            THEN                   # NAME FOUND                        #164800
              BEGIN                                                     164900
              RC = P<PFTABLE>;     # INDICATE FOUND AND SAVE POSITION  #165000
              P<PFTABLE> = 0;      # GET OUT OF LOOP                   #165100
              END                                                       165200
                                                                        165300
            ELSE                   # ADVANCE TO NEXT TABLE             #165400
              BEGIN                                                     165500
              DUMMY2 = P<PFTABLE>; # SAVE POSITION OF THIS TABLE       #165600
              P<PFTABLE> = PFFWD[0];  # POINT TO NEXT TABLE, IF ANY    #165700
              END                                                       165800
            END                                                         165900
          END                                                           166000
                                                                        166100
        IF RC LQ 1                                                      166200
        THEN                       # IF A NEW TABLE NEEDED             #166300
          BEGIN                                                         166400
          IF RC EQ 0                                                    166500
          THEN                     # SET UP 1ST TABLE                  #166600
            BEGIN                                                       166700
                                   # ALLOCATE 1ST TABLE                #166800
            P<PFTABLE> = CMM$ALF (PF$TABLESZ, 0, 0);                    166900
            PFPTR = P<PFTABLE>;    # SET POINTER TO 1ST TABLE          #167000
            END                                                         167100
                                                                        167200
          ELSE                     # SET UP NEW TABLE                  #167300
            BEGIN                                                       167400
            P<PFTABLE> = DUMMY2;   # POINT TO LAST TABLE               #167500
                                   # ALLOCATE BLOCK                    #167600
            PFFWD[0] = CMM$ALF (PF$TABLESZ, 0, 0);                      167700
            P<PFTABLE> = PFFWD[0];                                      167800
            PFBKD[0] = DUMMY2;     # SET BACKWARD PTR TO PREV TABLE    #167900
            END                                                         168000
                                                                        168100
          PFPFN[0] = AREANAMEC[0]; # MOVE PFN INTO NEW TABLE           #168200
          END                                                           168300
                                                                        168400
        ELSE                       # IF USING AN EXISTING TABLE        #168500
          BEGIN                                                         168600
          P<PFTABLE> = RC;         # SET POINTER TO EXISTING TABLE     #168700
          END                                                           168800
                                                                        168900
                                   # LOOP THRU THE REMAINING INPUT     #169000
                                   # FOR THIS AREA (OR SUBSCHEMA)      #169100
        FOR DUMMY1 = DUMMY1 STEP 1                                      169200
        DO                                                              169300
          BEGIN                                                         169400
          LEXSCAN;                 # GET THE NEXT ITEM INTO *CURWORD*  #169500
                                   # INITIALIZE FOR SEARCHING PF PARAMS#169600
          TBLPOS = 5;              # INITIALIZE ORDINAL FOR STORING    #169700
                                   # OF PARAM CHANGES                  #169800
          IF ICW[0] EQ $BLANKS$    # IF NO MORE INPUT                  #169900
          THEN                                                          170000
            BEGIN                                                       170100
            IF PKEEP               # IF OUTPUT REQUESTED               #170200
            THEN                   # OUTPUT THE COMPLETED LINE         #170300
              BEGIN                                                     170400
              INTERIN = TRUE;      # SET FOR NO OUTPUT TO TERMINAL     #170500
              WRITEBL (XNWORD[0], CHAR, XNTEMP);                        170600
              INTERIN = FALSE;                                          170700
              END                                                       170800
                                                                        170900
            TEST DUMMY;            # END OF THIS INPUT.  LOOP          #171000
                                   # TO PROCESS THE NEXT REQUEST       #171100
            END                                                         171200
                                                                        171300
          ELSE                                                          171400
            BEGIN                                                       171500
            IF PKEEP               # IF OUTPUT REQUESTED               #171600
            THEN                   # MOVE ITEM INTO OUTPUT LINE        #171700
              BEGIN                                                     171800
              LASTKW = ICW[0];     # SET LAST PF KEYWORD               #171900
              C<CHAR,CURLENG>XNWORD[0] = C<0,CURLENG>ICW[0];            172000
                                   # ADVANCE TO ALLOW 1 BLANK BETWEEN  #172100
              CHAR = CHAR + CURLENG + 1;                                172200
              END                                                       172300
            END                                                         172400
                                                                        172500
CONTROL IFEQ  OS$NAME,SCOPE;                                            172600
                                   # NOW BRANCH TO THE CORRECT SECTION #172700
                                   # TO PROCESS THE PF KEYWORD         #172800
          IF ICW[0] EQ "CY "                                            172900
          THEN                                                          173000
            BEGIN                                                       173100
            SETCY;                 # GO PROCESS -CY- KEYWORD           #173200
            TEST DUMMY1;           # GET NEXT KEYWORD                  #173300
            END                                                         173400
                                                                        173500
          IF ICW[0] EQ "ID "                                            173600
          THEN                                                          173700
            BEGIN                                                       173800
            SETID;                 # GO PROCESS -ID- KEYWORD           #173900
            TEST DUMMY1;           # GET NEXT KEYWORD                  #174000
            END                                                         174100
                                                                        174200
          IF ICW[0] EQ "LC "                                            174300
          THEN                                                          174400
            BEGIN                                                       174500
            SETLC;                 # GO PROCESS -LC- KEYWORD           #174600
            TEST DUMMY1;           # GET NEXT KEYWORD                  #174700
            END                                                         174800
                                                                        174900
          IF ICW[0] EQ "MR "                                            175000
          THEN                                                          175100
            BEGIN                                                       175200
            SETMR;                 # GO PROCESS -MR- KEYWORD           #175300
            TEST DUMMY1;           # GET NEXT KEYWORD                  #175400
            END                                                         175500
                                                                        175600
          IF ICW[0] EQ "PW "                                            175700
          THEN                                                          175800
            BEGIN                                                       175900
            SETPW;                 # GO PROCESS -PW- KEYWORD           #176000
            TEST DUMMY1;           # GET NEXT KEYWORD                  #176100
            END                                                         176200
                                                                        176300
          IF ICW[0] EQ "RW "                                            176400
          THEN                                                          176500
            BEGIN                                                       176600
            SETRW;                 # GO PROCESS -RW- KEYWORD           #176700
            TEST DUMMY1;           # GET NEXT KEYWORD                  #176800
            END                                                         176900
                                                                        177000
          IF ICW[0] EQ "SN "                                            177100
          THEN                                                          177200
            BEGIN                                                       177300
            SETSN;                 # GO PROCESS -SN- KEYWORD           #177400
            TEST DUMMY1;           # GET NEXT KEYWORD                  #177500
            END                                                         177600
                                                                        177700
CONTROL ENDIF;                                                          177800
                                                                        177900
CONTROL IFEQ  OS$NAME,NOS;                                              178000
                                                                        178100
          IF ICW[0] EQ "M  "                                            178200
          THEN                                                          178300
            BEGIN                                                       178400
            SETM;                  # GO PROCESS -M- KEYWORD            #178500
            TEST DUMMY1;           # GET NEXT KEYWORD                  #178600
            END                                                         178700
                                                                        178800
          IF ICW[0] EQ "PN "                                            178900
          THEN                                                          179000
            BEGIN                                                       179100
            SETPN;                 # GO PROCESS -PN- KEYWORD           #179200
            TEST DUMMY1;           # GET NEXT KEYWORD                  #179300
            END                                                         179400
                                                                        179500
          IF ICW[0] EQ "PW "                                            179600
          THEN                                                          179700
            BEGIN                                                       179800
            SETPW;                 # GO PROCESS -PW- KEYWORD           #179900
            TEST DUMMY1;           # GET NEXT KEYWORD                  #180000
            END                                                         180100
                                                                        180200
          IF ICW[0] EQ "R  "                                            180300
          THEN                                                          180400
            BEGIN                                                       180500
            SETR;                  # GO PROCESS -R- KEYWORD            #180600
            TEST DUMMY1;           # GET NEXT KEYWORD                  #180700
            END                                                         180800
                                                                        180900
          IF ICW[0] EQ "UN "                                            181000
          THEN                                                          181100
            BEGIN                                                       181200
            SETUN;                 # GO PROCESS -UN- KEYWORD           #181300
            TEST DUMMY1;           # GET NEXT KEYWORD                  #181400
            END                                                         181500
                                                                        181600
CONTROL ENDIF;                                                          181700
                                                                        181800
          LASTKX = ICW[0];         # SAVE ERRONEOUS KEYWORD            #181900
          DIAGU (328, LASTKX);     # NOT A VALID KEYWORD               #182000
          TEST DUMMY;              # GET NEXT KEYWORD                  #182100
          END                                                           182200
        END                                                             182300
      END                          # ----- MODPFP                      #182400
      TERM                                                              182500
