$CONTROL MAP,CODE,USLINIT                                               00010000
<< LISTDIR2 >>                                                          00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$THIRTY                                                                 00028000
                                                               <<01205>>00030000
$CONTROL   MAIN=LISTDR2B, SEGMENT=CMD                          <<01.PV>>00032000
BEGIN                                                                   00034000
                                                                        00036000
                                                                        00038000
          <<**********************************                          00040000
          ************************************                          00042000
          **                                **                          00044000
          **                                **                          00046000
          **         L I S T D I R 2        **                 22NOV77  00048000
          **                                **                          00050000
          **                                **                          00052000
          ************************************                          00054000
          **********************************>>                          00056000
                                                                        00058000
EQUATE VUFPOS = 9;                                             <<04298>>00060000
$INCLUDE INCLVUF                                               <<04298>>00062000
DEFINE LDIRID =                                                <<04298>>00064000
      "LISTDIR5         (C) HEWLETT-PACKARD CO., 1983"#;       <<07241>>00066000
                                                                        00068000
                                                                        00070000
    COMMENT:                                                            00072000
                                                                        00074000
    << PROGRAM LISTS ACCOUNT, GROUP, AND USER ENTRY AND FILE            00076000
    << LABEL INFORMATION IN FORMATTED (IE., READABLE) FORM.             00078000
    << COMMAND INPUT IS SIMILAR IN FORMAT TO ":LISTACCT",               00080000
    << ":LISTGROUP", ":LISTUSER", AND ":LISTF" COMMANDS.                00082000
    << COMMAND OUTPUT CAN BE TERMINATED BY TYPING CONTROL-Y.            00084000
    << ACCOUNT SECURITY IS STRICTLY ENFORCED WITH SOME ADDITIONAL       00086000
    << RESTRICITONS (SEE WRITE-UP).                                     00088000
    <<                                                                  00090000
    << COMMANDS ARE READ FROM $STDIN.  ERROR MESSAGES ARE OUTPUT        00092000
    << TO $STDLIST.  FORMATTED OUTPUT IS WRITTEN TO THE LIST            00094000
    << FILE (FORMAL DESIGNATOR: "OUT") WHICH DEFAULTS TO $STDLIST       00096000
    << UNLESS "PARM=1" IS SPECIFIED ON THE :RUN COMMAND IN WHICH        00098000
    << CASE A :FILE EQUATION OVERRIDES THE FOPEN PARAMETERS.            00100000
    << FORMATTED OUTPUT CAN BE DIRECTED TO ANOTHER FILE BY              00102000
    << SPECIFYING A LIST FILE ON THE COMMAND.                           00104000
    <<                                                                  00106000
    << PROGRAM ABORTS WITH THE FOLLOWING PARAMETERS:                    00108000
    <<     1 -- FAILURE TO OPEN LIST FILE ("OUT")                       00110000
    <<     2 -- WRITE ERROR ON $STDLIST                                 00112000
    <<     3 -- READ ERROR ON $STDIN                                    00114000
    <<     4 -- FAILURE TO OPEN $STDIN;                                 00116000
$PAGE                                                                   00118000
    COMMENT:                                                            00120000
                                                                        00122000
                                                                        00124000
          ***********************                                       00126000
          *                     *                                       00128000
          * GENERAL DESCRIPTION *                                       00130000
          *                     *                                       00132000
          ***********************                                       00134000
                                                                        00136000
                                                                        00138000
    << PROGRAM CONSISTS OF TWO MODULES:  COMMAND INTERPRETER AND        00140000
    << FORMATTER.  A THIRD MODULE, "DIRECSCAN", RESIDES IN MPE.         00142000
    <<                                                                  00144000
    << THE COMMAND INTERPRETER PROMPTS FOR, READS, AND PARSES ALL       00146000
    << COMMANDS.  THIS SECTION TAKES CARE OF INITIALIZING GLOBALS       00148000
    << AND ERROR RECOVERY.  AFTER SUCCESSFULLY SCANNING A COMMAND,      00150000
    << THE COMMAND INTERPRETER CALLS "CALLDIRECSCAN" WHICH SETS         00152000
    << UP THE CALL TO THE MPE INTRINSIC "DIRECSCAN".  "CALLDIRECSCAN"   00154000
    << TAKES CARE OF PROTECTING THE SYSTEM BY CALLING "ERRORON"         00156000
    << TO TURN OFF TRAPS AND SET THE MPE FLAG IN THE PCB AND BY         00158000
    << DISABLING BREAK TO AVOID ANY POSSIBLE DEADLOCKS WHILE IN         00160000
    << "DIRECSCAN".  ON RETURNING FROM "CALLDIRECSCAN", CARRY IS        00162000
    << SET IF "DIRECSCAN" SET THE CONDITION CODE (INDICATING AN         00164000
    << ERROR).                                                          00166000
    <<                                                                  00168000
    << THE FORMATTER EXECUTES AS A CO-ROUTINE WITH "DIRECSCAN".         00170000
    << AT EACH APPROPRIATE NODE (DETERMINED BY THE TYPE OF SEARCH       00172000
    << DEFINED BY THE 'DIRLEV' PARAMETER TO "DIRECSCAN"), "DIRECSCAN"   00174000
    << CALLS "FMTENTRY" TO PROCESS THE ENTRY.  THIS SECTION MOVES       00176000
    << THE DIRECTORY ENTRY ONTO THE STACK SEGMENT AND PROCEEDS TO       00178000
    << TO FORMAT THE INFORMATION.  THE INFORMATION IS LISTED,           00180000
    << AND THE SECTION RETURNS TO "DIRECSCAN".  THE FORMATTER           00182000
    << ABNORMALLY TERMINATES THE DIRECTORY SCAN ON AN I/O ERROR         00184000
    << AND WHEN CONTROL-Y HAS BEEN SENSED.                              00186000
    <<                                                                  00188000
    << CONTROL-Y CANNOT BE TRAPPED WHILE EXECUTING IN THE FORMATTER     00190000
    << BECAUSE THE DIRECTORY SYSTEM OWNS A SIR (AND HAS SET             00192000
    << CRITICAL).  CONTROL-Y IS SENSED BY STROBING THE CONTROL-Y        00194000
    << BIT IN THE PCB DURING THE OUTPUT LOOP IN THE FORMATTER --        00196000
    << THIS BIT IS SET WHEN THE DRIVER RECEIVES THE CONTROL-Y.          00198000
    << THE CONTROL-Y IS ACTED ON WHEN "CALLDIRECSCAN" RETURNS TO        00200000
    << THE COMMAND INTERPRETER.                                         00202000
    <<                                                                  00204000
    << SINCE THE DIRECTORY SYSTEM HAS SET CRITICAL, THE FORMATTER       00206000
    << MUST NOT ABORT (EG., CALL "QUIT") BECAUSE THIS WOULD CAUSE       00208000
    << A "SUDDEN DEATH" (SOFTWARE SYSTEM HALT).  CONSEQUENTLY,          00210000
    << FLAGS (BITS (0:2)) MUST BE SET WHEN CALLING "ERROR" TO           00212000
    << ENSURE A RETURN TO THE FORMATTER.                                00214000
    <<                                                                  00216000
    << ON ENTRY TO "FMTENTRY", DB IS POINTING TO THE DIRECTORY          00218000
    << DATA SEGMENT -- THE DB-RELATIVE ADDRESS OF THE DIRECTORY         00220000
    << ENTRY IS PASSED TO "FMTENTRY" THROUGH 'ENTRIE'.  (BECAUSE        00222000
    << DB IS NOT POINTING TO THE STACK SEGMENT, "FMTENTRY" MUST         00224000
    << HAVE NO LOCAL ARRAYS OR INITIALIZATION WHICH WOULD EMIT          00226000
    << DB-RELATIVE-ADDRESSING CODE BEFORE DB IS SWITCHED.)  THE         00228000
    << ENTRY IS TRANSFERRED TO THE TOP OF THE STACK SEGMENT WITH        00230000
    << THE "MVBL" INSTRUCTION (WHOSE TARGET ADDRESS IS DL-RELATIVE      00232000
    << AND SOURCE ADDRESS IS DB-RELATIVE).  DB IS THEN SWITCHED         00234000
    << TO THE STACK SEGMENT.  THE SIR ON THE DIRECTORY (PASSED          00236000
    << THROUGH 'SIR') IS NOT RELEASED UNTIL AFTER THE FILE LABEL        00238000
    << AND RECORD ZERO OF THE PROGRAM FILE ARE READ (IF APPLICABLE).    00240000
    <<                                                                  00242000
    << BEFORE RETURNING TO "DIRECSCAN", THE SIR MUST HAVE BEEN          00244000
    << RELEASED AND DB MUST BE SWITCHED BACK TO THE DIRECTORY           00246000
    << DATA SEGMENT.  ADDITIONALLY, BITS (13:2) OF THE RETURN           00248000
    << VALUE (OF "FMTENTRY") CAN BE SET TO 2 TO CAUSE AN (ABNORMAL)     00250000
    << TERMINATION OF THE DIRECTORY SEARCH BY "DIRECSCAN".              00252000
    <<                                                                  00254000
    << "ERROR" OUTPUTS AN APPROPRIATE ERROR MESSAGE ON $STDLIST.        00256000
    << THE PARAMETER TO "ERROR" ('ERR') CONSISTS OF TWO BYTES:          00258000
    << THE RIGHT BYTE CONTAINING THE ERROR NUMBER, AND THE LEFT         00260000
    << BYTE CONSISTING OF FLAGS.  NORMALLY "ERROR" RETURNS TO A         00262000
    << POINT IN THE COMMAND INTERPRETER ('REINIT') SET UP BY THE        00264000
    << COMMAND INTERPRETER.  IF BIT ZERO OF THE FLAGS IS SET,           00266000
    << HOWEVER, "ERROR" RETURNS DIRECTLY TO THE CALLER.  "ERROR"        00268000
    << USUALLY RETURNS A CONDITION CODE CCE.  IF AN I/O ERROR           00270000
    << OCCURS ON $STDLIST, "ERROR" ABORTS UNLESS BIT ONE OF THE         00272000
    << FLAGS IS SET -- IN THAT CASE, "ERROR" RETURNS TO THE CALLER      00274000
    << WITH A CONDITION CODE CCG.                                       00276000
$PAGE                                                                   00278000
    << COMMAND SYNTAX                                                   00280000
    << --------------                                                   00282000
    <<                                                                  00284000
    << (NB: ":" REPRESENTS A SEMICOLON.)                     <<29NOV77>>00286000
    <<                                                                  00288000
    << LISTACCT  [<ASET>] [,<LISTFILE>] [:PASS]                         00290000
    << LISTGROUP [<GSET>] [,<LISTFILE>] [:PASS]                         00292000
    << LISTUSER  [<USET>] [,<LISTFILE>] [:PASS]                         00294000
    << LISTF      <FSET>  [,<LISTFILE>] [:PASS] [:MAP]                  00296000
    << LISTSEC    <FSET>  [,<LISTFILE>] [:PASS]                         00298000
    << HELP      [<LISTFILE>]                                <<29NOV77>>00300000
    << MOUNT     [<VDESIG>] [:GEN=[<GENINX>]]                <<30NOV77>>00302000
    << DISMOUNT                                              <<30NOV77>>00304000
    << EXIT                                                  <<30NOV77>>00306000
    <<                                                                  00308000
    << <ASET>    ::= <ACCT NAME>                             <<21NOV77>>00310000
    << <GSET>    ::= <GROUP NAME> [.<ACCT NAME>]             <<21NOV77>>00312000
    << <FSET>    ::= <FILE NAME>                             <<21NOV77>>00314000
    <<               [.<GROUP NAME> [.<ACCT NAME>]]          <<22NOV77>>00316000
    << <LISTFILE>::= [*  //  $] <FILE NAME> [/<LOCKWORD>]               00318000
    <<               [.<GROUP NAME> [.<ACCT NAME>]]                     00320000
    << <VDESIG>  ::= (* // <VSET NAME>)                      <<30NOV77>>00322000
    <<               [.<GROUP NAME>[.<ACCT NAME>]]           <<30NOV77>>00324000
    <<                                                                  00326000
    << THE DEFAULT SET IS THE LOG-ON IDENTITY.                          00328000
    <<                                                       <<22NOV77>>00330000
    << AN <ASET>, <GSET> AND <FSET> NAME MAY BE A GENERIC               00332000
    << NAME, VIZ.: A SEQUENCE OF UP TO 8 ALPHANUMERIC                   00334000
    << CHARACTERS, "?", "#", AND "@".  THE LATTER THREE                 00336000
    << HAVE THE FOLLOWING MEANINGS:                                     00338000
    <<     "?" MATCHES EXACTLY ONE ALPHANUMERIC CHARACTER    <<21NOV77>>00340000
    <<     "#" MATCHES EXACTLY ONE NUMERIC CHARACTER         <<21NOV77>>00342000
    <<     "@" MATCHES ZERO OR MORE ALPHANUMERIC CHARACTERS. <<21NOV77>>00344000
    << A NON-MANAGER CANNOT SPECIFIY GENERIC ACCOUNT AND     <<21NOV77>>00346000
    << GROUP NAMES.  AN ACCOUNT MANAGER CANNOT SPECIFY A     <<21NOV77>>00348000
    << GENERIC ACCOUNT NAME.  THIS NOT ONLY PREVENTS A       <<21NOV77>>00350000
    << MALICIOUS USER FROM TYING UP THE DIRECTORY -- IT ALSO <<21NOV77>>00352000
    << RESTRICTS THE AMOUNT OF INFORMATION A MALICIOUS USER  <<21NOV77>>00354000
    << CAN LEARN!                                            <<21NOV77>>00356000
    <<                                                                  00358000
    << IF THE <LISTFILE> REFERS TO A :FILE EQUATION, THE "*" FORM       00360000
    << (INDICATING A BACK-REFERENCE) MUST BE USED.                      00362000
    <<                                                                  00364000
    << "PASS" LISTS THE PRIVILEGED FILECODE, FILE LABEL ADDRESS,        00366000
    << PASSWORDS, AND FILE CREATOR AND LOCKWORD.                        00368000
    <<                                                                  00370000
    << "LISTSEC" LISTS (ONLY) THE TOTAL SECURITY, INCLUDING:            00372000
    <<     ACCOUNT SECURITY                                             00374000
    <<     GROUP SECURITY                                               00376000
    <<     FILE SECURITY                                                00378000
    <<     MISCELLANEOUS SECURITY-RELATED INFORMATION                   00380000
    <<     EFFECTIVE FILE SECURITY FOR THE LOG-ON USER.                 00382000
    <<                                                                  00384000
    << "MAP" LISTS THE EXTENT MAP.                                      00386000
    <<                                                                  00388000
    << "PASS" AND "MAP" ARE USEABLE ONLY BY QUALIFIED USERS, VIZ.:      00390000
    << FILE CREATOR, ACCOUNT MANAGER, AND/OR SYSTEM MANAGER.            00392000
    <<                                                       <<01DEC77>>00394000
    << "MOUNT" AND "DISMOUNT" COMMANDS ARE FOR PRIVATE VOLUME<<30NOV77>>00396000
    << SETS AND REQUIRE "UV" OR "SM" CAPABILITY TO BE USED.  <<30NOV77>>00398000
    << COMMANDS SUBSEQUENT TO "MOUNT" REFER TO ENTRIES ON    <<30NOV77>>00400000
    << THE PRIVATE VOLUME.  ("LISTUSER" COMMAND USES THE     <<04DEC77>>00402000
    << SYSTEM, NOT PV, DIRECTORY FOR USER INFORMATION.)  THE <<04DEC77>>00404000
    << VOLUME REMAINS MOUNTED UNTIL A SUBSEQUENT "DISMOUNT"  <<04DEC77>>00406000
    << OR "MOUNT".                                           <<04DEC77>>00408000
    << ;                                                                00410000
$PAGE                                                                   00412000
    COMMENT:                                                            00414000
    << CURRENT BUFFER REQUIREMENTS (IN WORDS):                          00416000
    <<     SECURITY: 350     FILE:      744                    <<00864>>00418000
    <<     ACCOUNT:  258       LABEL:   440                    <<00864>>00420000
    <<     GROUP:    259       EXT MAP: 240                    <<00864>>00422000
    <<     USER:     126       PROGRAM:  64;                            00424000
EQUATE WBUFLEN=744,                                            <<00864>>00426000
       WBUFLEN1=WBUFLEN-1;                                              00428000
ARRAY WBUF(-1:WBUFLEN1):="  ",WBUFLEN("  ");                            00430000
BYTE ARRAY BUF(*)=WBUF,                                                 00432000
           HOMGRP(0:7),                                                 00434000
           LOUSR(0:7),                                                  00436000
           LOGRP(0:7),                                                  00438000
           LOACCT(0:7);                                                 00440000
BYTE ARRAY BAS1(*)=S-1;                                                 00442000
DOUBLE DLOCAP,                                                          00444000
       ORGADR;                              <<FOR UPSTACK RECOVERY>>    00446000
EQUATE LPDEV=32;                                                        00448000
INTEGER S1=S-1,                                                         00450000
        S0=S-0,                                                         00452000
        ABORT:=0,                                                       00454000
        STDIN,                                                          00456000
        CMDTYP,                                                         00458000
        ORGQ,                               <<FOR                 >>    00460000
        ORGTOS,                             <<    UPSTACK RECOVERY>>    00462000
        OUT,                                                            00464000
        ORGOUT,                                                         00466000
        LASTOUT:=0,                                                     00468000
        NXTLN,                                                          00470000
        LOTERM,                                                         00472000
        DEVTYP,                                                         00474000
        PVINFO:=0,                                           <<01DEC77>>00476000
        MVTABX:=0,                                             <<11.KM>>00478000
        REQTYPE,                                             <<01DEC77>>00480000
        FIRSTTIME:=0;                                                   00482000
LOGICAL EOL,                                <<END-OF-COMMAND FLAG>>     00484000
        ECHO,                                                           00486000
        LP,                                                             00488000
        ORGLP:=0,                                                       00490000
        LASTLP,                                                         00492000
        GIVEPASS,                           <<TRUE IF "PASS" SPEC'D>>   00494000
        SECONLY,                            <<TRUE IF "LISTSEC" SPEC'D>>00496000
        EXTMAP,                             <<TRUE IF "MAP" SPEC'D>>    00498000
        ALLCLASS,                           <<TRUE IF GEN NAME>>        00500000
        PVFLAG,                                                <<06137>>00502000
        PVDONE:=FALSE,  << PV file display already printed? >> <<*8675>>00504000
        USERSPECD=Q-4,                                                  00506000
        USERDEV:=0,                                                     00508000
        LOCAP=DLOCAP,                       <<USER/FILE-ACC ATTRS>>     00510000
        LOCAP2=DLOCAP+1;                    <<CAP-CLASS ATTRS>>         00512000
INTEGER POINTER PCB=3;                                         <<07241>>00514000
DEFINE                                                         <<07241>>00516000
   PCB'SIZE        = PCB(1)#,                                  <<07241>>00518000
   MPEV'PCB'SIZE   = %25#;                                     <<07241>>00520000
DEFINE                                                         <<*8833>>00522000
   DEF'SYSDIRBASE1  = ABSOLUTE (%1130)#,                       <<*8833>>00524000
   DEF'SYSDIRBASE2  = ABSOLUTE (%1131)#,                       <<*8833>>00526000
   SYSLDEV = 1#;                                               <<*8833>>00528000
DEFINE                                                         <<01.PV>>00530000
   PVF=               0:1 #,                                   <<11.KM>>00532000
   MVTABXF=           4:4 #,                                 <<04DEC77>>00534000
   STARTLEVELF     = 13:3 #,                                   <<01.PV>>00536000
   ENDLEVELF       = 10:3 #,                                   <<01.PV>>00538000
   ALLFLAG         =  9:1 #,                                   <<01.PV>>00540000
   ENDLEVELFX      =  9:4 #,                                   <<01.PV>>00542000
   TOLEVELF        =  6:3 #,                                   <<01.PV>>00544000
   HITFLAG         =  5:1 #;                                   <<01.PV>>00546000
EQUATE                                                         <<01.PV>>00548000
   FILELEVEL       = 0,                                        <<01.PV>>00550000
   GROUPLEVEL      = 1,                                        <<01.PV>>00552000
   ACCOUNTLEVEL    = 2,                                        <<01.PV>>00554000
   USERLEVEL       = 3,                                        <<01.PV>>00556000
   VSDEFLEVEL      = 4,                                        <<01.PV>>00558000
   VSLISTLEVEL     = 5;                                        <<01.PV>>00560000
EQUATE                                                         <<01.PV>>00562000
   ALLXXX          = %(2) 1000,                                <<01.PV>>00564000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<01.PV>>00566000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<01.PV>>00568000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<01.PV>>00570000
   ALLFILES        = ALLXXX + FILELEVEL,                       <<01.PV>>00572000
   ALLVSDS         = ALLXXX + VSDEFLEVEL,                      <<01.PV>>00574000
   ALLVSLS         = ALLXXX + VSLISTLEVEL;                     <<01.PV>>00576000
                                                                        00578000
DEFINE D'INX=   DPARMS #,              <<"PRODUCEPARMS" FMT>><<01DEC77>>00580000
       D'INX1=  PARMS #,                                       <<11.KM>>00582000
       D'TYPE=  PARMS(2) #,                                  <<13NOV77>>00584000
       D'FNAME= PARMS(3) #,                                  <<13NOV77>>00586000
       D'VNAME= PARMS(3) #,                                  <<13NOV77>>00588000
       D'GNAME= PARMS(7) #,                                  <<13NOV77>>00590000
       D'UNAME= PARMS(7) #,                                  <<13NOV77>>00592000
       D'ANAME= PARMS(11) #,                                 <<13NOV77>>00594000
       G'FNAME= PARMS(15) #,                                 <<13NOV77>>00596000
       G'VNAME= PARMS(15) #,                                 <<13NOV77>>00598000
       G'GNAME= PARMS(19) #,                                 <<13NOV77>>00600000
       G'UNAME= PARMS(19) #,                                 <<13NOV77>>00602000
       G'ANAME= PARMS(23) #,                                 <<13NOV77>>00604000
       D'BFNAME= BPARMS(6) #,                                <<13NOV77>>00606000
       D'BVNAME= BPARMS(6) #,                                <<13NOV77>>00608000
       D'BGNAME= BPARMS(14) #,                               <<13NOV77>>00610000
       D'BUNAME= BPARMS(14) #,                               <<13NOV77>>00612000
       D'BANAME= BPARMS(22) #,                               <<13NOV77>>00614000
       G'BFNAME= BPARMS(30) #,                               <<13NOV77>>00616000
       G'BVNAME= BPARMS(30) #,                               <<13NOV77>>00618000
       G'BGNAME= BPARMS(38) #,                               <<13NOV77>>00620000
       G'BUNAME= BPARMS(38) #,                               <<13NOV77>>00622000
       G'BANAME= BPARMS(46) #;                               <<13NOV77>>00624000
                                                             <<01DEC77>>00626000
DEFINE VS'GENINX= PARMS #,           <<"PARSEMOUNT" FMT>>    <<03DEC77>>00628000
       VS'NAME=   PARMS(1) #,                                <<03DEC77>>00630000
       VS'GNAME=  PARMS(5) #,                                <<03DEC77>>00632000
       VS'ANAME=  PARMS(9) #,                                <<03DEC77>>00634000
       VS'BGNAME= BPARMS(10) #,                              <<03DEC77>>00636000
       VS'BANAME= BPARMS(18) #;                              <<03DEC77>>00638000
                                                             <<13NOV77>>00640000
EQUATE FNAMEBASE=      19,                                   <<13NOV77>>00642000
       GNAMEBASE=      24,                                   <<30NOV77>>00644000
       ANAMEBASE=      29,                                   <<30NOV77>>00646000
       UNAMEBASE=      34,                                   <<30NOV77>>00648000
       VNAMEBASE=      39,                                   <<30NOV77>>00650000
       BADPARAM=        5,                                   <<01DEC77>>00652000
       BADDESIG=        7,                                   <<13NOV77>>00654000
       NONLOGONACCT=    8,                                   <<01DEC77>>00656000
       NONLOGONGRP=     9,                                   <<01DEC77>>00658000
       MISSINGPARAM=   12,                                   <<01DEC77>>00660000
       NOLOCKWORD=     14,                                   <<01DEC77>>00662000
       VMISSINGNAME=   40,                                   <<03DEC77>>00664000
       VMISSINGDELIM=  42,                                   <<03DEC77>>00666000
       NONUV=          44,                                   <<01DEC77>>00668000
       PVERROR=        45,                                   <<01DEC77>>00670000
       NOTIMPLEMENTED= 46,                                   <<01DEC77>>00672000
       BADGENINX=      47,                                     <<11.KM>>00674000
       NOMOUNT=        48;                                     <<11.KM>>00676000
                                                             <<02DEC77>>00678000
  DEFINE SUBR'MFDS4=                                         <<03DEC77>>00680000
           SUBROUTINE MFDS4(DBADR,DST,OFFSET,LENGTH);        <<03DEC77>>00682000
                           VALUE DBADR,DST,OFFSET,LENGTH;    <<03DEC77>>00684000
                           POINTER DBADR;                    <<02DEC77>>00686000
                           INTEGER DST,OFFSET,LENGTH;        <<03DEC77>>00688000
           BEGIN                                             <<02DEC77>>00690000
             ASSEMBLE(STAX;            <<SAVE RETN ADDR>>    <<03DEC77>>00692000
                      MFDS 4;                                <<03DEC77>>00694000
                      LDXA);                                 <<03DEC77>>00696000
             RETURN 0;                                       <<03DEC77>>00698000
           END  <<SUBROUTINE MFDS4>> #;                      <<03DEC77>>00700000
$INCLUDE INCLPXG                                               <<07073>>00702000
$PAGE                                                                   00704000
        PROCEDURE ERROR(ERR); VALUE ERR; INTEGER ERR; OPTION FORWARD;   00706000
      PROCEDURE GETFNAME(QNAME,NONFATAL);                               00708000
      VALUE QNAME,NONFATAL;                                             00710000
      BYTE POINTER QNAME;                                               00712000
      LOGICAL NONFATAL;                                                 00714000
      OPTION FORWARD;                                                   00716000
                                                                        00718000
PROCEDURE GET'FILEMNEMONIC(FILECODE,MNEMONIC,MNEMONIC'LENGTH); <<01454>>00720000
INTEGER FILECODE,MNEMONIC'LENGTH;                              <<01454>>00722000
BYTE ARRAY MNEMONIC;                                           <<01454>>00724000
OPTION EXTERNAL;                                               <<01454>>00726000
                                                                        00728000
                                                                        00730000
LOGICAL PROCEDURE ACCCHECK(LEVL,ANAME,ASEC,GNAME,GSEC,CR,FSEC,UINFO);   00732000
                          VALUE LEVL,ASEC,GSEC,FSEC; INTEGER LEVL;      00734000
                          BYTE ARRAY ANAME,GNAME,CR,UINFO; LOGICAL ASEC;00736000
                          DOUBLE GSEC,FSEC; OPTION VARIABLE,EXTERNAL;   00738000
                                                               <<*7980>>00740000
DOUBLE  PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);  00742000
                       VALUE LDEV,FLAGS,DSTX,QMISC,ADDR,FUNC,CNT,P1,P2; 00744000
                INTEGER LDEV,FLAGS,DSTX,QMISC,ADDR,FUNC,CNT,P1,P2;      00746000
                       OPTION EXTERNAL;                                 00748000
                                                               <<*7980>>00750000
DOUBLE  PROCEDURE DIRECSCAN (DIRLEV,INX,ANAME,GUNAME,FNAME,    <<35.PV>>00752000
                             RECIP,PARM,MVTABX);               <<35.PV>>00754000
                           VALUE DIRLEV,INX,MVTABX;            <<35.PV>>00756000
                           INTEGER DIRLEV,MVTABX;              <<38.PV>>00758000
                           DOUBLE INX;                         <<38.PV>>00760000
                           ARRAY ANAME,GUNAME,FNAME,PARM;               00762000
                           INTEGER PROCEDURE RECIP;            <<35.PV>>00764000
                           OPTION EXTERNAL,VARIABLE;           <<35.PV>>00766000
                                                               <<*7980>>00768000
        PROCEDURE ERROREXIT(WDS,ERR,PARM); VALUE WDS,ERR,PARM;          00770000
                           INTEGER WDS,ERR,PARM; OPTION EXTERNAL;       00772000
                                                               <<*7980>>00774000
        PROCEDURE ERRORON; OPTION EXTERNAL;                             00776000
                                                               <<*7980>>00778000
LOGICAL PROCEDURE EXCHANGEDB(DST); VALUE DST; LOGICAL DST;              00780000
                            OPTION EXTERNAL;                            00782000
                                                               <<*7980>>00784000
INTEGER PROCEDURE LUN (VTABINX,MVTABX);                        <<01.PV>>00786000
    VALUE   VTABINX,MVTABX;                                    <<01.PV>>00788000
    INTEGER VTABINX,MVTABX;                                    <<01.PV>>00790000
    OPTION EXTERNAL;                                           <<01.PV>>00792000
                                                               <<*7980>>00794000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,M,P1,P2,P3,P4,P5,         <<*7980>>00796000
         D,R,O,DST,C);                                         <<*7980>>00798000
   VALUE SETNO,MSGNO,M,P1,P2,P3,P4,P5,D,R,O,DST,C;             <<*7980>>00800000
   INTEGER SETNO,MSGNO,D,DST;                                  <<*7980>>00802000
   LOGICAL M,P1,P2,P3,P4,P5,R,O,C;                             <<*7980>>00804000
   OPTION EXTERNAL,VARIABLE;                                   <<*7980>>00806000
                                                               <<*7980>>00808000
        PROCEDURE RELSIR(S,A); VALUE S,A; INTEGER S,A; OPTION EXTERNAL; 00810000
                                                               <<06137>>00812000
DOUBLE PROCEDURE CALLDIRECSCAN(RECIP,PARMS,MVTABX);            <<06137>>00814000
       VALUE MVTABX;                                           <<06137>>00816000
       INTEGER PROCEDURE RECIP;                                <<06137>>00818000
       ARRAY PARMS;                                            <<06137>>00820000
       INTEGER MVTABX;                                         <<06137>>00822000
       OPTION PRIVILEGED,FORWARD;                              <<06137>>00824000
                                                               <<06137>>00826000
INTRINSIC WHO, READ, PRINT, ASCII, DASCII, FOPEN, FWRITE, QUIT,         00828000
GETUSERMODE,TERMINATE,FGETINFO,GETPRIVMODE,FCONTROL,FRELATE;   <<07241>>00830000
INTRINSIC RESETCONTROL,XCONTRAP, FCHECK, FCLOSE, READX;        <<02321>>00832000
                                                                        00834000
          <<-------------------->>                                      00836000
$PAGE "          PROCEDURE MATCH"                            <<13NOV77>>00838000
$CONTROL   SEGMENT=FMT1                                                 00840000
                                                                        00842000
                                                                        00844000
INTEGER PROCEDURE MATCH(DESIGNATOR,REALNAME);                           00846000
                       VALUE DESIGNATOR,REALNAME;                       00848000
                       BYTE POINTER DESIGNATOR,REALNAME;                00850000
BEGIN <<PROCEDURE MATCH>>                        <<REPLACED>><<19DEC77>>00852000
  COMMENT:                                                              00854000
    COMPARES GENERIC AND DIRECTORY NAMES AND RETURNS AN                 00856000
    INDICATOR OF THE MATCH, VIZ.:                                       00858000
                                                                        00860000
      -1 = INITIAL SUBSTRING OF "DESIGNATOR" IS LESS                    00862000
           THAN "REALNAME"                                              00864000
       0 = "DESIGNATOR" AND "REALNAME" MATCH                            00866000
       1 = "DESIGNATOR" AND "REALNAME" DO NOT MATCH.                    00868000
                                                                        00870000
    NOTE THAT -1 CAN BE RETURNED ONLY IF THE INITIAL                    00872000
    SUBSTRING OF "DESIGNATOR" STARTS WITH AN ALPHABETIC                 00874000
    CHARACTER.                                                          00876000
                                                                        00878000
    ASCERTIONS:                                                         00880000
      (1) "DESIGNATOR" CONTAINS ONLY ALPHANUMERIC, "?",                 00882000
          "#" AND "@" CHARACTERS                                        00884000
      (2) "DESIGNATOR" DOES NOT CONTAIN THE SEQUENCES                   00886000
          "@?" & "@@" (THESE SHOULD BE CONVERTED TO                     00888000
          "?@" & "@" BY THE PATTERN BUILDER)                            00890000
      (3) "REALNAME" CONTAINS ONLY ALPHANUMERIC CHARACTERS              00892000
      (4) "DESIGNATOR" & "REALNAME" ARE 8 BYTES LONG, WITH              00894000
          BLANK-FILL ON THE RIGHT                                       00896000
      (5) "DESIGNATOR" & "REALNAME" ARE BOTH THE SAME CASE,             00898000
          VIZ. UPPER- OR LOWER-CASE;                                    00900000
                                                                        00902000
                                                                        00904000
  EQUATE NOCODE= -2,                                                    00906000
         LTCODE= -1,                                                    00908000
         EQCODE=  0,                                                    00910000
         GTCODE=  1;                                                    00912000
                                                                        00914000
  BYTE POINTER DLEFT,                                                   00916000
               NLEFT;                                                   00918000
  INTEGER X=         X,                                                 00920000
          MATCHCODE= MATCH;                                             00922000
                                                                        00924000
  ARRAY NEXTQ(*)=    Q;                                                 00926000
  BYTE POINTER DPTR= NEXTQ,                                             00928000
               NPTR= DPTR+1;                                            00930000
  INTEGER LENGTH=    NPTR+1;                                            00932000
                                                                        00934000
                                                                        00936000
  <<**********************>>                                            00938000
  << DEFINE CHECK'ENDCOND >>                                            00940000
  <<**********************>>                                            00942000
                                                                        00944000
  DEFINE CHECK'ENDCOND=                                                 00946000
    BEGIN                                                               00948000
      COMMENT:                                                          00950000
        ENSURE THAT BOTH "DPTR" AND "NPTR" STRINGS ARE                  00952000
        EXHAUSTED.  IF EQCODE, THEN AT LEAST ONE STRING                 00954000
        IS EXHAUSTED;                                                   00956000
                                                                        00958000
      IF MATCHCODE=EQCODE THEN                                          00960000
      BEGIN                                                             00962000
        IF @DPTR=@DESIGNATOR(8) THEN                                    00964000
        BEGIN                                                           00966000
          IF @NPTR<>@REALNAME(8) AND                                    00968000
             NPTR<>" " THEN MATCH:=GTCODE;                              00970000
        END                                                             00972000
        ELSE                                                            00974000
          IF DPTR<>" " THEN                                             00976000
          BEGIN                                                         00978000
            IF DPTR<>"@" OR                                             00980000
               @DPTR<>@DESIGNATOR(7) AND                                00982000
               DPTR(1)<>" " THEN MATCH:=GTCODE;                         00984000
          END;                                                          00986000
      END;                                                              00988000
    END <<DEFINE CHECK'ENDCOND>>#;                                      00990000
                                                                        00992000
  <<************************>>                                          00994000
  << DEFINE FIND'MATCHSTART >>                                          00996000
  <<************************>>                                          00998000
                                                                        01000000
  DEFINE FIND'MATCHSTART=                                               01002000
    BEGIN                                                               01004000
      COMMENT:                                                          01006000
        SCAN "NPTR" FOR MATCH WITH CHARACTER FOLLOWING                  01008000
        "@" IN "DSTR".  SAVE POSITION IN "NLEFT" AND                    01010000
        SET "LENGTH" TO LENGTH OF COMPARE;                              01012000
                                                                        01014000
      IF DPTR="#" THEN                                                  01016000
      BEGIN                                                             01018000
        WHILE (LENGTH:=LENGTH-1)>=0 AND                                 01020000
              NPTR<>NUMERIC DO @NPTR:=@NPTR+1;                          01022000
      END                                                               01024000
      ELSE BEGIN                                                        01026000
        WHILE (LENGTH:=LENGTH-1)>=0 AND                                 01028000
              NPTR<>DPTR DO @NPTR:=@NPTR+1;                             01030000
      END;                                                              01032000
                                                                        01034000
      LENGTH:=LENGTH+1;                                                 01036000
      IF <= THEN MATCH:=GTCODE                                          01038000
      ELSE BEGIN                                                        01040000
        @NLEFT:=@NPTR;                                                  01042000
        LENGTH:=MIN(@DESIGNATOR(8)-@DPTR,                               01044000
                    @REALNAME(8)-@NPTR);                                01046000
      END;                                                              01048000
    END <<DEFINE FIND'MATCHSTART>>#;                                    01050000
                                                                        01052000
  <<*************************>>                                         01054000
  << DEFINE LESSER'SUBSTRING >>                                         01056000
  <<*************************>>                                         01058000
                                                                        01060000
  DEFINE LESSER'SUBSTRING=                                              01062000
    < AND (DPTR<>SPECIAL OR DPTR=" ") #;                                01064000
                                                                        01066000
  <<**************************>>                                        01068000
  << DEFINE RESET'MATCHSTART >>                                         01070000
  <<**************************>>                                        01072000
                                                                        01074000
  DEFINE RESET'MATCHSTART=                                              01076000
    BEGIN                                                               01078000
      COMMENT:                                                          01080000
        S-2 = @DPTR                                                     01082000
        S-1 = @NPTR                                                     01084000
        S-0 = LENGTH OF COMPARE.                                        01086000
                                                                        01088000
        BACK-UP POINTERS SO THAT "@" WILL MATCH LONGER                  01090000
        SUBSTRING.  "DPTR" IS RESET TO THE RIGHT OF                     01092000
        LAST "@".  "NPTR" IS RESET TO THE RIGHT OF LAST                 01094000
        INITIAL MATCH DETERMINED BY "FIND'MATCHSTART";                  01096000
                                                                        01098000
      @NLEFT:=@NLEFT+1;                                                 01100000
      DEL; DDEL;                                                        01102000
      TOS:=@DLEFT;                                                      01104000
      TOS:=@NLEFT;                                                      01106000
      TOS:=@REALNAME(8)-@NLEFT;                                         01108000
      MATCH:=NOCODE;                                                    01110000
      FIND'MATCHSTART;                                                  01112000
    END <<DEFINE RESET'MATCHSTART>>#;                                   01114000
                                                                        01116000
  <<*********************>>                                             01118000
  << DEFINE TURNOFFTRAPS >>                                             01120000
  <<*********************>>                                             01122000
                                                                        01124000
  DEFINE TURNOFFTRAPS=                                                  01126000
    BEGIN                                                               01128000
      COMMENT:                                                          01130000
        AVOID INTEGER OVERFLOW FOR BYTE ADDRESS                         01132000
        ARITHMETIC;                                                     01134000
                                                                        01136000
      PUSH(STATUS);                                                     01138000
      TOS.(2:1):=0;                                                     01140000
      SET(STATUS);                                                      01142000
    END <<DEFINE TURNOFFTRAPS>>#;                                       01144000
                                                                        01146000
  <<****************>>                                                  01148000
  << SUBROUTINE MIN >>                                                  01150000
  <<****************>>                                                  01152000
                                                                        01154000
  INTEGER SUBROUTINE MIN(I,J); VALUE I,J; INTEGER I,J;                  01156000
  BEGIN                                                                 01158000
    MIN:=IF I<=J THEN I ELSE J;                                         01160000
  END <<SUBROUTINE MIN>>;                                               01162000
                                                                        01164000
  <<********************>>                                              01166000
  << SUBROUTINE CLOSURE >>                                              01168000
  <<********************>>                                              01170000
                                                                        01172000
  LOGICAL SUBROUTINE CLOSURE;                                           01174000
  BEGIN                                                                 01176000
    COMMENT:                                                            01178000
      RETURN "TRUE" IF WE'VE ENCOUNTERED AN EMBEDDED                    01180000
      "@" (CLOSURE WILDCARD).  WE ASSUME THAT WE'VE                     01182000
      DONE A "SIMPLEMATCH" FIRST.  THUS, FAILURE TO                     01184000
      FIND CLOSURE WILDCARD MEANS THAT NO FURTHER                       01186000
      MATCH IS POSSIBLE (MATCH=GTCODE).  NOTE THAT                      01188000
      IF CLOSURE WILDCARD IS AT THE END OF "DPTR",                      01190000
      THE MATCH IS DONE (MATCH=EQCODE) SINCE IT WILL                    01192000
      MATCH REMAINDER OF "NPTR";                                        01194000
                                                                        01196000
    CLOSURE:=FALSE;                                                     01198000
    IF MATCHCODE=NOCODE THEN                                            01200000
    BEGIN                                                               01202000
      IF DPTR<>"@" THEN MATCH:=GTCODE                                   01204000
      ELSE                                                              01206000
        IF @DPTR=@DESIGNATOR(7) OR                                      01208000
           DPTR(1)=" " THEN MATCH:=EQCODE                               01210000
      ELSE IF NPTR=" " THEN MATCH:=GTCODE                               01212000
      ELSE BEGIN                                                        01214000
        @DPTR:=@DPTR+1;                                                 01216000
        @DLEFT:=@DPTR;                                                  01218000
        LENGTH:=@REALNAME(8)-@NPTR;                                     01220000
        FIND'MATCHSTART;                                                01222000
        IF MATCHCODE=NOCODE THEN CLOSURE:=TRUE;                         01224000
      END;                                                              01226000
    END;                                                                01228000
  END <<SUBROUTINE CLOSURE>>;                                           01230000
                                                                        01232000
  <<************************>>                                          01234000
  << SUBROUTINE SIMPLEMATCH >>                                          01236000
  <<************************>>                                          01238000
                                                                        01240000
  SUBROUTINE SIMPLEMATCH;                                               01242000
  BEGIN                                                                 01244000
    COMMENT:                                                            01246000
      S-3 = @DPTR                                                       01248000
      S-2 = @NPTR                                                       01250000
      S-1 = LENGTH OF COMPARE                                           01252000
      S-0 = "SIMPLEMATCH" RETURN ADDRESS.                               01254000
                                                                        01256000
      MATCH ALPHANUMERIC CHARACTERS AND SINGLE-BYTE                     01258000
      WILDCARD CHARACTERS ("?" AND "#");                                01260000
                                                                        01262000
    X:=TOS;                            <<SAVE RETN ADDR>>               01264000
    DO BEGIN                                                            01266000
      IF * <> *,(TOS),0 THEN                                            01268000
      BEGIN                                                             01270000
        WHILE DPTR="?" AND NPTR<>SPECIAL OR                             01272000
              DPTR="#" AND NPTR=NUMERIC DO                              01274000
        BEGIN                                                           01276000
          @DPTR:=@DPTR+1;                                               01278000
          ASSEMBLE(INCB,DECA);                                          01280000
          IF = THEN GO EXITWHILE;                                       01282000
        END;                                                            01284000
                                                                        01286000
  EXITWHILE:                                                            01288000
      END;                                                              01290000
    END UNTIL LENGTH=0 OR DPTR<>NPTR;                                   01292000
    IF = THEN MATCH:=EQCODE;                                            01294000
    TOS:=X;                            <<RESET RETN ADDR>>              01296000
  END <<SUBROUTINE SIMPLEMATCH>>;                                       01298000
                                                                        01300000
                                                                        01302000
  <<***********************>>                                           01304000
  <<                       >>                                           01306000
  << BEGIN PROCEDURE MATCH >>                                           01308000
  <<                       >>                                           01310000
  <<***********************>>                                           01312000
                                                                        01314000
  TURNOFFTRAPS;                                                         01316000
  IF DESIGNATOR=REALNAME,(8),0 THEN MATCH:=EQCODE                       01318000
  ELSE IF LESSER'SUBSTRING THEN MATCH:=LTCODE                           01320000
  ELSE BEGIN                                                            01322000
    COMMENT:                                                            01324000
      S-2 = @DPTR                                                       01326000
      S-1 = @NPTR                                                       01328000
      S-0 = COMPARE LENGTH;                                             01330000
                                                                        01332000
    MATCH:=NOCODE;                                                      01334000
    SIMPLEMATCH;                                                        01336000
    IF CLOSURE THEN                                                     01338000
    BEGIN                                                               01340000
      DO BEGIN                                                          01342000
        DO SIMPLEMATCH UNTIL NOT CLOSURE;                               01344000
        CHECK'ENDCOND;                                                  01346000
        IF MATCHCODE<>EQCODE THEN RESET'MATCHSTART;                     01348000
      END UNTIL MATCHCODE<>NOCODE;                                      01350000
    END;                                                                01352000
  END;                                                                  01354000
END <<PROCEDURE MATCH>>;                                                01356000
$PAGE "          PROCEDURE DATELINE"                         <<13NOV77>>01358000
$CONTROL   SEGMENT=FMT1                                      <<13NOV77>>01360000
                                                                        01362000
                                                                        01364000
PROCEDURE DATELINE(STRING,YRMODA);                                      01366000
                  BYTE ARRAY STRING;                                    01368000
                  LOGICAL YRMODA;                                       01370000
BEGIN                                                                   01372000
  COMMENT:                                                              01374000
  << MODIFIED VERSION OF MPE "DATE'LINE".  ROUTINE CONVERTS             01376000
  << A DATE-STAMP INTO ASCII STRING;                                    01378000
                                                                        01380000
                                                                        01382000
  BYTE ARRAY DAYS(*)=PB:="SUNMONTUEWEDTHUFRISAT";                       01384000
  BYTE ARRAY MONTHS(*)=PB:="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";      01386000
  INTEGER YEAR=Q+1,                                                     01388000
          DAY=YEAR+1,                                                   01390000
          X=X;                                                          01392000
  INTEGER ARRAY DAYSPERMONTH(*)=PB:=0,31,60,91,121,152,182,213,         01394000
                                    244,274,305,335;                    01396000
                                                                        01398000
          <<-------------------->>                                      01400000
                                                                        01402000
  SUBROUTINE CONVERT(N,POSITION);                                       01404000
                    VALUE N,POSITION;                                   01406000
                    INTEGER N,POSITION;                                 01408000
  BEGIN                                                                 01410000
        COMMENT:                                                        01412000
        << CONVERTS A TWO-DIGIT DECIMAL NUMBER TO ASCII STRING;         01414000
    X:=POSITION;                                                        01416000
    TOS:=N;                                                             01418000
    TOS:=10;                                                            01420000
    ASSEMBLE(DIV,XCH);                                                  01422000
    STRING(X):=TOS+"0";                                                 01424000
    STRING(X:=X+1):=TOS+"0";                                            01426000
  END  <<SUBROUTINE CONVERT>>;                                          01428000
                                                                        01430000
          <<-------------------->>                                      01432000
                                                                        01434000
    TOS:=YRMODA;                                                        01436000
    IF = THEN MOVE STRING:="*UNRECOGNIZABLE DATE*"             <<06145>>01438000
      ELSE BEGIN                                                        01440000
        TOS:=TOS.(0:7);                     <<YEAR>>                    01442000
        TOS:=YRMODA.(7:9);                  <<DAY OF YEAR>>             01444000
        X:=((YEAR-1)&ASR(2)+YEAR+DAY) MOD 7  *  3;                      01446000
        MOVE STRING:=DAYS(X),(3),2;                                     01448000
        MOVE * := ",  # MMM 19##";                                      01450000
        IF YEAR.(14:2)<>0 AND DAY>=60 THEN DAY:=DAY+1;  <<LEAP YEAR>>   01452000
        TOS:=@STRING(8);                                                01454000
        X:=12;                                                          01456000
        DO X:=X-1 UNTIL DAYSPERMONTH(X)<DAY;                            01458000
        DAY:=DAY-DAYSPERMONTH(X);                                       01460000
        MOVE * := MONTHS(X*3),(3);                                      01462000
        IF DAY<10 THEN STRING(6):=DAY+"0"                               01464000
          ELSE CONVERT(DAY,5);                                          01466000
        CONVERT(YEAR,14);                                               01468000
      END;                                                              01470000
END  <<PROCEDURE DATELINE>>                                             01472000
;                                                                       01474000
$PAGE "          PROCEDURE PUTNAME"                            <<00446>>01476000
$CONTROL   SEGMENT=FMT1                                        <<00446>>01478000
                                                               <<00446>>01480000
                                                               <<00446>>01482000
INTEGER PROCEDURE PUTNAME(BUF,NAME1,NAME2,NAME3);              <<00446>>01484000
                 VALUE BUF,NAME1,NAME2,NAME3;                  <<00446>>01486000
                 BYTE POINTER BUF,NAME1,NAME2,NAME3;           <<00446>>01488000
                 OPTION VARIABLE;                              <<00446>>01490000
BEGIN                                                          <<00446>>01492000
  COMMENT:                                                     <<00446>>01494000
  <<THIS PROCEDURE FORMATS THE NAMES AS FOLLOWS:               <<00446>>01496000
  <<  1) NAME1.NAME2.NAME3.                                    <<00446>>01498000
  <<  2) NAME1.NAME2  (NAME3 NOT PASSED),                      <<00446>>01500000
  <<  3) NAME1        (NAME2&NAME3 NOT PASSED).                <<00446>>01502000
  <<IF NAME2 IS PASSED THEN NAME1 MUST ALSO BE PASSED,         <<00446>>01504000
  <<IF NAME3 IS PASSED THEN NAME2 MUST BE PASSED.              <<00446>>01506000
  <<NAME# CONSISTS OF 8 CHAR WITH TRAILING BLANKS.             <<00446>>01508000
  <<NO CHECK IS MADE FOR ALL BLANK NAMES.                      <<00446>>01510000
  <<WE RETURN THE LEN OF THE FORMATTED NAME.                   <<00446>>01512000
  ;                                                            <<00446>>01514000
                                                               <<00446>>01516000
  LOGICAL PARMMASK=Q-4;                                        <<00446>>01518000
  DEFINE NAME2'PASSED=PARMMASK.(14:1) #,                       <<00446>>01520000
         NAME3'PASSED=PARMMASK #;                              <<00446>>01522000
  INTEGER X=X,                                                 <<00446>>01524000
          LEN;                                                 <<00446>>01526000
                                                               <<00446>>01528000
            <<-------------------->>                           <<00446>>01530000
                                                               <<00446>>01532000
  INTEGER SUBROUTINE MOVENAME(BUF,NAME);                       <<00446>>01534000
                            VALUE BUF,NAME;                    <<00446>>01536000
                            BYTE POINTER BUF,NAME;             <<00446>>01538000
                                                               <<00446>>01540000
  BEGIN                                                        <<00446>>01542000
    COMMENT:                                                   <<00446>>01544000
    << THIS SUBROUTINE MOVES 'NAME' TO 'BUF', REMOVING         <<00446>>01546000
    << TRAILING BLANKS.  IT RETURNS THE LEN OF 'NAME';         <<00446>>01548000
                                                               <<00446>>01550000
    MOVE BUF:=NAME,(8);                                        <<00446>>01552000
    IF BUF(7)=" " THEN                                         <<00446>>01554000
        BEGIN << DEBLANK >>                                    <<00446>>01556000
        SCAN BUF UNTIL " ",1;                                  <<00446>>01558000
        X:=TOS;                                                <<00446>>01560000
        MOVENAME:=X-@BUF;                                      <<00446>>01562000
        END                                                    <<00446>>01564000
    ELSE MOVENAME:=8;                                          <<00446>>01566000
  END  <<SUBROUTINE MOVENAME>>                                 <<00446>>01568000
  ;                                                            <<00446>>01570000
  LEN:=MOVENAME(BUF,NAME1);                                    <<00446>>01572000
  IF NAME2'PASSED THEN                                         <<00446>>01574000
      BEGIN                                                    <<00446>>01576000
      BUF(LEN):=".";                                           <<00446>>01578000
      LEN:=LEN+1;                                              <<00446>>01580000
      LEN:=LEN+MOVENAME(BUF(LEN),NAME2);                       <<00446>>01582000
      IF NAME3'PASSED THEN                                     <<00446>>01584000
          BEGIN                                                <<00446>>01586000
          BUF(LEN):=".";                                       <<00446>>01588000
          LEN:=LEN+1;                                          <<00446>>01590000
          LEN:=LEN+MOVENAME(BUF(LEN),NAME3);                   <<00446>>01592000
          END <<NAME3>>;                                       <<00446>>01594000
      END <<NAME2>>;                                           <<00446>>01596000
  PUTNAME:=LEN;                                                <<00446>>01598000
END  <<PROCEDURE PUTNAME>>                                     <<00446>>01600000
;                                                              <<00446>>01602000
$PAGE "          PROCEDURE FMTCAP"                             <<00446>>01604000
$CONTROL   SEGMENT=FMT1                                                 01606000
                                                                        01608000
                                                                        01610000
PROCEDURE FMTCAP(BUF,USRATTR,CAP);                                      01612000
                VALUE USRATTR,CAP;                                      01614000
                BYTE ARRAY BUF;                                         01616000
                LOGICAL USRATTR;                                        01618000
                LOGICAL POINTER CAP;                                    01620000
BEGIN                                                                   01622000
  BYTE POINTER BPS0=S-0;                                                01624000
  INTEGER                                                      <<*8729>>01626000
     CAP'LEN,     << length of capabilities list >>            <<*8729>>01628000
     EXTRA'LEN,   << length of list rolled over to next line >><<*8729>>01630000
     ORIG'POS;    << original position of extra capability >>  <<*8729>>01632000
                                                                        01634000
          <<-------------------->>                                      01636000
                                                                        01638000
    TOS:=@BUF;                                                          01640000
    IF USRATTR THEN                                                     01642000
      BEGIN                                                             01644000
        IF CAP.( 0:1) THEN MOVE * := "SM,",2;                           01646000
        IF CAP.( 1:1) THEN MOVE * := "AM,",2;                           01648000
        IF CAP.( 2:1) THEN MOVE * := "AL,",2;                           01650000
        IF CAP.( 3:1) THEN MOVE * := "GL,",2;                           01652000
        IF CAP.( 4:1) THEN MOVE * := "DI,",2;                           01654000
        IF CAP.( 5:1) THEN MOVE * := "OP,",2;                           01656000
        IF CAP.( 6:1) THEN MOVE * := "CV,",2;                  <<02.PV>>01658000
        IF CAP.( 7:1) THEN MOVE * := "UV,",2;                  <<02.PV>>01660000
         IF CAP.(8:1) THEN MOVE * := "LG,",2;                           01662000
        IF CAP.(10:1) THEN MOVE * := "PS,",2;                  << 8154>>01664000
           IF CAP.(11:1) THEN MOVE * := "NA,",2;               <<06984>>01666000
           IF CAP.(12:1) THEN MOVE * := "NM,",2;               <<06984>>01668000
        IF CAP.(13:1) THEN MOVE * := "CS,",2;                           01670000
        IF CAP.(14:1) THEN MOVE * := "ND,",2;                           01672000
        IF CAP.(15:1) THEN MOVE * := "SF,",2;                           01674000
        @CAP:=@CAP+1;                                                   01676000
      END;                                                              01678000
    IF CAP.( 8:1) THEN MOVE * := "IA,",2;                               01680000
    IF CAP.( 7:1) THEN MOVE * := "BA,",2;                               01682000
    IF CAP.(15:1) THEN MOVE * := "PH,",2;                               01684000
    IF CAP.(14:1) THEN MOVE * := "DS,",2;                               01686000
    IF CAP.(12:1) THEN MOVE * := "MR,",2;                               01688000
    <<IF CAP.(11:1) THEN MOVE * := "RT,",2;>>                <<09DEC77>>01690000
    <<IF CAP.(10:1) THEN MOVE * := "CR,",2;>>                <<09DEC77>>01692000
    IF CAP.( 9:1) THEN MOVE * := "PM,",2;                               01694000
    <<IF CAP.( 6:1) THEN MOVE * := "NS,",2;>>                <<09DEC77>>01696000
                                                               <<*8729>>01698000
    << Roll over excess length of capabilities to next line >> <<*8729>>01700000
    IF (CAP'LEN := @BPS0-@BUF) > 57 THEN                       <<*8729>>01702000
       BEGIN                                                   <<*8729>>01704000
       EXTRA'LEN := CAP'LEN - 57;                              <<*8729>>01706000
       ORIG'POS := EXTRA'LEN + 2;                              <<*8729>>01708000
       TOS := TOS + 2;                                         <<*8729>>01710000
       MOVE * := BPS0(-ORIG'POS), (EXTRA'LEN), 2;              <<*8729>>01712000
       ORIG'POS := (2 * EXTRA'LEN) + 2;                        <<*8729>>01714000
       MOVE BPS0(-ORIG'POS) := " ";                            <<*8729>>01716000
       MOVE BPS0(-ORIG'POS+1) := BPS0(-ORIG'POS),              <<*8729>>01718000
                                 (EXTRA'LEN-1);                <<*8729>>01720000
       END;                                                    <<*8729>>01722000
    BPS0(-1):=" ";                                           <<09DEC77>>01724000
END  <<PROCEDURE FMTCAP>>                                               01726000
;                                                                       01728000
$PAGE "          PROCEDURE FMTFCODE"                         <<15NOV77>>01730000
$CONTROL   SEGMENT=FMT2                                                 01732000
                                                                        01734000
                                                                        01736000
PROCEDURE FMTFCODE(FLCODE,PMOKAY,BUF);                                  01738000
                  VALUE FLCODE,PMOKAY,BUF;                              01740000
                  INTEGER FLCODE;                                       01742000
                  LOGICAL PMOKAY;                                       01744000
                  BYTE POINTER BUF;                                     01746000
BEGIN <<PROCEDURE FMTCODE>>                      <<ADDED>><<15NOV77>>   01748000
  BYTE POINTER BPS0=S-0;                                                01750000
  INTEGER LENGTH;                                              <<01454>>01752000
  INTRINSIC ASCII;                                                      01754000
                                                                        01756000
                                                                        01758000
  MOVE BUF:="FCODE: ",2;                                                01760000
                                                               <<01454>>01762000
  GET'FILEMNEMONIC(FLCODE,BPS0,LENGTH);                        <<01454>>01764000
  IF <> THEN  << NO MNEMONIC FOR FILE CODE >>                  <<01454>>01766000
     IF (FLCODE < 0) AND (NOT PMOKAY)                          <<01454>>01768000
        THEN MOVE BPS0 := "PRIV"                               <<01454>>01770000
        ELSE ASCII(FLCODE,10,BPS0);                            <<01454>>01772000
  DEL;                                                         <<01454>>01774000
END  <<PROCEDURE FMTFCODE>>;                                            01776000
$PAGE "          PROCEDURE FMTSEC"                                      01778000
$CONTROL   SEGMENT=FMT1                                                 01780000
                                                                        01782000
                                                                        01784000
PROCEDURE FMTSEC(BUF,SEC);                                              01786000
                VALUE SEC;                                              01788000
                BYTE ARRAY BUF;                                         01790000
                LOGICAL SEC;                                            01792000
BEGIN                                                                   01794000
  BYTE POINTER BPS0=S-0;                                                01796000
                                                                        01798000
          <<-------------------->>                                      01800000
                                                                        01802000
    TOS:=@BUF;                                                          01804000
    IF SEC.(10:1) THEN MOVE * := "ANY,",2;                              01806000
    IF SEC.(11:1) THEN MOVE * := "AC,",2;                               01808000
    IF SEC.(12:1) THEN MOVE * := "AL,",2;                               01810000
    IF SEC.(13:1) THEN MOVE * := "GU,",2;                               01812000
    IF SEC.(14:1) THEN MOVE * := "GL,",2;                               01814000
    IF SEC.(15:1) THEN MOVE * := "CR"                                   01816000
      ELSE BEGIN                                                        01818000
        BPS0(-1):=" ";                                                  01820000
        <<DEL;>>                                                        01822000
      END;                                                              01824000
END  <<PROCEDURE FMTSEC>>                                               01826000
;                                                                       01828000
$PAGE "          PROCEDURE FMTSECINFO"                                  01830000
$CONTROL   SEGMENT=FMT2                                                 01832000
                                                                        01834000
                                                                        01836000
LOGICAL PROCEDURE FMTSECINFO(ENT,ENTB,LEVEL,LINEL,GPART);               01838000
                            VALUE LEVEL;                                01840000
                            INTEGER ARRAY ENT,LINEL;                    01842000
                            BYTE ARRAY ENTB;                            01844000
                            INTEGER LEVEL;                              01846000
                            BYTE POINTER GPART;                         01848000
                            OPTION PRIVILEGED;                          01850000
BEGIN                                                                   01852000
  DEFINE ADSEC    = ENT(26) #,                                          01854000
         GDSEC    = ENTD1(10) #;                                        01856000
  DEFINE FLFNAME  = ENTB #,                                             01858000
         FLGNAME  = ENTB(8) #,                                          01860000
         FLANAME  = ENTB(16) #,                                         01862000
         FLCR     = ENTB(24) #,                                         01864000
         FLPASS   = ENTB(32) #,                                         01866000
         FLSEC    = ENTD(10) #,                                         01868000
         FLSEC1   = ENT(20) #,                                          01870000
         FLSEC2   = ENT(21) #,                                          01872000
         FLRSEC   = FLSEC1.(2:6) #,                                     01874000
         FLASEC   = FLSEC1.(8:6) #,                                     01876000
         FLWSEC   = LOGICAL(INTEGER(FLSEC&DCSR(12))) LAND %77 #,        01878000
         FLLSEC   = FLSEC2.(4:6) #,                                     01880000
         FLXSEC   = FLSEC2.(10:6) #,                                    01882000
         FLSECURE = LOGICAL(ENT(22)) #,                                 01884000
        FLFTYPE  =ENT(36).(2:3)#,                              <<01719>>01886000
         FLCODE   = ENT(26) #;                                          01888000
  DEFINE OWNGRSYSSEC = GSYSSEC1.(2:5)&LSL(1) #,                <<06137>>01890000
         OWNGASYSSEC = GSYSSEC1.(7:5)&LSL(1) #,                <<06137>>01892000
         OWNGWSYSSEC = LOGICAL(INTEGER(GSYSSEC&DCSR(14)))      <<06137>>01894000
                       LAND %76 #,                             <<06137>>01896000
         OWNGLSYSSEC = GSYSSEC1(1).(1:5)&LSL(1) #,             <<06137>>01898000
         OWNGXSYSSEC = GSYSSEC1(1).(6:5)&LSL(1) #,             <<06137>>01900000
         OWNGSSYSSEC = GSYSSEC1(1).(11:5)&LSL(1) #,            <<06137>>01902000
         OWNARSYSSEC = ASYSSEC.(4:2)&LSL(4) #,                 <<06137>>01904000
         OWNAASYSSEC = ASYSSEC.(6:2)&LSL(4) #,                 <<06137>>01906000
         OWNAWSYSSEC = ASYSSEC.(8:2)&LSL(4) #,                 <<06137>>01908000
         OWNALSYSSEC = ASYSSEC.(10:2)&LSL(4) #,                <<06137>>01910000
         OWNAXSYSSEC = ASYSSEC.(12:2)&LSL(4) #,                <<06137>>01912000
         OWNGRPVSEC  = GPVSEC1.(2:5)&LSL(1) #,                 <<06137>>01914000
         OWNGAPVSEC  = GPVSEC1.(7:5)&LSL(1) #,                 <<06137>>01916000
         OWNGWPVSEC  = LOGICAL(INTEGER(GPVSEC&DCSR(14)))       <<06137>>01918000
                       LAND %76 #,                             <<06137>>01920000
         OWNGLPVSEC  = GPVSEC1(1).(1:5)&LSL(1) #,              <<06137>>01922000
         OWNGXPVSEC  = GPVSEC1(1).(6:5)&LSL(1) #,              <<06137>>01924000
         OWNGSPVSEC  = GPVSEC1(1).(11:5)&LSL(1) #,             <<06137>>01926000
         OWNARPVSEC  = APVSEC.(4:2)&LSL(4) #,                  <<06137>>01928000
         OWNAAPVSEC  = APVSEC.(6:2)&LSL(4) #,                  <<06137>>01930000
         OWNAWPVSEC  = APVSEC.(8:2)&LSL(4) #,                  <<06137>>01932000
         OWNALPVSEC  = APVSEC.(10:2)&LSL(4) #,                 <<06137>>01934000
         OWNAXPVSEC  = APVSEC.(12:2)&LSL(4) #;                 <<06137>>01936000
  DEFINE BLANKLINE= TOS:=TOS+2 #,                                       01938000
         AM= LOCAP&CSL(2) #,                                            01940000
         SM= INTEGER(LOCAP)<0 #,                                        01942000
         PM= LOCAP2&LSR(6) #;                                           01944000
  DEFINE BLANKSEC= BEGIN                                       <<06137>>01946000
                   MOVE BUF(S0):="                   ",2;      <<06137>>01948000
                   FMTSEC(*,0);                                <<06137>>01950000
                   END#;                                       <<06137>>01952000
  EQUATE SLCOL=42,                                           <<15NOV77>>01954000
         SLCOL2=SLCOL-2,                                                01956000
         SDLLEN=23,                                                     01958000
         SDLLEN2=SDLLEN-2,                                     <<06137>>01960000
         PVCOL=34;                                             <<06137>>01962000
  OWN DOUBLE GSYSSEC,GPVSEC;                                   <<06137>>01964000
  OWN INTEGER ASYSSEC,APVSEC;                                  <<06137>>01966000
  ARRAY SDL(*)=PB:=SDLLEN2,16,1,5(30),1,6(30),1,28,2(30),29,19,<<06137>>01968000
                   1,27;                                       <<06137>>01970000
  BYTE ARRAY BSTARS(*)=PB:="**";                                        01972000
  BYTE ARRAY WRITESEC(*)=PB:="SECURITY--WRITE:   ";            <<06137>>01974000
  BYTE ARRAY CREATOR(*)=PB:="CREATOR: ";                                01976000
  BYTE ARRAY LOCKWORD(*)=PB:="LOCKWORD: ";                              01978000
  BYTE ARRAY APPEND(*)=PB:="APPEND:  ";                                 01980000
  BYTE ARRAY LOCK(*)=PB:="LOCK:    ";                                   01982000
  BYTE ARRAY EXECUTE(*)=PB:="EXECUTE: ";                                01984000
  BYTE ARRAY SAVE(*)=PB:="SAVE:    ";                                   01986000
  BYTE ARRAY SECON(*)=PB:="**SECURITY IS ON";                           01988000
  BYTE POINTER BPS0=S-0;                                                01990000
  DOUBLE POINTER ENTD1=S-0,                                             01992000
                 ENTD=ENT;                                              01994000
  INTEGER X=X,                                                          01996000
          S0=S-0,                                                       01998000
          RESULT=FMTSECINFO;                                            02000000
  INTEGER POINTER GSYSSEC1=GSYSSEC;                            <<06137>>02002000
  INTEGER POINTER GPVSEC1 =GPVSEC;                             <<06137>>02004000
  LOGICAL OKAY:=0,                     <<TRUE IF SM OR AM>>             02006000
          CROKAY:=0,                   <<TRUE IF SM,AM, OR CR>>         02008000
          ACC;                                                          02010000
                                                                        02012000
          <<--------------------->>                                     02014000
                                                                        02016000
  SUBROUTINE FMTFNAME;                                                  02018000
  BEGIN                                                                 02020000
    MOVE BUF:="FILE: ",2;                                               02022000
    MOVE * := FLFNAME,(8),2;                                            02024000
    TOS:=TOS-8;                                                         02026000
    SCAN * UNTIL " ",1;                                                 02028000
    BPS0:=".";                                                          02030000
    TOS:=TOS+1;                                                         02032000
    @GPART:=S0;                                                         02034000
    MOVE * := FLGNAME,(8),2;                                            02036000
    TOS:=TOS-8;                                                         02038000
    SCAN * UNTIL " ",1;                                                 02040000
    BPS0:=".";                                                          02042000
    TOS:=TOS+1;                                                         02044000
    MOVE * := FLANAME,(8);                                              02046000
  END  <<SUBROUTINE FMTFNAME>>                                          02048000
  ;                                                                     02050000
                                                                        02052000
          <<-------------------->>                                      02054000
                                                                        02056000
    COMMENT:                                                   <<06137>>02058000
    << WE MUST SAVE BOTH SYS AND PV SECURITY DEPENDING         <<06137>>02060000
    << ON MVTABX;                                              <<06137>>02062000
                                                               <<06137>>02064000
    CASE *(2-LEVEL) OF BEGIN                                            02066000
      IF MVTABX = 0 THEN ASYSSEC := ADSEC                      <<06137>>02068000
                    ELSE APVSEC  := ADSEC;                     <<06137>>02070000
      BEGIN                                                             02072000
        TOS:=@ENT+1;                        <<ENTD1>>                   02074000
        IF MVTABX = 0 THEN GSYSSEC := GDSEC                    <<06137>>02076000
                      ELSE GPVSEC  := GDSEC;                   <<06137>>02078000
        <<DEL;>>                                                        02080000
        NXTLN:=61;                                                      02082000
      END;                                                              02084000
      BEGIN                                                             02086000
        IF GIVEPASS THEN                                                02088000
          BEGIN                                                         02090000
                COMMENT:                                                02092000
                << ONLY SYSTEM MANAGER, OR ACCOUNT MANAGER OF THIS      02094000
                << ACCOUNT, CAN GET TO FILE LOCKWORDS & CREATOR IDS;    02096000
            IF SM OR AM AND LOACCT=FLANAME,(8) THEN OKAY:=1;            02098000
                COMMENT:                                                02100000
                << SM, AM, OR PRIVILEGED USER CAN DISPLAY PRIVILEGED    02102000
                << FILE CODES;                                          02104000
            IF OKAY OR LOUSR=FLCR,(8) AND LOACCT=FLANAME,(8)            02106000
              THEN CROKAY:=1;                                           02108000
          END;                                                          02110000
        FMTFNAME;                                                       02112000
        TOS:=32;                            <<INX INTO 'BUF'>>          02114000
        BLANKLINE;                                                      02116000
            COMMENT:                                                    02118000
            << FORMAT ACCOUNT SECURITY;                                 02120000
        MOVE BUF(S0):="SYSTEM    READ:    ",2;                 <<06137>>02122000
        FMTSEC(*,OWNARSYSSEC);                                 <<06137>>02124000
        TOS := TOS + PVCOL;                                    <<06137>>02126000
        IF MVTABX<>0 THEN                                      <<06137>>02128000
           BEGIN                                               <<06137>>02130000
           MOVE BUF(S0) :="PV        READ:    ",2;             <<06137>>02132000
           FMTSEC(*,OWNARPVSEC);                               <<06137>>02134000
           END                                                 <<06137>>02136000
        ELSE BLANKSEC;                                         <<06137>>02138000
        TOS:=TOS+26;                                           <<06137>>02140000
        MOVE BUF(S0):=WRITESEC,(19),2;                         <<06137>>02142000
        FMTSEC(*,OWNAWSYSSEC);                                 <<06137>>02144000
        TOS := TOS+PVCOL;                                      <<06137>>02146000
        IF MVTABX<>0 THEN                                      <<06137>>02148000
           BEGIN                                               <<06137>>02150000
           MOVE BUF(S0) := WRITESEC,(19),2;                    <<06137>>02152000
           FMTSEC(*,OWNAWPVSEC);                               <<06137>>02154000
           END                                                 <<06137>>02156000
        ELSE BLANKSEC;                                         <<06137>>02158000
        TOS:=TOS+26;                                                    02160000
        MOVE BUF(S0):=" (ACCT)   APPEND:  ",2;                 <<06137>>02162000
        FMTSEC(*,OWNAASYSSEC);                                 <<06137>>02164000
        TOS := TOS + PVCOL;                                    <<06137>>02166000
        IF MVTABX<>0 THEN                                      <<06137>>02168000
           BEGIN                                               <<06137>>02170000
           MOVE BUF(S0) := " (ACCT)   APPEND:  ",2;            <<06137>>02172000
           FMTSEC(*,OWNAAPVSEC);                               <<06137>>02174000
           END                                                 <<06137>>02176000
        ELSE BLANKSEC;                                         <<06137>>02178000
        TOS:=TOS+26;                                                    02180000
        X:=S0;                                                          02182000
        MOVE BUF(X:=X+10):=LOCK,(9),2;                                  02184000
        FMTSEC(*,OWNALSYSSEC);                                 <<06137>>02186000
        TOS := TOS + PVCOL;                                    <<06137>>02188000
        IF MVTABX<>0 THEN                                      <<06137>>02190000
           BEGIN                                               <<06137>>02192000
           X := S0;                                            <<06137>>02194000
           MOVE BUF(X:=X+10):=LOCK,(9),2;                      <<06137>>02196000
           FMTSEC(*,OWNALPVSEC);                               <<06137>>02198000
           END                                                 <<06137>>02200000
        ELSE BLANKSEC;                                         <<06137>>02202000
        TOS:=TOS+26;                                                    02204000
        X:=S0;                                                          02206000
        MOVE BUF(X:=X+10):=EXECUTE,(9),2;                               02208000
        FMTSEC(*,OWNAXSYSSEC);                                 <<06137>>02210000
        TOS := TOS + PVCOL;                                    <<06137>>02212000
        IF MVTABX<>0 THEN                                      <<06137>>02214000
           BEGIN                                               <<06137>>02216000
           X := S0;                                            <<06137>>02218000
           MOVE BUF(X:=X+10):=EXECUTE,(9),2;                   <<06137>>02220000
           FMTSEC(*,OWNAXPVSEC);                               <<06137>>02222000
           END                                                 <<06137>>02224000
        ELSE BLANKSEC;                                         <<06137>>02226000
        TOS:=TOS+26;                                                    02228000
            COMMENT:                                                    02230000
            << FORMAT GROUP SECURITY;                                   02232000
        BLANKLINE;                                                      02234000
        MOVE BUF(S0):="SYSTEM    READ:    ",2;                 <<06137>>02236000
        FMTSEC(*,OWNGRSYSSEC);                                 <<06137>>02238000
        TOS := TOS + PVCOL;                                    <<06137>>02240000
        IF MVTABX<>0 THEN                                      <<06137>>02242000
           BEGIN                                               <<06137>>02244000
           MOVE BUF(S0) := "PV        READ     ",2;            <<06137>>02246000
           FMTSEC(*,OWNGRPVSEC);                               <<06137>>02248000
           END                                                 <<06137>>02250000
        ELSE BLANKSEC;                                         <<06137>>02252000
        TOS:=TOS+26;                                           <<06137>>02254000
        MOVE BUF(S0):=WRITESEC,(19),2;                         <<06137>>02256000
        FMTSEC(*,OWNGWSYSSEC);                                 <<06137>>02258000
        TOS := TOS + PVCOL;                                    <<06137>>02260000
        IF MVTABX<>0 THEN                                      <<06137>>02262000
           BEGIN                                               <<06137>>02264000
           MOVE BUF(S0) := WRITESEC,(19),2;                    <<06137>>02266000
           FMTSEC(*,OWNGWPVSEC);                               <<06137>>02268000
           END                                                 <<06137>>02270000
        ELSE BLANKSEC;                                         <<06137>>02272000
        TOS:=TOS+26;                                           <<06137>>02274000
        X:=S0;                                                          02276000
        MOVE BUF(S0):=" (GROUP)  APPEND:  ",2;                 <<06137>>02278000
        FMTSEC(*,OWNGASYSSEC);                                 <<06137>>02280000
        TOS := TOS + PVCOL;                                    <<06137>>02282000
        IF MVTABX<>0 THEN                                      <<06137>>02284000
           BEGIN                                               <<06137>>02286000
           MOVE BUF(S0):=" (GROUP)  APPEND:  ",2;              <<06137>>02288000
           FMTSEC(*,OWNGAPVSEC);                               <<06137>>02290000
           END                                                 <<06137>>02292000
        ELSE BLANKSEC;                                         <<06137>>02294000
        TOS:=TOS+26;                                           <<06137>>02296000
        X:=S0;                                                          02298000
        MOVE BUF(X:=X+10):=LOCK,(9),2;                                  02300000
        FMTSEC(*,OWNGLSYSSEC);                                 <<06137>>02302000
        TOS := TOS + PVCOL;                                    <<06137>>02304000
        IF MVTABX<>0 THEN                                      <<06137>>02306000
           BEGIN                                               <<06137>>02308000
           X := S0;                                            <<06137>>02310000
           MOVE BUF(X:=X+10):=LOCK,(9),2;                      <<06137>>02312000
           FMTSEC(*,OWNGLPVSEC);                               <<06137>>02314000
           END                                                 <<06137>>02316000
        ELSE BLANKSEC;                                         <<06137>>02318000
        TOS:=TOS+26;                                           <<06137>>02320000
        X:=S0;                                                          02322000
        MOVE BUF(X:=X+10):=EXECUTE,(9),2;                               02324000
        FMTSEC(*,OWNGXSYSSEC);                                 <<06137>>02326000
        TOS := TOS + PVCOL;                                    <<06137>>02328000
        IF MVTABX<>0 THEN                                      <<06137>>02330000
           BEGIN                                               <<06137>>02332000
           X := S0;                                            <<06137>>02334000
           MOVE BUF(X:=X+10):=EXECUTE,(9),2;                   <<06137>>02336000
           FMTSEC(*,OWNGXPVSEC);                               <<06137>>02338000
           END                                                 <<06137>>02340000
        ELSE BLANKSEC;                                         <<06137>>02342000
        TOS:=TOS+26;                                           <<06137>>02344000
        X:=S0;                                                          02346000
        MOVE BUF(X:=X+10):=SAVE,(9),2;                                  02348000
        FMTSEC(*,OWNGSSYSSEC);                                 <<06137>>02350000
        TOS := TOS + PVCOL;                                    <<06137>>02352000
        IF MVTABX<>0 THEN                                      <<06137>>02354000
           BEGIN                                               <<06137>>02356000
           X := S0;                                            <<06137>>02358000
           MOVE BUF(X:=X+10):=SAVE,(9),2;                      <<06137>>02360000
           FMTSEC(*,OWNGSPVSEC);                               <<06137>>02362000
           END                                                 <<06137>>02364000
        ELSE BLANKSEC;                                         <<06137>>02366000
        TOS:=TOS+26;                                           <<06137>>02368000
            COMMENT:                                                    02370000
            <<        ---- FILE SECURITY ----                           02372000
            << FORMAT READ SECURITY AND FCODE;                          02374000
        BLANKLINE;                                                      02376000
        MOVE BUF(S0):="SECURITY--READ:    ",2;                 <<06137>>02378000
        FMTSEC(*,FLRSEC);                                               02380000
        TOS:=TOS+SLCOL;                                                 02382000
        FMTFCODE(FLCODE,OKAY LOR (CROKAY LAND PM),BUF(S0));  <<15NOV77>>02384000
        IF FLCODE=0 AND FLFTYPE=1 THEN MOVE BUF(S0+7):="KSAM ";<<01719>>02386000
        TOS:=TOS+14;                                                    02388000
            COMMENT:                                                    02390000
            << FORMAT WRITE SECURITY AND CREATOR ID;                    02392000
        MOVE BUF(S0):=" (FILE)   WRITE:   ",2;                          02394000
        FMTSEC(*,FLWSEC);                                               02396000
        TOS:=TOS+SLCOL;                                                 02398000
        MOVE BUF(S0):=CREATOR,(9),2;                                    02400000
        IF CROKAY THEN MOVE * := FLCR,(8)                               02402000
          ELSE MOVE * := BSTARS,(2);                                    02404000
        TOS:=TOS+18;                                                    02406000
            COMMENT:                                                    02408000
            << FORMAT APPEND SECURITY AND LOCKWORD;                     02410000
        X:=S0;                                                          02412000
        MOVE BUF(X:=X+10):=APPEND,(9),2;                                02414000
        FMTSEC(*,FLASEC);                                               02416000
        TOS:=TOS+SLCOL;                                                 02418000
        MOVE BUF(S0):= LOCKWORD,(10),2;                                 02420000
        IF OKAY THEN MOVE * := FLPASS,(8)                               02422000
          ELSE MOVE * := BSTARS,(2);                                    02424000
        TOS:=TOS+18;                                                    02426000
            COMMENT:                                                    02428000
            << FORMAT LOCK SECURITY AND :SECURE FLAG;                   02430000
        X:=S0;                                                          02432000
        MOVE BUF(X:=X+10):=LOCK,(9),2;                                  02434000
        FMTSEC(*,FLLSEC);                                               02436000
        TOS:=TOS+SLCOL2;                                                02438000
        MOVE BUF(S0):=SECON,(16),2;                                     02440000
        IF NOT FLSECURE THEN                                            02442000
          BEGIN                                                         02444000
            TOS:=TOS-1;                                                 02446000
            MOVE * := "FF",2;                                           02448000
          END;                                                          02450000
        DEL;                                                            02452000
        TOS:=TOS+18;                                                    02454000
            COMMENT:                                                    02456000
            << FORMAT EXECUTE SECURITY AND EFFECTIVE                    02458000
            << SECURITY FOR LOG-ON USER, ALL IN LEFT MARGIN;            02460000
        X:=S0;                                                          02462000
        MOVE BUF(X:=X+10):=EXECUTE,(9),2;                               02464000
        FMTSEC(*,FLXSEC);                                               02466000
        TOS:=TOS+38;                                                    02468000
        BLANKLINE;                                                      02470000
        COMMENT:                                               <<06137>>02472000
        << MUST USE SYS. DIRC. SECURITY FOR PROPER             <<06137>>02474000
        << ACCESS RIGHTS;                                      <<06137>>02476000
        ACC:=IF NOT FLSECURE THEN %76                                   02478000
          ELSE ACCCHECK(0,FLANAME,ASYSSEC,FLGNAME,             <<06137>>02480000
                   GSYSSEC,FLCR,FLSEC);                        <<06137>>02482000
        MOVE BUF(S0):="FOR ",2;                                         02484000
        MOVE * := LOUSR,(8),2;                                          02486000
        TOS:=TOS-8;                                                     02488000
        SCAN * UNTIL " ",1;                                             02490000
        BPS0:=".";                                                      02492000
        TOS:=TOS+1;                                                     02494000
        MOVE * := LOACCT,(8),2;                                         02496000
        TOS:=TOS-8;                                                     02498000
        SCAN * UNTIL " ",1;                                             02500000
        MOVE * := ": ",2;                                               02502000
        IF INTEGER(ACC&LSR(1))=0 THEN MOVE * := "NO ACCESS ALLOWED"     02504000
          ELSE BEGIN                                                    02506000
            IF ACC.(10:1) THEN MOVE * := "READ,",2;                     02508000
            IF ACC.(12:1) THEN MOVE * := "WRITE,",2;                    02510000
            IF ACC.(11:1) THEN MOVE * := "APPEND,",2;                   02512000
            IF ACC.(13:1) THEN MOVE * := "LOCK,",2;                     02514000
            IF ACC.(14:1) THEN MOVE * := "EXECUTE"                      02516000
              ELSE BEGIN                                                02518000
                BPS0(-1):=" ";                                          02520000
                DEL;                                                    02522000
              END;                                                      02524000
          END;                                                          02526000
        <<TOS:=TOS+54;>>                                                02528000
        MOVE LINEL(-1):=SDL,(SDLLEN);                                   02530000
        RESULT:=RESULT+1;                   <<PRINT BUFFER>>            02532000
        <<DEL;>>                                                        02534000
      END;                                                              02536000
    END  <<OF CASE>>;                                                   02538000
END  <<PROCEDURE FMTSECINFO>>                                           02540000
;                                                                       02542000
$PAGE "          PROCEDURE FMTACCTINFO"                                 02544000
$CONTROL   SEGMENT=FMT2                                                 02546000
                                                                        02548000
                                                                        02550000
PROCEDURE FMTACCTINFO(ENT,ENTB,LINEL);                                  02552000
                     INTEGER ARRAY ENT,LINEL;                           02554000
                     BYTE ARRAY ENTB;                                   02556000
BEGIN                                                                   02558000
  DEFINE ADNAME   = ENTB #,                                             02560000
         ADGIPNTR = ENT(4) #,                                           02562000
         ADUIPNTR = ENT(5) #,                                           02564000
         ADCAP    = ENTD(3) #,                                          02566000
         ADLATTR  = ENTD(4) #,                                          02568000
         ADPASS   = ENTB(20) #,                                         02570000
         ADDFSCNT = ENTD(7) #,                                          02572000
         ADDFSLIM = ENTD(8) #,                                          02574000
         ADCPUCNT = ENTD(9) #,                                          02576000
         ADCPULIM = ENTD(10) #,                                         02578000
         ADCONCNT = ENTD(11) #,                                         02580000
         ADCONLIM = ENTD(12) #,                                         02582000
         ADSEC    = ENT(26) #,                                          02584000
         ADPURGE  = ADSEC<0 #,                                          02586000
         ADRSEC   = ADSEC.(4:2)&LSL(4) #,                               02588000
         ADASEC   = ADSEC.(6:2)&LSL(4) #,                               02590000
         ADWSEC   = ADSEC.(8:2)&LSL(4) #,                               02592000
         ADLSEC   = ADSEC.(10:2)&LSL(4) #,                              02594000
         ADXSEC   = ADSEC.(12:2)&LSL(4) #,                              02596000
         ADMAXPRI = LOGICAL(ENT(27)) LAND %377 #;                       02598000
  DEFINE BLANKLINE= TOS:=TOS+2 #,                                       02600000
         SM= INTEGER(LOCAP)<0 #;                                        02602000
  EQUATE ALCOL=32,                                                      02604000
         ADLLEN=14,                                            <<*8729>>02606000
         ADLLEN2=ADLLEN-2;                                              02608000
  ARRAY ADL(*)=PB:=ADLLEN2,9,1,25,27,5(29),2(10),31,31;        <<*8729>>02610000
  BYTE ARRAY BSTARS(*)=PB:="**";                                        02612000
  BYTE ARRAY READSEC(*)=PB:="SECURITY--READ:    ";                      02614000
  BYTE ARRAY APPEND(*)=PB:="APPEND:  ";                                 02616000
  BYTE ARRAY LOCK(*)=PB:="LOCK:    ";                                   02618000
  BYTE ARRAY EXECUTE(*)=PB:="EXECUTE: ";                                02620000
  BYTE ARRAY DISCSPACE(*)=PB:="DISC SPACE: ";                           02622000
  BYTE ARRAY PASSWORD(*)=PB:="PASSWORD: ";                              02624000
  BYTE ARRAY CPUTIME(*)=PB:="CPU TIME: ";                               02626000
  BYTE ARRAY LOCATTR(*)=PB:="LOC ATTR: %";                              02628000
  BYTE ARRAY CONTIME(*)=PB:="CONNECT TIME: ";                           02630000
  BYTE ARRAY DISCLIM(*)=PB:="DISC LIMIT: ";                             02632000
  BYTE ARRAY WRITE(*)=PB:="WRITE:   ";                                  02634000
  BYTE ARRAY CPULIM(*)=PB:="CPU LIMIT: ";                               02636000
  BYTE ARRAY CONLIM(*)=PB:="CONNECT LIMIT: ";                           02638000
  BYTE ARRAY MAXPRI(*)=PB:="MAX PRI: ";                                 02640000
  BYTE ARRAY GRPPTR(*)=PB:="GRP INX PTR: %";                            02642000
  BYTE ARRAY CAP(*)=PB:="CAP: ";                                        02644000
  BYTE ARRAY SEC(*)=PB:="(SEC)";                                        02646000
  BYTE ARRAY MIN(*)=PB:="(MIN)";                                        02648000
  BYTE ARRAY SECT(*)=PB:="(S)";                                         02650000
  BYTE ARRAY TSTR(0:10);                                                02652000
  DOUBLE POINTER ENTD=ENT;                                              02654000
  INTEGER X=X,                                                          02656000
          S0=S-0,                                                       02658000
          TYP1=S-2;                                                     02660000
                                                                        02662000
          <<-------------------->>                                      02664000
                                                                        02666000
  SUBROUTINE OCTAL(BUF,NUM);                                            02668000
                  VALUE BUF,NUM;                                        02670000
                  BYTE POINTER BUF;                                     02672000
                  INTEGER NUM;                                          02674000
  BEGIN                                                                 02676000
    X:=6-ASCII(NUM,8,TSTR);                                             02678000
    MOVE BUF:=TSTR(X),(6-X);                                            02680000
  END  <<SUBROUTINE OCTAL>>                                             02682000
  ;                                                                     02684000
                                                                        02686000
          <<-------------------->>                                      02688000
                                                                        02690000
  SUBROUTINE DOCTAL(BUF,DNUM);                                          02692000
                   VALUE BUF,DNUM;                                      02694000
                   BYTE POINTER BUF;                                    02696000
                   DOUBLE DNUM;                                         02698000
  BEGIN                                                                 02700000
    X:=11-DASCII(DNUM,8,TSTR);                                          02702000
    MOVE BUF:=TSTR(X),(11-X);                                           02704000
  END  <<SUBROUTINE DOCTAL>>                                            02706000
  ;                                                                     02708000
                                                                        02710000
          <<-------------------->>                                      02712000
                                                                        02714000
  SUBROUTINE SYSLIMIT(BUF,DVAL,TYP);                                    02716000
                     VALUE BUF,DVAL,TYP;                                02718000
                     BYTE POINTER BUF;                                  02720000
                     DOUBLE DVAL;                                       02722000
                     INTEGER TYP;                                       02724000
  BEGIN                                                                 02726000
    IF DVAL=%17777777777D THEN MOVE BUF:="UNLIMITED"                    02728000
      ELSE BEGIN                                                        02730000
        TOS:=DASCII(DVAL,10,BUF);                                       02732000
        CASE *TYP1 OF BEGIN                                             02734000
          MOVE BUF(TOS):=SECT,(3);                                      02736000
          MOVE BUF(TOS):=SEC,(5);                                       02738000
          MOVE BUF(TOS):=MIN,(5);                                       02740000
        END;                                                            02742000
      END;                                                              02744000
  END  <<SUBROUTINE SYSLIMIT>>                                          02746000
  ;                                                                     02748000
                                                                        02750000
          <<-------------------->>                                      02752000
                                                                        02754000
        COMMENT:                                                        02756000
        << FORMAT ACCOUNT NAME AND BLANKLINE;                           02758000
    MOVE BUF:="ACCOUNT: ",2;                                            02760000
    MOVE * := ADNAME,(8);                                               02762000
    TOS:=18;                                <<INX INTO 'BUF'>>          02764000
    BLANKLINE;                                                          02766000
        COMMENT:                                                        02768000
        << FORMAT DISC SPACE AND PASSWORD;                              02770000
    MOVE BUF(S0):=DISCSPACE,(12);                                       02772000
    X:=DASCII(ADDFSCNT,10,BUF(S0+12))+X;                                02774000
    MOVE BUF(X):=SECT,(3);                                              02776000
    TOS:=TOS+ALCOL;                                                     02778000
    MOVE BUF(S0):=PASSWORD,(10),2;                                      02780000
    IF GIVEPASS AND SM THEN MOVE * := ADPASS,(8)                        02782000
      ELSE MOVE * := BSTARS,(2);                                        02784000
    TOS:=TOS+18;                                                        02786000
        COMMENT:                                                        02788000
        << FORMAT CPU TIME AND LOCAL ATTRIBUTES;                        02790000
    MOVE BUF(S0):=CPUTIME,(10);                                         02792000
    X:=DASCII(ADCPUCNT,10,BUF(S0+10))+X;                                02794000
    MOVE BUF(X):=SEC,(5);                                               02796000
    TOS:=TOS+ALCOL;                                                     02798000
    MOVE BUF(S0):=LOCATTR,(11),2;                                       02800000
    DOCTAL(*,ADLATTR);                                                  02802000
    TOS:=TOS+22;                                                        02804000
        COMMENT:                                                        02806000
        << FORMAT CONNECT TIME AND READ SECURITY;                       02808000
    MOVE BUF(S0):=CONTIME,(14);                                         02810000
    X:=DASCII(ADCONCNT,10,BUF(S0+14))+X;                                02812000
    MOVE BUF(X):=MIN,(5);                                               02814000
    TOS:=TOS+ALCOL;                                                     02816000
    MOVE BUF(S0):=READSEC,(19),2;                                       02818000
    FMTSEC(*,ADRSEC);                                                   02820000
    TOS:=TOS+26;                                                        02822000
        COMMENT:                                                        02824000
        << FORMAT DISC LIMIT AND WRITE SECURITY;                        02826000
    MOVE BUF(S0):=DISCLIM,(12),2;                                       02828000
    SYSLIMIT(*,ADDFSLIM,0);                                             02830000
    TOS:=TOS+ALCOL;                                                     02832000
    X:=S0;                                                              02834000
    MOVE BUF(X:=X+10):=WRITE,(9),2;                                     02836000
    FMTSEC(*,ADWSEC);                                                   02838000
    TOS:=TOS+26;                                                        02840000
        COMMENT:                                                        02842000
        << FORMAT CPU LIMIT AND APPEND SECURITY;                        02844000
    MOVE BUF(S0):=CPULIM,(11),2;                                        02846000
    SYSLIMIT(*,ADCPULIM,1);                                             02848000
    TOS:=TOS+ALCOL;                                                     02850000
    X:=S0;                                                              02852000
    MOVE BUF(X:=X+10):=APPEND,(9),2;                                    02854000
    FMTSEC(*,ADASEC);                                                   02856000
    TOS:=TOS+26;                                                        02858000
        COMMENT:                                                        02860000
        << FORMAT CONNECT LIMIT AND LOCK SECURITY;                      02862000
    MOVE BUF(S0):=CONLIM,(15),2;                                        02864000
    SYSLIMIT(*,ADCONLIM,2);                                             02866000
    TOS:=TOS+ALCOL;                                                     02868000
    X:=S0;                                                              02870000
    MOVE BUF(X:=X+10):=LOCK,(9),2;                                      02872000
    FMTSEC(*,ADLSEC);                                                   02874000
    TOS:=TOS+26;                                                        02876000
        COMMENT:                                                        02878000
        << FORMAT MAX PRIORITY AND EXECUTE SECURITY;                    02880000
    MOVE BUF(S0):=MAXPRI,(9);                                           02882000
    ASCII(ADMAXPRI,10,BUF(S0+9));                                       02884000
    TOS:=TOS+ALCOL;                                                     02886000
    X:=S0;                                                              02888000
    MOVE BUF(X:=X+10):=EXECUTE,(9),2;                                   02890000
    FMTSEC(*,ADXSEC);                                                   02892000
    TOS:=TOS+26;                                                        02894000
        COMMENT:                                                        02896000
        << FORMAT GROUP AND USER INDEX POINTERS AND CAPABILITY,         02898000
        << ALL ON THE LEFT MARGIN;                                      02900000
    MOVE BUF(S0):=GRPPTR,(14),2;                                        02902000
    OCTAL(*,ADGIPNTR);                                                  02904000
    TOS:=TOS+20;                                                        02906000
    MOVE BUF(S0):="USR INX PTR: %",2;                                   02908000
    OCTAL(*,ADUIPNTR);                                                  02910000
    TOS:=TOS+20;                                                        02912000
    MOVE BUF(S0):=CAP,(5),2;                                            02914000
    FMTCAP(*,1,ADCAP);                                                  02916000
    <<TOS:=TOS+62;>>                                                    02918000
        COMMENT:                                                        02920000
        << SET UP GLOBAL VALUES FOR PRINTING INFORMATION;               02922000
    MOVE LINEL(-1):=ADL,(ADLLEN);                                       02924000
    <<DEL;>>                                                            02926000
END  <<PROCEDURE FMTACCTINFO>>                                          02928000
;                                                                       02930000
$PAGE "          PROCEDURE FMTGRPINFO"                                  02932000
$CONTROL   SEGMENT=FMT2                                                 02934000
                                                                        02936000
                                                                        02938000
PROCEDURE FMTGRPINFO(ENT,ENTB,ANAME,LINEL);                             02940000
                    INTEGER ARRAY ENT,LINEL;                            02942000
                    BYTE ARRAY ENTB,ANAME;                              02944000
BEGIN                                                                   02946000
  DEFINE GDNAME   = ENTB #,                                             02948000
         GDFIPNTR = ENT(4) #,                                           02950000
         GDPASS   = ENTB(10) #,                                         02952000
         GDDFSCNT = ENTD1(4) #,                                         02954000
         GDDFSLIM = ENTD1(5) #,                                         02956000
         GDCPUCNT = ENTD1(6) #,                                         02958000
         GDCPULIM = ENTD1(7) #,                                         02960000
         GDCONCNT = ENTD1(8) #,                                         02962000
         GDCONLIM = ENTD1(9) #,                                         02964000
         GDSEC    = ENTD1(10) #,                                        02966000
         GDSEC1   = ENT(21) #,                                          02968000
         GDSEC2   = ENT(22) #,                                          02970000
         GDPURGE  = GDSEC1<0 #,                                         02972000
         GDRSEC   = GDSEC1.(2:5)&LSL(1) #,                              02974000
         GDASEC   = GDSEC1.(7:5)&LSL(1) #,                              02976000
         GDWSEC   = LOGICAL(INTEGER(GDSEC&DCSR(14))) LAND %76 #,        02978000
         GDLSEC   = GDSEC2.(1:5)&LSL(1) #,                              02980000
         GDXSEC   = GDSEC2.(6:5)&LSL(1) #,                              02982000
         GDSSEC   = GDSEC2.(11:5)&LSL(1) #,                             02984000
         GDCAP    = ENT(23) #,                                 <<00446>>02986000
         GDLINK   = ENT(24) #,                                 <<00446>>02988000
         GDPV     = LOGICAL(GDLINK.(0:1)) #,                   <<00446>>02990000
         GDMVTABX = GDLINK.(8:8) #,                            <<00446>>02992000
         GDHVSACT = ENTB(52) #,                                <<00446>>02994000
         GDHVSGRP = ENTB(60) #,                                <<00446>>02996000
         GDHVSVS  = ENTB(68) #,                                <<00446>>02998000
         GDMNTREF = ENT(39) #;                                 <<00446>>03000000
  DEFINE BLANKLINE= TOS:=TOS+2 #,                                       03002000
         SMORAM= LOCAP&CSL(1) OR < #;                                   03004000
  EQUATE GLCOL=34,                                                      03006000
         GRCOL=34,                                             <<00446>>03008000
         HVSCOL=40,                                            <<00446>>03010000
         GDLLEN=14,                                            <<00446>>03012000
         GDLLEN2=GDLLEN-2;                                              03014000
  ARRAY GDL(*)=PB:=GDLLEN2,12,1,26,8(34),20,16;                <<00446>>03016000
  BYTE ARRAY BSTARS(*)=PB:="**";                                        03018000
  BYTE ARRAY READSEC(*)=PB:="SECURITY--READ:    ";                      03020000
  BYTE ARRAY APPEND(*)=PB:="APPEND:  ";                                 03022000
  BYTE ARRAY LOCK(*)=PB:="LOCK:    ";                                   03024000
  BYTE ARRAY EXECUTE(*)=PB:="EXECUTE: ";                                03026000
  BYTE ARRAY DISCSPACE(*)=PB:="DISC SPACE: ";                           03028000
  BYTE ARRAY PASSWORD(*)=PB:="PASSWORD: ";                              03030000
  BYTE ARRAY CPUTIME(*)=PB:="CPU TIME: ";                               03032000
  BYTE ARRAY CONTIME(*)=PB:="CONNECT TIME: ";                           03034000
  BYTE ARRAY DISCLIM(*)=PB:="DISC LIMIT: ";                             03036000
  BYTE ARRAY WRITE(*)=PB:="WRITE:   ";                                  03038000
  BYTE ARRAY CPULIM(*)=PB:="CPU LIMIT: ";                               03040000
  BYTE ARRAY CONLIM(*)=PB:="CONNECT LIMIT: ";                           03042000
  BYTE ARRAY CAP(*)=PB:="CAP: ";                                        03044000
  BYTE ARRAY SEC(*)=PB:="(SEC)";                                        03046000
  BYTE ARRAY MIN(*)=PB:="(MIN)";                                        03048000
  BYTE ARRAY SECT(*)=PB:="(S)";                                         03050000
  BYTE ARRAY SAVE(*)=PB:="SAVE:    ";                                   03052000
  BYTE ARRAY MVTABX(*)=PB:="MVTABX: %";                        <<00446>>03054000
  BYTE ARRAY MOUNTREFCNT(*)=PB:="MOUNT REF CNT: ";             <<00446>>03056000
  BYTE ARRAY HOMEVOLSET(*)=PB:="HOME VOL SET: ";               <<00446>>03058000
  BYTE ARRAY PV(*)=PB:="PRIV VOL: ";                           <<00446>>03060000
  BYTE ARRAY TSTR(0:10);                                                03062000
  BYTE POINTER BPS0=S-0;                                                03064000
  DOUBLE POINTER ENTD1;                                                 03066000
  INTEGER X=X,                                                          03068000
          S0=S-0,                                                       03070000
          TYP1=S-2;                                                     03072000
                                                                        03074000
          <<-------------------->>                                      03076000
                                                                        03078000
  SUBROUTINE OCTAL(BUF,NUM);                                            03080000
                  VALUE BUF,NUM;                                        03082000
                  BYTE POINTER BUF;                                     03084000
                  INTEGER NUM;                                          03086000
  BEGIN                                                                 03088000
    X:=6-ASCII(NUM,8,TSTR);                                             03090000
    MOVE BUF:=TSTR(X),(6-X);                                            03092000
  END  <<SUBROUTINE OCTAL>>                                             03094000
  ;                                                                     03096000
                                                                        03098000
          <<-------------------->>                                      03100000
                                                                        03102000
  SUBROUTINE SYSLIMIT(BUF,DVAL,TYP);                                    03104000
                     VALUE BUF,DVAL,TYP;                                03106000
                     BYTE POINTER BUF;                                  03108000
                     DOUBLE DVAL;                                       03110000
                     INTEGER TYP;                                       03112000
  BEGIN                                                                 03114000
    IF DVAL=%17777777777D THEN MOVE BUF:="UNLIMITED"                    03116000
      ELSE BEGIN                                                        03118000
        TOS:=DASCII(DVAL,10,BUF);                                       03120000
        CASE *TYP1 OF BEGIN                                             03122000
          MOVE BUF(TOS):=SECT,(3);                                      03124000
          MOVE BUF(TOS):=SEC,(5);                                       03126000
          MOVE BUF(TOS):=MIN,(5);                                       03128000
        END;                                                            03130000
      END;                                                              03132000
  END  <<SUBROUTINE SYSLIMIT>>                                          03134000
  ;                                                                     03136000
                                                               <<00446>>03138000
          <<-------------------->>                             <<00446>>03140000
                                                               <<00446>>03142000
  SUBROUTINE DECIMAL(BUF,NUM);                                 <<00446>>03144000
                  VALUE BUF,NUM;                               <<00446>>03146000
                  BYTE POINTER BUF;                            <<00446>>03148000
                  INTEGER NUM;                                 <<00446>>03150000
  BEGIN                                                        <<00446>>03152000
    X:=ASCII(NUM,10,TSTR); << USE TSTR ...        >>           <<00446>>03154000
    MOVE BUF:=TSTR,(X);    << INCASE BUF ODD BYTE >>           <<00446>>03156000
  END  <<SUBROUTINE DECIMAL>>                                  <<00446>>03158000
  ;                                                            <<00446>>03160000
                                                                        03162000
           <<-------------------->>                                     03164000
                                                                        03166000
        COMMENT:                                                        03168000
        << FORMAT QUALIFIED GROUP NAME AND BLANKLINE;                   03170000
    @ENTD1:=@ENT+1;                                                     03172000
    MOVE BUF:="GROUP: ",2;                                              03174000
    PUTNAME(BPS0,GDNAME,ANAME);                                <<00446>>03176000
    ASSEMBLE(DEL);   << DELETE POINTER >>                      <<00446>>03178000
    TOS:=24;                                <<INX INTO 'BUF'>>          03180000
    BLANKLINE;                                                          03182000
        COMMENT:                                                        03184000
        << FORMAT DISC SPACE AND PASSWORD;                              03186000
    MOVE BUF(S0):=DISCSPACE,(12);                                       03188000
    X:=DASCII(GDDFSCNT,10,BUF(S0+12))+X;                                03190000
    MOVE BUF(X):=SECT,(3);                                              03192000
    TOS:=TOS+GLCOL;                                                     03194000
    MOVE BUF(S0):=PASSWORD,(10),2;                                      03196000
    IF GIVEPASS AND SMORAM THEN MOVE * := GDPASS,(8)                    03198000
      ELSE MOVE * := BSTARS,(2);                                        03200000
    TOS:=TOS+18;                                                        03202000
        COMMENT:                                                        03204000
        << FORMAT CPU TIME AND READ SECURITY;                           03206000
    MOVE BUF(S0):=CPUTIME,(10);                                         03208000
    X:=DASCII(GDCPUCNT,10,BUF(S0+10))+X;                                03210000
    MOVE BUF(X):=SEC,(5);                                               03212000
    TOS:=TOS+GLCOL;                                                     03214000
    MOVE BUF(S0):=READSEC,(19),2;                                       03216000
    FMTSEC(*,GDRSEC);                                                   03218000
    TOS:=TOS+34;                                                        03220000
        COMMENT:                                                        03222000
        << FORMAT CONNECT TIME AND WRITE SECURITY;                      03224000
    MOVE BUF(S0):=CONTIME,(14);                                         03226000
    X:=DASCII(GDCONCNT,10,BUF(S0+14))+X;                                03228000
    MOVE BUF(X):=MIN,(5);                                               03230000
    TOS:=TOS+GLCOL;                                                     03232000
    X:=S0;                                                              03234000
    MOVE BUF(X:=X+10):=WRITE,(9),2;                                     03236000
    FMTSEC(*,GDWSEC);                                                   03238000
    TOS:=TOS+34;                                                        03240000
        COMMENT:                                                        03242000
        << FORMAT DISC LIMIT AND APPEND SECURITY;                       03244000
    MOVE BUF(S0):=DISCLIM,(12),2;                                       03246000
    SYSLIMIT(*,GDDFSLIM,0);                                             03248000
    TOS:=TOS+GLCOL;                                                     03250000
    X:=S0;                                                              03252000
    MOVE BUF(X:=X+10):=APPEND,(9),2;                                    03254000
    FMTSEC(*,GDASEC);                                                   03256000
    TOS:=TOS+34;                                                        03258000
        COMMENT:                                                        03260000
        << FORMAT CPU LIMIT AND LOCK SECURITY;                          03262000
    MOVE BUF(S0):=CPULIM,(11),2;                                        03264000
    SYSLIMIT(*,GDCPULIM,1);                                             03266000
    TOS:=TOS+GLCOL;                                                     03268000
    X:=S0;                                                              03270000
    MOVE BUF(X:=X+10):=LOCK,(9),2;                                      03272000
    FMTSEC(*,GDLSEC);                                                   03274000
    TOS:=TOS+34;                                                        03276000
        COMMENT:                                                        03278000
        << FORMAT CONNECT LIMIT AND EXECUTE SECURITY;                   03280000
    MOVE BUF(S0):=CONLIM,(15),2;                                        03282000
    SYSLIMIT(*,GDCONLIM,2);                                             03284000
    TOS:=TOS+GLCOL;                                                     03286000
    X:=S0;                                                              03288000
    MOVE BUF(X:=X+10):=EXECUTE,(9),2;                                   03290000
    FMTSEC(*,GDXSEC);                                                   03292000
    TOS:=TOS+34;                                                        03294000
        COMMENT:                                                        03296000
        << FORMAT FILE INDEX POINTER AND SAVE SECURITY;                 03298000
    MOVE BUF(S0):="FILE INX PTR: %",2;                                  03300000
    OCTAL(*,GDFIPNTR);                                                  03302000
    TOS:=TOS+GLCOL;                                                     03304000
    X:=S0;                                                              03306000
    MOVE BUF(X:=X+10):=SAVE,(9),2;                                      03308000
    FMTSEC(*,GDSSEC);                                                   03310000
    TOS:=TOS+34;                                                        03312000
        COMMENT:                                               <<00446>>03314000
        << FORMAT MVTABS AND PV;                               <<00446>>03316000
    MOVE BUF(S0):=MVTABX,(9),2;                                <<00446>>03318000
    OCTAL(*,GDMVTABX);                                         <<00446>>03320000
    TOS:=TOS+GLCOL;                                            <<00446>>03322000
    MOVE BUF(S0):=PV,(10),2;                                   <<00446>>03324000
    IF GDPV THEN MOVE * := "YES"                               <<00446>>03326000
    ELSE MOVE * := "NO";                                       <<00446>>03328000
    TOS:=TOS+GRCOL;                                            <<00446>>03330000
        COMMENT:                                               <<00446>>03332000
        << FORMAT MOUNT REF COUNT;                             <<00446>>03334000
    MOVE BUF(S0):=MOUNTREFCNT,(15),2;                          <<00446>>03336000
    IF GDPV THEN DECIMAL(*,GDMNTREF)                           <<00446>>03338000
    ELSE MOVE * := "0";                                        <<00446>>03340000
    TOS:=TOS+GLCOL+GRCOL;                                      <<00446>>03342000
        COMMENT:                                               <<00446>>03344000
        << FORMAT HOME VOL SET NAME;                           <<00446>>03346000
    MOVE BUF(S0):=HOMEVOLSET,(14),2;                           <<00446>>03348000
    IF GDPV THEN PUTNAME(BPS0,GDHVSVS,GDHVSGRP,GDHVSACT);      <<00446>>03350000
    ASSEMBLE(DEL);         << DELETE BYTE POINTER >>           <<00446>>03352000
    TOS:=TOS+HVSCOL;       << UPDATE BUFFER INDEX >>           <<00446>>03354000
        COMMENT:                                                        03356000
        << FORMAT CAPABILITY;                                           03358000
    MOVE BUF(S0):=CAP,(5),2;                                            03360000
    FMTCAP(*,0,GDCAP);                                                  03362000
    <<TOS:=TOS+32;>>                                                    03364000
        COMMENT:                                                        03366000
        << SET UP GLOBAL VALUES FOR PRINTING INFORMATION;               03368000
    MOVE LINEL(-1):=GDL,(GDLLEN);                                       03370000
    <<DEL;>>                                                            03372000
END  <<PROCEDURE FMTGRPINFO>>                                           03374000
;                                                                       03376000
$PAGE "          PROCEDURE FMTUSRINFO"                                  03378000
$CONTROL   SEGMENT=FMT2                                                 03380000
                                                                        03382000
                                                                        03384000
PROCEDURE FMTUSRINFO(ENT,ENTB,ANAME,LINEL);                             03386000
                    INTEGER ARRAY ENT,LINEL;                            03388000
                    BYTE ARRAY ENTB,ANAME;                              03390000
                    OPTION PRIVILEGED;                                  03392000
BEGIN                                                                   03394000
  DEFINE UDNAME   = ENTB #,                                             03396000
         UDCAP    = ENTD(2) #,                                          03398000
         UDLATTR  = ENTD(3) #,                                          03400000
         UDPASS   = ENTB(16) #,                                         03402000
         UDHOMGRP = ENTB(24) #,                                         03404000
         UDLOGCNT = ENT(16) #,                                          03406000
         UDPURGE  = ENT(17)<0 #,                                        03408000
         UDMAXPRI = LOGICAL(ENT(17)) LAND %377 #;                       03410000
  DEFINE OUTL= LINEL(-1) #,                                             03412000
         BLANKLINE= TOS:=TOS+2 #,                                       03414000
         SMORAM= LOCAP&CSL(1) OR < #;                                   03416000
  EQUATE ULCOL=24,                                                      03418000
         UDLLEN=8,                                             <<*8729>>03420000
         UDLLEN2=UDLLEN-2,                                              03422000
         LOUDLLEN=UDLLEN+3,                                             03424000
         LOUDLLEN2=LOUDLLEN-2,                                          03426000
         PXFIXED=-2,                                                    03428000
         PXJOBNUM=50;                                          <<07073>>03430000
  ARRAY UDL(*)=PB:=UDLLEN2,12,1,21,23,8,31,31,1,21,8;          <<*8729>>03432000
  BYTE ARRAY BSTARS(*)=PB:="**";                                        03434000
  BYTE ARRAY PASSWORD(*)=PB:="PASSWORD: ";                              03436000
  BYTE ARRAY LOCATTR(*)=PB:="LOC ATTR: %";                              03438000
  BYTE ARRAY MAXPRI(*)=PB:="MAX PRI: ";                                 03440000
  BYTE ARRAY CAP(*)=PB:="CAP: ";                                        03442000
  BYTE ARRAY TSTR(0:10);                                                03444000
  BYTE POINTER BPS0=S-0;                                                03446000
  DOUBLE POINTER ENTD=ENT;                                              03448000
  INTEGER X=X,                                                          03450000
          S0=S-0,                                                       03452000
          S3=S-3;                                                       03454000
  INTEGER POINTER PS1=S-1;                                              03456000
                                                                        03458000
          <<-------------------->>                                      03460000
                                                                        03462000
  SUBROUTINE DOCTAL(BUF,DNUM);                                          03464000
                   VALUE BUF,DNUM;                                      03466000
                   BYTE POINTER BUF;                                    03468000
                   DOUBLE DNUM;                                         03470000
  BEGIN                                                                 03472000
    X:=11-DASCII(DNUM,8,TSTR);                                          03474000
    MOVE BUF:=TSTR(X),(11-X);                                           03476000
  END  <<SUBROUTINE DOCTAL>>                                            03478000
  ;                                                                     03480000
                                                                        03482000
          <<-------------------->>                                      03484000
                                                                        03486000
        COMMENT:                                                        03488000
        << FORMAT QUALIFIED USER NAME AND BLANK LINE;                   03490000
    MOVE BUF:="USER: ",2;                                               03492000
    MOVE * := UDNAME,(8),2;                                             03494000
    TOS:=TOS-8;                                                         03496000
    SCAN * UNTIL " ",1;                                                 03498000
    BPS0:=".";                                                          03500000
    TOS:=TOS+1;                                                         03502000
    MOVE * := ANAME,(8);                                                03504000
    TOS:=24;                                <<INX INTO 'BUF'>>          03506000
    BLANKLINE;                                                          03508000
        COMMENT:                                                        03510000
        << FORMAT HOME GROUP AND PASSWORD;                              03512000
    MOVE BUF(S0):="HOME GROUP: ",2;                                     03514000
    MOVE * := UDHOMGRP,(8);                                             03516000
    TOS:=TOS+ULCOL;                                                     03518000
    MOVE BUF(S0):=PASSWORD,(10),2;                                      03520000
    IF GIVEPASS AND SMORAM THEN MOVE * := UDPASS,(8)                    03522000
      ELSE MOVE * := BSTARS,(2);                                        03524000
    TOS:=TOS+18;                                                        03526000
        COMMENT:                                                        03528000
        << FORMAT MAX PRIORITY AND LOCAL ATTRIBUTES;                    03530000
    MOVE BUF(S0):=MAXPRI,(9);                                           03532000
    ASCII(UDMAXPRI,10,BUF(S0+9));                                       03534000
    TOS:=TOS+ULCOL;                                                     03536000
    MOVE BUF(S0):=LOCATTR,(11),2;                                       03538000
    DOCTAL(*,UDLATTR);                                                  03540000
    TOS:=TOS+22;                                                        03542000
        COMMENT:                                                        03544000
        << FORMAT NUMBER OF LOGONS AND CAPABILITY, BOTH IN              03546000
        << LEFT MARGIN;                                                 03548000
    MOVE BUF(S0):="LOGON CNT: ";                                        03550000
    ASCII(UDLOGCNT,10,BUF(S0+11));                                      03552000
    TOS:=TOS+16;                                                        03554000
    MOVE BUF(S0):=CAP,(5),2;                                            03556000
    FMTCAP(*,1,UDCAP);                                                  03558000
    TOS:=TOS+62;                                                        03560000
        COMMENT:                                                        03562000
        << IF USER ENTRY IS FOR LOG-ON USER, LIST LOG-ON GROUP          03564000
        << AND JOB/SESSION NUMBER;                                      03566000
    IF NOT ALLCLASS AND LOUSR=UDNAME,(8) AND LOACCT=ANAME,(8) THEN      03568000
      BEGIN                                                             03570000
        BLANKLINE;                                                      03572000
        MOVE BUF(S0):="LOGON GROUP: ",2;                                03574000
        MOVE * := LOGRP,(8);                                            03576000
        TOS:=TOS+ULCOL;                                                 03578000
        PUSH(DL);                                                       03580000
        TOS:=0;                             <<FOR 'ASCII'>>             03582000
        TOS:=PS1(-PS1(PXFIXED)+PXJOBNUM);                               03584000
        IF < THEN                                                       03586000
          BEGIN                                                         03588000
            MOVE BUF(S3):="JOB #: J";                                   03590000
            X:=X+8;                                                     03592000
          END                                                           03594000
          ELSE BEGIN                                                    03596000
            MOVE BUF(S3):="SESSION #: S";                               03598000
            X:=X+12;                                                    03600000
          END;                                                          03602000
        TOS:=TOS.(2:14);                                                03604000
        ASCII(*,10,BUF(X));                                             03606000
        DEL;                                                            03608000
        TOS:=TOS+18;                                                    03610000
            COMMENT:                                                    03612000
            << FORMAT LOG-ON DEVICE NUMBER;                             03614000
        MOVE BUF(S0):="LOGON DEV #: ";                                  03616000
        ASCII(LOTERM,10,BUF(S0+13));                                    03618000
        <<TOS:=TOS+16;>>                                                03620000
            COMMENT:                                                    03622000
            << SET UP GLOBAL VALUES FOR PRINTING INFORMATION;           03624000
        MOVE LINEL(-1):=UDL,(LOUDLLEN);                                 03626000
        OUTL:=LOUDLLEN2;                                                03628000
      END                                                               03630000
      ELSE MOVE LINEL(-1):=UDL,(UDLLEN);                                03632000
    <<DEL;>>                                                            03634000
END  <<PROCEDURE FMTUSRINFO>>                                           03636000
;                                                                       03638000
$PAGE "          PROCEDURE FMTFILEINFO"                                 03640000
$CONTROL   SEGMENT=FMT1                                                 03642000
                                                                        03644000
                                                                        03646000
PROCEDURE FMTFILEINFO(ENT,ENTB,LOGUNT,DISKADR,GNAME,LINEL,GPART);       03648000
                     VALUE LOGUNT,DISKADR;                              03650000
                     INTEGER ARRAY ENT,LINEL;                           03652000
                     BYTE ARRAY ENTB,GNAME;                             03654000
                     LOGICAL LOGUNT;                                    03656000
                     DOUBLE DISKADR;                                    03658000
                     BYTE POINTER GPART;                                03660000
BEGIN                                                                   03662000
  DEFINE FUNNYDIV= ASSEMBLE(ZERO,CAB;                                   03664000
                            LDXA,LDIV;                                  03666000
                            CAB,LDXA;                                   03668000
                            LDIV      ) #,                              03670000
         FUNNYMULT= ASSEMBLE(LDXA,LMPY;                                 03672000
                             CAB,LDXA;                                  03674000
                             MPY,ZERO;                                  03676000
                             DADD      ) #;                             03678000
                                                               <<B2.05>>03680000
  EQUATE OFFSET = 128;                                         <<B2.05>>03682000
                                                               <<B2.05>>03684000
  DEFINE FLFNAME  = ENTB #,                                             03686000
         FLGNAME  = ENTB(8) #,                                          03688000
         FLANAME  = ENTB(16) #,                                         03690000
         FLCR     = ENTB(24) #,                                         03692000
         FLPASS   = ENTB(32) #,                                         03694000
         FLSEC    = ENTD(10) #,                                         03696000
         FLSEC1   = ENT(20) #,                                          03698000
         FLSEC2   = ENT(21) #,                                          03700000
         FLRSEC   = FLSEC1.(2:6) #,                                     03702000
         FLASEC   = FLSEC1.(8:6) #,                                     03704000
         FLWSEC   = LOGICAL(INTEGER(FLSEC&DCSR(12))) LAND %77 #,        03706000
         FLLSEC   = FLSEC2.(4:6) #,                                     03708000
         FLXSEC   = FLSEC2.(10:6) #,                                    03710000
         FLSECURE = LOGICAL(ENT(22)) #,                                 03712000
         FLCRDATE = ENT(23) #,                                          03714000
         FLACCDATE= ENT(24) #,                                          03716000
         FLMODDATE= ENT(25) #,                                          03718000
         FLCODE   = ENT(26) #,                                          03720000
         FLFCB0   = ENT(32) #,                                 <<06757>>03722000
         FLFCB1   = ENT(33) #,                                 <<06757>>03724000
         FLFLAGS  = ENT(28) #,                                          03726000
         FLDISCTYP= FLFLAGS.(8:6) #,                                    03728000
         FLSUBTYP = FLFLAGS.(4:4) #,                                    03730000
         FLRWACC  = FLFLAGS.(14:2) #,                                   03732000
         FLEXCACC = LOGICAL(FLFLAGS) #,     <<BITS (0:4) >>             03734000
         FLNUMLAB = INTEGER(ENTB(58)) #,                                03736000
         FLMAXLAB = ENT(29).(8:8) #,                                    03738000
         FLLIMIT  = ENTD(15) #,                                         03740000
         FLCLOAD  = ENT(35) #,                                          03742000
         FLFOPS   = ENT(36) #,                                          03744000
         FLASCII  = LOGICAL(FLFOPS.(13:1)) #,                           03746000
         FLRECTYP = FLFOPS.(8:2) #,                                     03748000
         FLCCTL   = LOGICAL(FLFOPS.(7:1)) #,                            03750000
         FLFTYPE  = FLFOPS.(2:3) #,                            <<01549>>03752000
         FLRECSIZE= ENT(37) #,                                          03754000
         FLBLKSIZE= ENT(38) #,                                          03756000
         FLOFFSET = INTEGER(ENTB(78)) #,                                03758000
         FLMAXEXT = ENT(39).(11:5) #,                                   03760000
         FLEXTSIZE= ENT(41) #,                                          03762000
         FLEOF    = ENTD(21) #,                                         03764000
         FLEXTMAP = ENTD(22) #;                                         03766000
  DEFINE PFCAP    = ENT(OFFSET) #,                             <<B2.05>>03768000
         PFSEG    = ENT(OFFSET+1) #,                           <<B2.05>>03770000
         PFDB     = ENT(OFFSET+2) #,                           <<B2.05>>03772000
         PFSTACK  = ENT(OFFSET+5) #,                           <<B2.05>>03774000
         PFDL     = ENT(OFFSET+6) #,                           <<B2.05>>03776000
         CLASSNAME= ENTB(248)#,                                         03778000
         TSTTYPE = ENT(124).(0:8) #,                                    03780000
         PFMAXDATA= ENT(OFFSET+7) #;                           <<B2.05>>03782000
  DEFINE OUTL= LINEL(-1) #,                                             03784000
         BLANKLINE= TOS:=TOS+2 #,                                       03786000
         AM= LOCAP&CSL(2) #,                                            03788000
         SM= INTEGER(LOCAP)<0 #,                                        03790000
         PM= LOCAP2&LSR(6) #;                                           03792000
  EQUATE FLCOL=22,                                                      03794000
         MSG=6,                                                <<02314>>03796000
         PROG=1029,                                                     03798000
         FDLLEN=21,                                                     03800000
         PDLLEN=3,                                                      03802000
         FDLLEN2=FDLLEN-2;                                              03804000
 ARRAY FDL(*)=PB:=FDLLEN2,16,1,30,2(20),5(30),24,22,3(24),     <<01549>>03806000
    23,19,34,16,1;                                             <<06757>>03808000
  ARRAY PDL(*)=PB:=20,17,27;                                            03810000
  ARRAY EDL(*)=PB:=8(30);                                               03812000
  BYTE ARRAY BSTARS(*)=PB:="**";                                        03814000
  BYTE ARRAY READSEC(*)=PB:="SECURITY--READ:    ";                      03816000
  BYTE ARRAY CREATOR(*)=PB:="CREATOR: ";                                03818000
  BYTE ARRAY LOCKWORD(*)=PB:="LOCKWORD: ";                              03820000
  BYTE ARRAY APPEND(*)=PB:="APPEND:  ";                                 03822000
  BYTE ARRAY LOCK(*)=PB:="LOCK:    ";                                   03824000
  BYTE ARRAY EXECUTE(*)=PB:="EXECUTE: ";                                03826000
  BYTE ARRAY WRITE(*)=PB:="WRITE:   ";                                  03828000
  BYTE ARRAY CAP(*)=PB:="CAP: ";                                        03830000
  BYTE ARRAY SECT(*)=PB:="(S)";                                         03832000
  BYTE ARRAY SECON(*)=PB:="**SECURITY IS ON";                           03834000
  BYTE ARRAY TSTR(0:10);                                                03836000
  BYTE POINTER BPS0=S-0,                                                03838000
               BPS1=S-1;                                                03840000
  DOUBLE NUMSEC;                                                        03842000
  DOUBLE POINTER ENTD=ENT,                                              03844000
                 DPS0=S-0,                                              03846000
                 DPS1=S-1,                                              03848000
                 DPS3=S-3;                                              03850000
  INTEGER X=X,                                                          03852000
          S0=S-0,                                                       03854000
          S2=S-2,                                                       03856000
          S3=S-3,                                                       03858000
          TOTALRECSIZE,                                        <<02314>>03860000
          BLKFACT,                                                      03862000
           SIZE,                                               <<00811>>03864000
          NUMEXT;                                                       03866000
  LOGICAL OKAY:=0,                     <<TRUE IF SM OR AM>>             03868000
          MSGFILE:=FALSE,              <<TRUE IF MSG FILE>>    <<02314>>03870000
          CROKAY:=0,                   <<TRUE IF SM,AM, OR CR>>         03872000
          MAPPED:=0;                                                    03874000
                                                                        03876000
          <<-------------------->>                                      03878000
                                                                        03880000
  SUBROUTINE OCTAL(BUF,NUM);                                            03882000
                  VALUE BUF,NUM;                                        03884000
                  BYTE POINTER BUF;                                     03886000
                  INTEGER NUM;                                          03888000
  BEGIN                                                                 03890000
    X:=6-ASCII(NUM,8,TSTR);                                             03892000
    MOVE BUF:=TSTR(X),(6-X);                                            03894000
  END  <<SUBROUTINE OCTAL>>                                             03896000
  ;                                                                     03898000
                                                                        03900000
          <<-------------------->>                                      03902000
                                                                        03904000
  SUBROUTINE FMTFNAME;                                                  03906000
  BEGIN                                                                 03908000
    MOVE BUF:="FILE: ",2;                                               03910000
    MOVE * := FLFNAME,(8),2;                                            03912000
    TOS:=TOS-8;                                                         03914000
    SCAN * UNTIL " ",1;                                                 03916000
    BPS0:=".";                                                          03918000
    TOS:=TOS+1;                                                         03920000
    @GPART:=S0;                                                         03922000
    MOVE * := FLGNAME,(8),2;                                            03924000
    TOS:=TOS-8;                                                         03926000
    SCAN * UNTIL " ",1;                                                 03928000
    BPS0:=".";                                                          03930000
    TOS:=TOS+1;                                                         03932000
    MOVE * := FLANAME,(8);                                              03934000
  END  <<SUBROUTINE FMTFNAME>>                                          03936000
  ;                                                                     03938000
                                                                        03940000
          <<-------------------->>                                      03942000
                                                                        03944000
  SUBROUTINE DOCTAL(BUF,DNUM);                                          03946000
                   VALUE BUF,DNUM;                                      03948000
                   BYTE POINTER BUF;                                    03950000
                   DOUBLE DNUM;                                         03952000
  BEGIN                                                                 03954000
    X:=11-DASCII(DNUM,8,TSTR);                                          03956000
    MOVE BUF:=TSTR(X),(11-X);                                           03958000
  END  <<SUBROUTINE DOCTAL>>                                            03960000
;                                                                       03962000
                                                                        03964000
          <<-------------------->>                                      03966000
                                                                        03968000
          <<-------------------->>                                      03970000
                                                                        03972000
    IF FLFTYPE = MSG THEN MSGFILE:=TRUE;                       <<02314>>03974000
    IF GIVEPASS THEN                                                    03976000
      BEGIN                                                             03978000
            COMMENT:                                                    03980000
            << ONLY SM AND AM CAN DISPLAY LOCKWORDS AND CREATOR IDS;    03982000
        IF SM OR AM AND LOACCT=FLANAME,(8) THEN OKAY:=1;                03984000
            COMMENT:                                                    03986000
            << SM, AM, OR CR CAN DISPLAY DISC ADDRESSES.  CR MUST       03988000
            << BE PRIVILEGED TO DISPLAY PRIVILEGED FILE CODES;          03990000
        IF OKAY OR LOUSR=FLCR,(8) AND LOACCT=FLANAME,(8)                03992000
          THEN CROKAY:=1;                                               03994000
      END;                                                              03996000
        COMMENT:                                                        03998000
        << FORMAT QUALIFIED FILE NAME AND BLANK LINE;                   04000000
    FMTFNAME;                                                           04002000
    IF LP AND ALLCLASS THEN                                             04004000
        IF LOGICAL(FIRSTTIME) THEN                                      04006000
          BEGIN                                                         04008000
            FIRSTTIME:=FIRSTTIME-1;                                     04010000
            MOVE GNAME:=GPART,(17);                                     04012000
          END                                                           04014000
          ELSE                                                          04016000
            IF GPART<>GNAME,(17) THEN                                   04018000
              BEGIN                                                     04020000
                MOVE GNAME:=GPART,(17);                                 04022000
                NXTLN:=61;                                              04024000
              END;                                                      04026000
    TOS:=32;                                <<INX INTO 'BUF'>>          04028000
    BLANKLINE;                                                          04030000
        COMMENT:                                                        04032000
        << FORMAT FILE CODE AND FILE OPTIONS;                           04034000
    FMTFCODE(FLCODE,OKAY LOR (CROKAY LAND PM),BUF(S0));      <<15NOV77>>04036000
    IF FLCODE=0 AND FLFTYPE=1 THEN MOVE BUF(S0+7):="KSAM ";    <<01719>>04038000
    TOS:=TOS+FLCOL;                                                     04040000
    MOVE BUF(S0):="FOPTIONS: ",2;                                       04042000
    CASE FLFTYPE OF                                            <<01549>>04044000
      BEGIN                                                    <<01549>>04046000
      MOVE * := "STD",2;   <<NORMAL FILE>>                     <<01549>>04048000
      MOVE * := "KSAM",2;  <<KSAM>>                            <<01549>>04050000
      MOVE * := "RIO",2;   <<RELATIVE I/O>>                    <<01549>>04052000
      ;                    <<UNDEFINED>>                       <<01549>>04054000
      MOVE * := "CIR",2;   <<CIRCULAR>>                        <<01549>>04056000
      ;                    <<UNDEFINED>>                       <<01549>>04058000
      MOVE * := "MSG",2;   <<MESSAGE FILE>>                    <<01549>>04060000
      END;                                                     <<01549>>04062000
    IF FLASCII THEN MOVE * := ",ASCII",2                       <<01549>>04064000
      ELSE MOVE * := ",BINARY",2;                              <<01549>>04066000
    IF FLRECTYP=1 THEN MOVE * := ",VARIABLE",2                          04068000
      ELSE                                                              04070000
        IF < THEN MOVE * := ",FIXED",2                                  04072000
          ELSE MOVE * := ",UNDEFINED",2;                                04074000
    IF FLCCTL THEN MOVE * := ",CCTL",2;                                 04076000
    DEL;                                                                04078000
    TOS:=TOS+38;                                               <<01549>>04080000
        COMMENT:                                                        04082000
        << FORMAT BLOCKING FACTOR AND CREATOR ID;                       04084000
    MOVE BUF(S0):="BLK FACTOR: ";                                       04086000
    TOS:=0;                                                             04088000
    TOTALRECSIZE:=(-FLRECSIZE+1)&ASR(1);                       <<02314>>04090000
    IF MSGFILE THEN TOTALRECSIZE:=TOTALRECSIZE+3;              <<02314>>04092000
    TOS:=BLKFACT:=FLBLKSIZE/TOTALRECSIZE;                      <<02314>>04094000
    ASCII(*,10,BUF(S2+12));                                             04096000
    TOS:=TOS+FLCOL;                                                     04098000
    MOVE BUF(S0):=CREATOR,(9),2;                                        04100000
    IF CROKAY THEN MOVE * := FLCR,(8)                                   04102000
      ELSE MOVE * := BSTARS,(2);                                        04104000
    TOS:=TOS+18;                                                        04106000
        COMMENT:                                                        04108000
        << FORMAT RECORD SIZE AND LOCKWORD;                             04110000
    MOVE BUF(S0):="REC SIZE: ";                                         04112000
       << REDUCE RECORD SIZE TO EXCLUDE RECORD LENGTH IF VAR.>><<00811>>04114000
    SIZE := IF FLRECTYP = 1 AND NOT MSGFILE THEN -FLRECSIZE-4  <<02314>>04116000
            ELSE -FLRECSIZE;                                   <<02314>>04118000
    X:=ASCII(SIZE,10,BUF(S0+10))+X;                           <<<00811>>04120000
    MOVE BUF(X):="(B)";                                                 04122000
    TOS:=TOS+FLCOL;                                                     04124000
    MOVE BUF(S0):= LOCKWORD,(10),2;                                     04126000
    IF OKAY THEN                                                        04128000
      BEGIN                                                             04130000
        IF FLPASS<>" " THEN MOVE * := FLPASS,(8),2;                     04132000
      END                                                               04134000
      ELSE MOVE * := BSTARS,(2),2;                                      04136000
    DEL;                                                                04138000
    TOS:=TOS+18;                                                        04140000
        COMMENT:                                                        04142000
        << FORMAT BLOCK SIZE AND READ SECURITY;                         04144000
    MOVE BUF(S0):="BLK SIZE: ";                                         04146000
 << REPORT FULL BLOCK SIZE FOR VARIABLE FILES.>>               <<01151>>04148000
    SIZE := FLBLKSIZE;                                         <<01151>>04150000
    X:=ASCII(SIZE,10,BUF(S0+10))+X;                            <<00811>>04152000
    MOVE BUF(X):="(W)";                                                 04154000
    TOS:=TOS+FLCOL;                                                     04156000
    MOVE BUF(S0):=READSEC,(19),2;                                       04158000
    FMTSEC(*,FLRSEC);                                                   04160000
    TOS:=TOS+38;                                                        04162000
        COMMENT:                                                        04164000
        << FORMAT EXTENT SIZE AND WRITE SECURITY;                       04166000
    MOVE BUF(S0):="EXT SIZE: ";                                         04168000
    X:=DASCII(DOUBLE(LOGICAL(FLEXTSIZE)),10,BUF(S0+10))+X;     <<00089>>04170000
    MOVE BUF(X):=SECT,(3);                                              04172000
    TOS:=TOS+FLCOL;                                                     04174000
    X:=S0;                                                              04176000
    MOVE BUF(X:=X+10):=WRITE,(9),2;                                     04178000
    FMTSEC(*,FLWSEC);                                                   04180000
    TOS:=TOS+38;                                                        04182000
        COMMENT:                                                        04184000
        << FORMAT NUMBER OF RECORDS AND APPEND SECURITY;                04186000
    MOVE BUF(S0):="# REC: ";                                            04188000
    DASCII(FLEOF,10,BUF(S0+7));                                         04190000
    TOS:=TOS+FLCOL;                                                     04192000
    X:=S0;                                                              04194000
    MOVE BUF(X:=X+10):=APPEND,(9),2;                                    04196000
    FMTSEC(*,FLASEC);                                                   04198000
    TOS:=TOS+38;                                                        04200000
        COMMENT:                                                        04202000
        << COMPUTE NUMBER OF ALLOCATED EXTENTS AND, FROM THAT,          04204000
        << NUMBER OF USED SECTORS.  THIS CODE WAS LIFTED AND            04206000
        << MODIFIED FROM ":LISTF" ROUTINE IN MPE;                       04208000
    TOS:=@FLEXTMAP;                                                     04210000
    X:=FLMAXEXT;                                                        04212000
    TOS:=0;                                                             04214000
    DO BEGIN                                                            04216000
      IF DPS1(X)<>0D THEN TOS:=TOS+1;                                   04218000
      X:=X-1;                                                           04220000
    END UNTIL <;                                                        04222000
    DELB;                                                               04224000
    NUMEXT:=S0;                                                         04226000
    IF S0-1<FLMAXEXT THEN                                               04228000
      BEGIN                                                             04230000
        TOS:=FLEXTSIZE;                                                 04232000
        ASSEMBLE(LMPY);                                                 04234000
      END                                                               04236000
      ELSE BEGIN                                                        04238000
        DEL;                                                            04240000
        TOS:=FLLIMIT;                                                   04242000
        X:=BLKFACT;                                                     04244000
        FUNNYDIV;                                                       04246000
        IF TOS<>0 THEN TOS:=TOS+1D;                                     04248000
        X:=(FLBLKSIZE+127)&LSR(7);                                      04250000
        FUNNYMULT;                                                      04252000
        TOS:=TOS+DOUBLE(FLOFFSET);                                      04254000
        X:=FLEXTSIZE;                                                   04256000
        FUNNYDIV;                                                       04258000
        X:=TOS;                                                         04260000
        IF = THEN X:=FLEXTSIZE;                                         04262000
        ASSEMBLE(ZROB);                                                 04264000
        DEL;                                                            04266000
        TOS:=X;                                                         04268000
        TOS:=FLEXTSIZE;                                                 04270000
        TOS:=FLMAXEXT;                                                  04272000
        ASSEMBLE(LMPY,DADD);                                            04274000
      END;                                                              04276000
    NUMSEC:=TOS;                                                        04278000
        COMMENT:                                                        04280000
        << WHEW!! NOW WE CAN FORMAT NUMBER OF SECTORS AND               04282000
        << LOCK SECURITY;                                               04284000
    MOVE BUF(S0):="# SEC: ";                                            04286000
    DASCII(NUMSEC,10,BUF(S0+7));                                        04288000
    TOS:=TOS+FLCOL;                                                     04290000
    X:=S0;                                                              04292000
    MOVE BUF(X:=X+10):=LOCK,(9),2;                                      04294000
    FMTSEC(*,FLLSEC);                                                   04296000
    TOS:=TOS+38;                                                        04298000
        COMMENT:                                                        04300000
        << FORMAT NUMBER OF EXTENTS AND EXECUTE SECURITY;               04302000
    MOVE BUF(S0):="# EXT: ";                                            04304000
    ASCII(NUMEXT,10,BUF(S0+7));                                         04306000
    TOS:=TOS+FLCOL;                                                     04308000
    X:=S0;                                                              04310000
    MOVE BUF(X:=X+10):=EXECUTE,(9),2;                                   04312000
    FMTSEC(*,FLXSEC);                                                   04314000
    TOS:=TOS+38;                                                        04316000
        COMMENT:                                                        04318000
        << FORMAT FILE LIMIT AND ":SECURE" FLAG;                        04320000
    MOVE BUF(S0):="MAX REC: ";                                          04322000
    DASCII(FLLIMIT,10,BUF(S0+9));                                       04324000
    TOS:=TOS+FLCOL;                                                     04326000
    X:=S0;                                                              04328000
    MOVE BUF(X:=X+8):=SECON,(16),2;                                     04330000
    IF NOT FLSECURE THEN                                                04332000
      BEGIN                                                             04334000
        TOS:=TOS-1;                                                     04336000
        MOVE * := "FF",2;                                               04338000
      END;                                                              04340000
    DEL;                                                                04342000
    TOS:=TOS+26;                                                        04344000
        COMMENT:                                                        04346000
        << FORMAT MAXIMUM NUMBER OF EXTENTS AND COLD LOAD ID;           04348000
    MOVE BUF(S0):="MAX EXT: ";                                          04350000
    ASCII(FLMAXEXT+1,10,BUF(S0+9));                                     04352000
    TOS:=TOS+FLCOL;                                                     04354000
    MOVE BUF(S0):="COLD LOAD ID: %",2;                                  04356000
    OCTAL(*,FLCLOAD);                                                   04358000
    TOS:=TOS+22;                                                        04360000
        COMMENT:                                                        04362000
        << FORMAT NUMBER OF USER LABELS AND CREATION DATE;              04364000
    MOVE BUF(S0):="# LABELS: ";                                         04366000
    ASCII(FLNUMLAB,10,BUF(S0+10));                                      04368000
    TOS:=TOS+FLCOL;                                                     04370000
    MOVE BUF(S0):="CREATED: ",2;                                        04372000
    DATELINE(*,FLCRDATE);                                               04374000
    TOS:=TOS+26;                                                        04376000
        COMMENT:                                                        04378000
        << FORMAT MAXIMUM NUMBER OF USER LABELS AND LAST-MODIFIED       04380000
        << DATE;                                                        04382000
    MOVE BUF(S0):="MAX LABELS: ";                                       04384000
    ASCII(FLMAXLAB,10,BUF(S0+12));                                      04386000
    TOS:=TOS+FLCOL;                                                     04388000
    MOVE BUF(S0):="MODIFIED: ",2;                                       04390000
    DATELINE(*,FLMODDATE);                                              04392000
    TOS:=TOS+26;                                                        04394000
        COMMENT:                                                        04396000
        << FORMAT LOGICAL DEVICE NUMBER AND LAST-ACCESSED DATE;         04398000
    MOVE BUF(S0):="DISC DEV #: ";                                       04400000
    ASCII(LOGUNT,10,BUF(S0+12));                                        04402000
    TOS:=TOS+FLCOL;                                                     04404000
    MOVE BUF(S0):="ACCESSED: ",2;                                       04406000
    DATELINE(*,FLACCDATE);                                              04408000
    TOS:=TOS+26;                                                        04410000
        COMMENT:                                                        04412000
        << FORMAT DISC TYPE AND FILE LABEL ADDRESS;                     04414000
    MOVE BUF(S0):="DISC TYPE: ";                                        04416000
    ASCII(FLDISCTYP,10,BUF(S0+11));                                     04418000
    TOS:=TOS+FLCOL;                                                     04420000
    MOVE BUF(S0):="LABEL ADR: ",2;                                      04422000
    IF NOT CROKAY THEN MOVE * := BSTARS,(2)                             04424000
      ELSE BEGIN                                                        04426000
        BPS0:="%";                                                      04428000
        TOS:=TOS+1;                                                     04430000
        DOCTAL(*,DISKADR);                                              04432000
      END;                                                              04434000
    TOS:=TOS+24;                                                        04436000
        COMMENT:                                                        04438000
        << FORMAT SUB TYPE AND SECTOR OFFSET;                           04440000
    MOVE BUF(S0):="DISC SUBTYPE: ";                                     04442000
    ASCII(FLSUBTYP,10,BUF(S0+14));                                      04444000
    TOS:=TOS+FLCOL;                                                     04446000
    MOVE BUF(S0):="SEC OFFSET: %",2;                                    04448000
    OCTAL(*,FLOFFSET);                                                  04450000
    TOS:=TOS+16;                                                        04452000
<<COMMENT FORMAT LDEV OR CLASS AND FLAGS >>                             04454000
    IF TSTTYPE < %101 THEN                                              04456000
    MOVE BUF(S0):="LDEV #:",2                                           04458000
    ELSE                                                                04460000
    MOVE BUF(S0):="CLASS: ",2;                                 <<00864>>04462000
    MOVE *:=CLASSNAME WHILE AN,2;                                       04464000
    TOS:=TOS+FLCOL;                                                     04466000
    MOVE BUF(S0):="FLAGS: ",2;                                          04468000
    CASE *FLRWACC OF BEGIN                                              04470000
      MOVE * := "NO ACCESSORS",2;                                       04472000
      MOVE * := "READ ACCESS",2;                                        04474000
      MOVE * := "WRITE ACCESS",2;                                       04476000
      MOVE * := "R/W ACCESS",2;                                         04478000
    END;                                                                04480000
                                                               <<01205>>04482000
  IF FLEXCACC.(0:1) THEN                                       <<01205>>04484000
     IF FLEXCACC.(1:1)                                         <<01205>>04486000
        THEN MOVE * := ",:RESTORE", 2                          <<01205>>04488000
        ELSE MOVE * := ",:STORE", 2;                           <<01205>>04490000
                                                               <<01205>>04492000
    IF FLEXCACC.(2:1) THEN MOVE * := ",LOADED",2;                       04494000
    IF FLEXCACC.(3:1) THEN MOVE * := ",EXC ACCESS",2;                   04496000
    DEL;                                                                04498000
    TOS:=TOS+46;                                                        04500000
    <<FORMAT FCB VECTORS>>                                              04502000
    MOVE BUF(S0):="FCB VECTOR: %",2;                                    04504000
    ASSEMBLE(DUP);                                             <<06757>>04506000
    OCTAL(*,FLFCB0);                                           <<06757>>04508000
    TOS := TOS + 8;                                            <<06757>>04510000
    MOVE * := "%",2;                                           <<06757>>04512000
    OCTAL(*,FLFCB1);                                           <<06757>>04514000
    TOS:=TOS+32;                                               <<06757>>04516000
    MOVE LINEL(-1):=FDL,(FDLLEN);                                       04518000
        COMMENT:                                                        04520000
        << IF EXTMAP OPTION SPECIFIED, FORMAT EXTENT MAP;               04522000
    IF EXTMAP THEN                                                      04524000
        IF SM OR (AM OR LOUSR=FLCR,(8)) AND LOACCT=FLANAME,(8) THEN     04526000
          BEGIN                                                         04528000
            MAPPED:=1;                                                  04530000
            TOS:=@FLEXTMAP;                                             04532000
            X:=FLMAXEXT;                                                04534000
            IF <> THEN DO UNTIL DPS0(X)<>0D OR DXBZ;                    04536000
            TOS:=X+1;                                                   04538000
            TOS:=(S0+3)/4;                                              04540000
            MOVE LINEL(OUTL):=EDL,(S0);                                 04542000
            OUTL:=S0+X-1;                                               04544000
            X:=S3;                                                      04546000
            S3:=TOS*60+X;                                               04548000
            MOVE BUF(X):="EXT MAP: ",2;                                 04550000
                COMMENT:                                                04552000
                << S2=DPTR TO FIRST EXTENT DPTR                         04554000
                << S1=NUMBER OF ACTIVE EXTENTS                          04556000
                << S0=BPTR INTO BUF;                                    04558000
            X:=0;                                                       04560000
            DO BEGIN                                                    04562000
              BPS0:="%";                                                04564000
              TOS:=TOS+1;                                               04566000
              TOS:=X;                                                   04568000
              DOCTAL(BPS1,DPS3(X));                                     04570000
              X:=TOS+1;                                                 04572000
              TOS:=TOS+(IF X.(14:2)=0 THEN 20 ELSE 12);                 04574000
              ASSEMBLE(DECB);                                           04576000
            END UNTIL =;                                                04578000
            DEL;   DDEL;                                                04580000
          END;                                                          04582000
        COMMENT:                                                        04584000
        << IF PROGRAM FILE, FORMAT PROGRAM-FILE INFORMATION;            04586000
    IF FLCODE=PROG AND FLEOF<>0D THEN                                   04588000
      BEGIN                                                             04590000
            COMMENT:                                                    04592000
            << FORMAT NUMBER OF SEGMENTS AND TOTAL DB;                  04594000
        IF NOT MAPPED THEN BLANKLINE;                                   04596000
        MOVE BUF(S0):="# SEG: ";                                        04598000
        ASCII(PFSEG,10,BUF(S0+7));                                      04600000
        TOS:=TOS+FLCOL;                                                 04602000
        MOVE BUF(S0):="TOTAL DB: %",2;                                  04604000
        OCTAL(*,PFDB);                                                  04606000
        TOS:=TOS+18;                                                    04608000
            COMMENT:                                                    04610000
            << FORMAT STACK SIZE AND DL SIZE;                           04612000
        MOVE BUF(S0):="STACK: %",2;                                     04614000
        OCTAL(*,PFSTACK);                                               04616000
        TOS:=TOS+FLCOL;                                                 04618000
        MOVE BUF(S0):="DL: %",2;                                        04620000
        OCTAL(*,PFDL);                                                  04622000
        TOS:=TOS+12;                                                    04624000
            COMMENT:                                                    04626000
            << FORMAT MAXDATA SIZE AND CAPABILITY;                      04628000
        MOVE BUF(S0):="MAXDATA: %",2;                                   04630000
        IF PFMAXDATA=-1 THEN                                            04632000
          BEGIN                                                         04634000
            TOS:=TOS-1;                                                 04636000
            MOVE * := "DEFAULT";                                        04638000
          END                                                           04640000
          ELSE OCTAL(*,PFMAXDATA);                                      04642000
        TOS:=TOS+FLCOL;                                                 04644000
        MOVE BUF(S0):=CAP,(5),2;                                        04646000
        FMTCAP(*,0,PFCAP);                                              04648000
        <<TOS:=TOS+32;>>                                                04650000
            COMMENT:                                                    04652000
            << SET UP GLOBAL VALUES FOR PRINTING INFORMATION;           04654000
        MOVE LINEL(OUTL+1):=PDL,(PDLLEN);                               04656000
        OUTL:=PDLLEN+X-1;                                               04658000
      END                                                               04660000
      ELSE IF NOT MAPPED THEN OUTL:=OUTL-1;                             04662000
    <<DEL;>>                                                            04664000
END  <<PROCEDURE FMTFILEINFO>>                                          04666000
;                                                                       04668000
$PAGE "          PROCEDURE FMTENTRY"                                    04670000
$CONTROL   SEGMENT=FMT1                                                 04672000
                                                                        04674000
                                                                        04676000
INTEGER PROCEDURE FMTENTRY(ENTRIE,LEVEL,QPARMS,SIR);         <<14NOV77>>04678000
                          VALUE LEVEL,QPARMS,SIR;            <<14NOV77>>04680000
                          ARRAY ENTRIE;                                 04682000
                          INTEGER LEVEL;                                04684000
                          INTEGER QPARMS;                    <<14NOV77>>04686000
                          DOUBLE SIR;                                   04688000
                          OPTION PRIVILEGED;                            04690000
BEGIN                                                                   04692000
  DEFINE ADNAME   = ENTB #;                                             04694000
  DEFINE FDVTABINX= ENTB(8) #,                                          04696000
         GLINKAGE = ENT(24) #,                                 <<11.KM>>04698000
         FLCODE   = ENT(26) #,                                          04700000
         FLEOF    = ENTD(21) #,                                         04702000
         FLOFFSET = INTEGER(ENTB(78)) #;                                04704000
  DEFINE PVGROUP= LOGICAL(GLINKAGE.(PVF)) #;                   <<11.KM>>04706000
  DEFINE OUTL= LINEL(-1) #,                                             04708000
         PSIF= ABSOLUTE(CPCB)+9 #,          <<PSEUDO-INTERRUPT FIELD>>  04710000
         CTLYD= LOGICAL(PCB(PSIF)&LSR(1)) #,                   <<07073>>04712000
         SOFTKILL= LOGICAL(PCB(PSIF)&LSR(4)) #,                <<07073>>04714000
         GNAME= ANAME #;                                                04716000
  EQUATE NOMOUNT'RTN= [2/3,14/NOMOUNT];                        <<11.KM>>04718000
  EQUATE PROG=1029,                                                     04720000
         DIRBASE'OFFSET=%270,                                  <<*8833>>04722000
         CPCB=4,                                                        04724000
         LPCNTL=1,                                                      04726000
         PAGECTL=%61,                                                   04728000
         SPACECTL=0;                                                    04730000
  EQUATE FDLLEN=20-1,                                                   04732000
         PDLLEN=3,                                                      04734000
         EDLLEN=8,                                             <<00864>>04736000
         MAXLEN1=FDLLEN+PDLLEN+EDLLEN-1;                                04738000
  INTEGER POINTER PCB = 3;                                     <<07073>>04740000
  OWN BYTE ARRAY ANAME(0:16);                                           04742000
  OWN ARRAY STARLINE(0:9):=10("**");                                    04744000
  OWN INTEGER ARRAY LINEL(-1:MAXLEN1);                                  04746000
  BYTE ARRAY BAS12(*)=S-12,                                             04748000
             BAS8(*)=S-8;                                               04750000
  BYTE POINTER GPART,                                                   04752000
               BPS0=S-0,                                                04754000
               ENTB;                                                    04756000
  DOUBLE DISKADR,                                                       04758000
         DP;                                                            04760000
  DOUBLE SYSDIRBASE,                                           <<*8833>>04762000
         DIRBASE;                                              <<*8833>>04764000
  INTEGER X=X,                                                          04766000
          S0=S-0,                                                       04768000
          DELTAQ=Q-0,                                        <<14NOV77>>04770000
          DDSDST,                                                       04772000
          LNUM,                                                         04774000
          PINX:=0,                                                      04776000
          P1=DP,                                                        04778000
          P2=P1+1;                                                      04780000
  INTEGER POINTER ENT;                                                  04782000
  LABEL ABORTSCAN;                                                      04784000
  LOGICAL LOGUNT;                                                       04786000
  POINTER PARMS;                                             <<14NOV77>>04788000
                                                                        04790000
  DOUBLE POINTER ENTD=ENT;                                              04792000
                                                                        04794000
  SUBR'MFDS4;                                                  <<*8833>>04796000
                                                               <<*8833>>04798000
          <<-------------------->>                                      04800000
                                                                        04802000
  SUBROUTINE PRINTINFO;                                                 04804000
  BEGIN                                                                 04806000
    IF CTLYD OR SOFTKILL THEN GO ABORTSCAN;                    <<00448>>04808000
    IF LP THEN                                                          04810000
      BEGIN                                                             04812000
        IF NXTLN<>1 THEN                    <<NOT TOP OF PAGE>>         04814000
          BEGIN                                                         04816000
            IF (X:=NXTLN+OUTL+4)<=61 THEN TOS:=SPACECTL                 04818000
              ELSE BEGIN                    <<WON'T FIT ON PAGE>>       04820000
                X:=OUTL+4;                  <<1+(OUTL+1)+2>>            04822000
                TOS:=PAGECTL;                                           04824000
              END;                                                      04826000
            FCONTROL(OUT,LPCNTL,S0);                                    04828000
            IF <> THEN GOTO OUTERR;                                     04830000
          END                                                           04832000
          ELSE BEGIN                                                    04834000
            TOS:=PAGECTL;                                               04836000
            X:=OUTL+4;                                                  04838000
          END;                                                          04840000
        IF TOS=PAGECTL AND ALLCLASS THEN    <<PRINT HEADING>>           04842000
          BEGIN                                                         04844000
            IF LEVEL=0 THEN                                             04846000
              BEGIN                                                     04848000
                ASSEMBLE(ADDS 13);                                      04850000
                MOVE BAS12:="GROUP:  ",2;                               04852000
                MOVE * := GPART,(17);                                   04854000
                FWRITE(OUT,BAS12,-25,%203);                             04856000
          IF < THEN GOTO  OUTERR                               <<02321>>04858000
          ELSE IF > THEN BEGIN                                 <<02321>>04860000
              ERROR([2/3,14/52]);                              <<02321>>04862000
              MOVE WBUF := WBUF(-1),(WBUFLEN); <<BLANK WBUF>>  <<02321>>04864000
              GOTO ABORTSCAN;                                  <<02321>>04866000
              END;                                             <<02321>>04868000
                ASSEMBLE(SUBS 13);                                      04870000
              END                                                       04872000
              ELSE BEGIN                                                04874000
                ASSEMBLE(ADDS 9);                                       04876000
                MOVE BAS8:="ACCOUNT:  ",2;                              04878000
                MOVE * := ANAME,(8);                                    04880000
                FWRITE(OUT,BAS8,-18,%203);                              04882000
          IF < THEN GOTO OUTERR                                <<02321>>04884000
          ELSE IF > THEN BEGIN                                 <<02321>>04886000
              ERROR([2/3,14/52]);                              <<02321>>04888000
              MOVE WBUF := WBUF(-1),(WBUFLEN);                 <<02321>>04890000
              GOTO ABORTSCAN;                                  <<02321>>04892000
              END;                                             <<02321>>04894000
                ASSEMBLE(SUBS 9);                                       04896000
              END;                                                      04898000
            X:=X+3;                                                     04900000
          END;                                                          04902000
        NXTLN:=IF X=61 THEN 1 ELSE X;       <<UPDATE NXTLN, THEN PRINT>>04904000
      END;                                                              04906000
    IF CTLYD OR SOFTKILL THEN GO ABORTSCAN;                    <<00448>>04908000
    FWRITE(OUT,STARLINE,10,0);                                          04910000
          IF < THEN GOTO OUTERR                                <<02321>>04912000
          ELSE IF > THEN BEGIN                                 <<02321>>04914000
              ERROR([2/3,14/52]);                              <<02321>>04916000
              MOVE WBUF := WBUF(-1),(WBUFLEN);                 <<02321>>04918000
              GOTO ABORTSCAN;                                  <<02321>>04920000
              END;                                             <<02321>>04922000
    FOR LNUM:=0 UNTIL OUTL DO               <<DUMP FORMATTED OUTPUT>>   04924000
      BEGIN                                                             04926000
        IF CTLYD OR SOFTKILL THEN GO ABORTSCAN;                <<00448>>04928000
        TOS:=@BUF((PINX+LINEL(LNUM))*2-1);<<LBPTR TO LAST CHAR>>        04930000
        IF BPS0 = " " THEN <<RIGHT DEBLANK>>                            04932000
           BEGIN                                                        04934000
           TOS:=S0-1;                                                   04936000
           IF *=*,(-LINEL(LNUM)*2+2),1 THEN; <<LEAVE ONE>>              04938000
            DELB;                                                       04940000
           END;                                                         04942000
        TOS:=-(TOS-@BUF(PINX*2))-1;<<LENGTH>>                           04944000
        FWRITE(OUT,WBUF(PINX),S0,0);                                    04946000
      DEL;                                                              04948000
     IF > THEN BEGIN                                           <<02321>>04950000
          ERROR([2/3,14/52]);                                  <<02321>>04952000
          MOVE WBUF := WBUF(-1),(WBUFLEN);                     <<02321>>04954000
          GO TO ABORTSCAN;                                     <<02321>>04956000
          END                                                  <<02321>>04958000
     ELSE IF < THEN                                            <<02321>>04960000
          BEGIN                                                         04962000
OUTERR:                                                                 04964000
            ERROR([2/3,14/17]);                                         04966000
            MOVE WBUF:=WBUF(-1),(WBUFLEN);                              04968000
            GO ABORTSCAN;                                               04970000
          END;                                                          04972000
        PINX:=PINX+LINEL(LNUM);                                         04974000
      END;                                                              04976000
    MOVE WBUF:=WBUF(-1),(PINX);                                         04978000
  END  <<SUBROUTINE PRINTINFO>>                                         04980000
  ;                                                                     04982000
                                                                        04984000
           <<-------------------->>                                     04986000
                                                                        04988000
        COMMENT:                                                        04990000
        << ON ENTRY, DB IS POINTING TO DIRECTORY DATA SEG AND           04992000
        << WE OWN A SIR.  MUST MOVE ENTRY ONTO STACK SEG AND            04994000
        << SWITCH DB.  AFTER READING FILE LABEL AND RECORD #0           04996000
        << (WHEN APPLICABLE), WE RELEASE THE SIR.                       04998000
        <<                                                              05000000
        << **NB: THROUGHOUT EXECUTION OF THIS ROUTINE, CRITICAL         05002000
        <<       IS SET (BY 'DIRECSCAN');                               05004000
    ASSEMBLE(ADDS 160);         <<ALLOCATE ENTRY BUFFER>>      <<01.PV>>05006000
    PUSH(S,DL);                                                         05008000
    TOS:=TOS-TOS-159;      <<PTR TO S-159 (DL-REL) >>          <<01.PV>>05010000
    TOS:=@ENTRIE;                                                       05012000
    TOS:=54;                                                   <<01.PV>>05014000
    ASSEMBLE(MVBL);                         <<MOVE ENTRY ONTO STACK>>   05016000
    DDSDST:=EXCHANGEDB(0);                                              05018000
    @ENTB:=(@ENT:=@S0-159)&LSL(1);                             <<01.PV>>05020000
    @PARMS:=@DELTAQ-DELTAQ+QPARMS;                             <<11.KM>>05022000
                                                             <<13NOV77>>05024000
    IF ALLCLASS THEN                   <<GENERIC NAME:  >>   <<13NOV77>>05026000
    BEGIN                              <<CHECK FOR MATCH>>   <<13NOV77>>05028000
      CASE *LEVEL OF BEGIN                                   <<13NOV77>>05030000
        TOS:=MATCH(G'FNAME,ENTB);                            <<13NOV77>>05032000
        TOS:=MATCH(G'GNAME,ENTB);                            <<13NOV77>>05034000
        TOS:=MATCH(G'ANAME,ENTB);                            <<13NOV77>>05036000
        TOS:=MATCH(G'UNAME,ENTB);                            <<13NOV77>>05038000
      END;                                                   <<13NOV77>>05040000
      IF TOS<>0 THEN                                         <<13NOV77>>05042000
      BEGIN                                                  <<13NOV77>>05044000
        FMTENTRY:=IF < THEN 3 ELSE 3;  <<SIR NOT REL'D>>     <<08FEB78>>05046000
        EXCHANGEDB(DDSDST);                                  <<13NOV77>>05048000
        RETURN;                                              <<13NOV77>>05050000
      END;                                                   <<13NOV77>>05052000
    END;                                                     <<13NOV77>>05054000
                                                             <<13NOV77>>05056000
    IF CTLYD OR SOFTKILL THEN                                  <<00448>>05058000
      BEGIN                                                             05060000
        TOS:=SIR;                                                       05062000
        RELSIR(*,*);                                                    05064000
        GO ABORTSCAN;                                                   05066000
      END;                                                              05068000
                                                               <<11.KM>>05070000
    IF LEVEL=GROUPLEVEL AND CMDTYP=FILELEVEL AND               <<11.KM>>05072000
      NOT PVDONE AND PVGROUP THEN                              <<*8675>>05074000
      BEGIN                                                    <<06137>>05076000
      IF  PVINFO.(MVTABXF)=0 THEN                              <<06137>>05078000
         BEGIN                            <<NO MOUNTED PV>>    <<06137>>05080000
         ERROR(NOMOUNT'RTN);                                   <<06137>>05082000
         FMTENTRY:=3;                     <<NEXTBROTHER+SIR>>  <<06137>>05084000
         EXCHANGEDB(DDSDST);                                   <<06137>>05086000
         RETURN;                                               <<06137>>05088000
         END                                                   <<06137>>05090000
      ELSE                                                     <<06137>>05092000
         BEGIN              << BEGIN SERCHING PV DIRECTORY >>  <<06137>>05094000
         TOS := SIR;                                           <<06137>>05096000
         RELSIR(*,*);                                          <<06137>>05098000
         PVFLAG := TRUE;   << TELLS GETCMDS THAT ERROR >>      <<06137>>05100000
                           << CONDITION WILL BE HANDLED>>      <<06137>>05102000
                           << IN THIS PROCEDURE.       >>      <<06137>>05104000
         IF SECONLY THEN                                       <<06137>>05106000
            FMTSECINFO(ENT,ENTB,LEVEL,LINEL,GPART);            <<06137>>05108000
         MVTABX := PVINFO.(MVTABXF);                           <<06137>>05110000
         TOS := CALLDIRECSCAN(FMTENTRY,PARMS,MVTABX);          <<06137>>05112000
                                                               <<*8675>>05114000
         << Set PVDONE to true so we won't print the private >><<*8675>>05116000
         << volume file information again.  Reset MVTABX to  >><<*8675>>05118000
         << 0 as we are back in the system directory.        >><<*8675>>05120000
                                                               <<*8675>>05122000
         PVDONE := TRUE;                                       <<*8675>>05124000
         MVTABX := 0;                                          <<*8675>>05126000
         IF CARRY THEN ERROR(S1+1);                            <<06137>>05128000
         IF ABORT <> 0 THEN QUIT(ABORT);                       <<06137>>05130000
         FMTENTRY := 2;         <<NEXT BROTHER, NO SIR>>       <<06137>>05132000
         EXCHANGEDB(DDSDST);                                   <<06137>>05134000
         RETURN;                                               <<06137>>05136000
         END;                                                  <<06137>>05138000
      END;                                                     <<06137>>05140000
                                                             <<15NOV77>>05142000
    IF LEVEL=0 THEN                         <<GET FILE LABEL>>          05144000
      BEGIN                                                             05146000
        << If the user's logon group is on a PV and he has   >><<*8833>>05148000
        << the home volume set mounted, an attempt may be    >><<*8833>>05150000
        << made to print PV directory information again.     >><<*8833>>05152000
        << Compare the system directory base and the one in  >><<*8833>>05154000
        << use (found in the directory data segment) to make >><<*8833>>05156000
        << sure they are the same.  If they are different,   >><<*8833>>05158000
        << the PV directory must be being used and we skip   >><<*8833>>05160000
        << this entry.                                       >><<*8833>>05162000
                                                               <<*8833>>05164000
        IF PVDONE THEN                                         <<*8833>>05166000
           BEGIN                                               <<*8833>>05168000
           MFDS4 (DIRBASE, DDSDST, DIRBASE'OFFSET, 2);         <<*8833>>05170000
                                                               <<*8833>>05172000
           << form system directory base address on TOS >>     <<*8833>>05174000
           TOS := DEF'SYSDIRBASE1;                             <<*8833>>05176000
           TOS.(0:8) := SYSLDEV;                               <<*8833>>05178000
           TOS := DEF'SYSDIRBASE2;                             <<*8833>>05180000
           SYSDIRBASE := TOS;                                  <<*8833>>05182000
                                                               <<*8833>>05184000
           IF DIRBASE <> SYSDIRBASE THEN                       <<*8833>>05186000
              BEGIN                                            <<*8833>>05188000
              FMTENTRY:=0;        << continue scan >>          <<*8833>>05190000
              EXCHANGEDB(DDSDST);                              <<*8833>>05192000
              RETURN;                                          <<*8833>>05194000
              END;                                             <<*8833>>05196000
           END;                                                <<*8833>>05198000
        LOGUNT := LUN (FDVTABINX,MVTABX);                      <<02.PV>>05200000
        P1:=ENT(4).(8:8);                                               05202000
        P2:=ENT(5);                                                     05204000
        DISKADR:=DP;                                                    05206000
        TOS:=ATTACHIO(LOGUNT,0,0,@ENT,0,128,P1,P2,1);          <<01549>>05208000
        DEL;                                                            05210000
        IF TOS.(8:8)<>1 THEN GOTO IOERR;                                05212000
        IF FLCODE=PROG AND FLEOF<>0D AND NOT SECONLY THEN               05214000
          BEGIN                             <<GET RECORD #0>>           05216000
            DP:=DP+DOUBLE(FLOFFSET);                                    05218000
            TOS:=ATTACHIO(LOGUNT,0,0,@ENT(128),0,8,P1,P2,1);   <<01549>>05220000
            DEL;                                                        05222000
            IF TOS.(8:8)<>1 THEN                                        05224000
              BEGIN                                                     05226000
IOERR:                                                                  05228000
                TOS:=SIR;                                               05230000
                RELSIR(*,*);                                            05232000
                ERROR([2/3,14/11]);                                     05234000
                GO ABORTSCAN;                                           05236000
              END;                                                      05238000
          END;                                                          05240000
      END;                                                              05242000
    TOS:=SIR;                                                           05244000
    RELSIR(*,*);                                                        05246000
    IF SECONLY THEN                                                     05248000
      BEGIN                                                             05250000
        IF FMTSECINFO(ENT,ENTB,LEVEL,LINEL,GPART) THEN PRINTINFO;       05252000
      END                                                               05254000
      ELSE                                                              05256000
        IF LEVEL=CMDTYP THEN                                 <<15NOV77>>05258000
        BEGIN                                                <<15NOV77>>05260000
          TOS:=@ENT;                                         <<15NOV77>>05262000
          TOS:=@ENTB;                                        <<15NOV77>>05264000
          CASE *LEVEL OF BEGIN                               <<15NOV77>>05266000
            FMTFILEINFO(*,*,LOGUNT,DISKADR,GNAME,LINEL,      <<15NOV77>>05268000
                        GPART);                              <<15NOV77>>05270000
            FMTGRPINFO(*,*,ANAME,LINEL);                     <<15NOV77>>05272000
            FMTACCTINFO(*,*,LINEL);                          <<15NOV77>>05274000
            FMTUSRINFO(*,*,ANAME,LINEL);                     <<15NOV77>>05276000
          END;                                               <<15NOV77>>05278000
          PRINTINFO;                                         <<15NOV77>>05280000
        END                                                  <<15NOV77>>05282000
        ELSE                                                 <<15NOV77>>05284000
          IF CMDTYP=GROUPLEVEL OR CMDTYP=USERLEVEL THEN      <<15NOV77>>05286000
          BEGIN                                              <<15NOV77>>05288000
            MOVE ANAME:=ADNAME,(8);                          <<15NOV77>>05290000
            NXTLN:=61;                                       <<15NOV77>>05292000
          END;                                               <<15NOV77>>05294000
    FMTENTRY:=0;                       <<CONTINUE DIRECTORY SCAN>>      05296000
    EXCHANGEDB(DDSDST);                                                 05298000
    RETURN;                                                             05300000
                                                                        05302000
ABORTSCAN:                                                              05304000
    FMTENTRY:=4;                       <<TERMINATE DIRECTORY SCAN>>     05306000
    EXCHANGEDB(DDSDST);                                                 05308000
END  <<PROCEDURE FMTENTRY>>                                             05310000
;                                                                       05312000
$PAGE "          DOUBLE PROCEDURE CALLDIRECSCAN"                        05314000
$CONTROL   SEGMENT=FMT2                                      <<??NOV77>>05316000
                                                                        05318000
                                                                        05320000
DOUBLE PROCEDURE CALLDIRECSCAN(RECIP,PARMS,MVTABX);          <<04DEC77>>05322000
                              VALUE MVTABX;                  <<04DEC77>>05324000
                              INTEGER PROCEDURE RECIP;       <<13NOV77>>05326000
                              ARRAY PARMS;                   <<13NOV77>>05328000
                              INTEGER MVTABX;                <<04DEC77>>05330000
                              OPTION PRIVILEGED;             <<14NOV77>>05332000
BEGIN                                                                   05334000
    COMMENT:                                                            05336000
    << SETS UP CONDITIONS FOR CALLING "DIRECSCAN".  ROUTINE MUST        05338000
    << FIRST SECURE PRIV MODE, DISABLE BREAK, AND PROTECT MPE WITH      05340000
    << "ERRORON".  BEFORE RETURNING WE RE-ENABLE BREAK.  WE             05342000
    << RETURN TO COMMAND INTERPRETER VIA "ERROREXIT" WHICH SETS         05344000
    << CARRY IF E<>0;                                                   05346000
                                                                        05348000
  EQUATE DISABLEBRK=14,                                                 05350000
         ENABLEBRK=15;                                                  05352000
  DOUBLE ARRAY DPARMS(*)=PARMS;                              <<13NOV77>>05354000
  INTEGER E:=0,                                                         05356000
          DUMMY;                                                        05358000
                                                                        05360000
          <<********************>>                                      05362000
                                                                        05364000
    ERRORON;                                                 <<14NOV77>>05366000
    FCONTROL(STDIN,DISABLEBRK,DUMMY);                                   05368000
    CALLDIRECSCAN:=DIRECSCAN(D'TYPE,D'INX,D'ANAME,D'GNAME,   <<13NOV77>>05370000
                             D'FNAME,RECIP,PARMS,MVTABX);    <<13NOV77>>05372000
    IF <> THEN E:=1;                                                    05374000
    FCONTROL(STDIN,ENABLEBRK,DUMMY);                                    05376000
    ERROREXIT(3,E,0);                                        <<07DEC77>>05378000
END  <<DOUBLE PROCEDURE CALLDIRECSCAN>>                                 05380000
;                                                                       05382000
$PAGE   "           PROCEDURE CALLPVPROC"                    <<01DEC77>>05384000
$CONTROL   SEGMENT=FMT2                                                 05386000
                                                                        05388000
PROCEDURE CALLPVPROC(PVPROC,VSNAME,VSGNAME,VSANAME,          <<03DEC77>>05390000
                     REQTYPE,GENINX,PVINFO);                            05392000
                    VALUE VSNAME,VSGNAME,VSANAME,GENINX;     <<03DEC77>>05394000
                    PROCEDURE PVPROC;                                   05396000
                    BYTE POINTER VSNAME,VSGNAME,VSANAME;     <<03DEC77>>05398000
                    INTEGER REQTYPE,GENINX,PVINFO;                      05400000
                    OPTION PRIVILEGED,VARIABLE;                         05402000
BEGIN <<PROCEDURE CALLPVPROC>>                      <<ADDED>><<02DEC77>>05404000
  COMMENT:                                                     <<00214>>05406000
    "PVPROC" MAY BE "MOUNT" OR "DISMOUNT".  ACTUAL CALLING     <<00214>>05408000
    SEQUENCES ARE:                                             <<00214>>05410000
      MOUNT(VSNAME,VSGNAME,VSANAME,REQTYPE,GENINX,PVINFO,      <<00214>>05412000
            OTHERPIN)                                          <<00214>>05414000
      DISMOUNT(VSNAME,VSGNAME,VSANAME,REQTYPE,PVINFO,          <<00214>>05416000
               OTHERPIN)                                       <<00214>>05418000
    ;                                                          <<00214>>05420000
                                                               <<00214>>05422000
  INTEGER E:=0;                                              <<08FEB78>>05424000
  LOGICAL PARMMASK=Q-4;                                      <<08FEB78>>05426000
  PROCEDURE MOUNT; OPTION EXTERNAL;                                     05428000
                                                                        05430000
                                                                        05432000
  IF FALSE THEN ERROR(NOTIMPLEMENTED);                       <<03FEB77>>05434000
  ERRORON;                                                              05436000
  TOS:=@VSNAME;                                              <<03DEC77>>05438000
  TOS:=@VSGNAME;                                             <<03DEC77>>05440000
  TOS:=@VSANAME;                                             <<03DEC77>>05442000
  TOS:=@REQTYPE;                                                        05444000
  IF @PVPROC=@MOUNT THEN                                                05446000
  BEGIN                                                                 05448000
    TOS:=GENINX;                                                        05450000
    TOS:=@PVINFO;                                                       05452000
    TOS:=0;  <<OTHERPIN>>                                      <<00214>>05454000
    TOS:=PARMMASK.(10:6)&LSL(1);                               <<00214>>05456000
  END                                                                   05458000
  ELSE BEGIN                                                            05460000
    TOS:=@PVINFO;                                            <<08FEB78>>05462000
    TOS:=0;  <<OTHERPIN>>                                      <<00214>>05464000
    TOS:=(PARMMASK.(10:4)&LSL(1) LOR PARMMASK.(15:1)) &LSL(1); <<00214>>05466000
  END;                                                                  05468000
  PVPROC;                                                               05470000
  IF <> THEN E:=1;                                                      05472000
  ERROREXIT(8,E,0);                                                     05474000
END  <<PROCEDURE CALLPVPROC>>;                                          05476000
$PAGE "          PROCEDURE CONTROLY"                                    05478000
$CONTROL   SEGMENT=CMD                                                  05480000
                                                                        05482000
                                                                        05484000
PROCEDURE CONTROLY;                                                     05486000
BEGIN                                                                   05488000
  DOUBLE DELTAPB=Q-2;                                                   05490000
  LABEL EXIT0;                                                          05492000
  INTEGER DELTAQ=Q-0;                                                   05494000
                                                                        05496000
          <<-------------------->>                                      05498000
                                                                        05500000
    MOVE WBUF:=WBUF(-1),(WBUFLEN);                                      05502000
    PRINT(WBUF,0,0);                                                    05504000
    IF <> THEN QUIT(2);                                                 05506000
    ASSEMBLE(ADDM EXIT0);                                               05508000
    DELTAQ:=@DELTAQ-ORGQ;              <<DELTAQ PTS TO ORGQ>>           05510000
    DELTAPB:=ORGADR;                                                    05512000
    RESETCONTROL;                                                       05514000
    ASSEMBLE(XEQ 0);                                                    05516000
EXIT0:                                                                  05518000
                                                                        05520000
END  <<PROCEDURE CONTROLY>>                                             05522000
;                                                                       05524000
$PAGE "          PROCEDURE SOFTCONTROLY"                     <<13NOV77>>05526000
$CONTROL  SEGMENT=CMD                                                   05528000
PROCEDURE SOFTCONTROLY;                                                 05530000
BEGIN <<PROCEDURE SOFTCONTROLY>>                             <<13NOV77>>05532000
  COMMENT:                                                              05534000
    THIS ROUTINE HANDLES A CONTROL-Y INTERRUPT WHICH OCCURRED           05536000
    BETWEEN GETPRIVMODE/GETUSERMODE BRACKET.  WE MUST BE                05538000
    CALLED THEN IF INTERNAL EXIT IS ANTICIPATED.  THIS IS DUE           05540000
    TO AN MPE/HP3000 BUG WHEREBY THE TRACE-BIT IS SET IN THE            05542000
    DELTA-PB TO DEFER CONTROL-Y TRAP, BUT THE TRACE-INTERRUPT           05544000
    ONLY OCCURS ON EXTERNAL EXITS!                                      05546000
                                                               <<11.KM>>05548000
    NOTE THAT THE RECOVERY HERE IS ESSENTIALLY THE SAME AS              05550000
    THAT FOR "CONTROLY", VIZ:  ALTER THE MARKER SO THAT WE              05552000
    EXIT BACK TO THE COMMAND INTERPRETER;                               05554000
                                                                        05556000
  DOUBLE DELTAPB=Q-2;                                                   05558000
  INTEGER DELTAQ=Q-0;                                                   05560000
  INTRINSIC RESETCONTROL;                                               05562000
                                                                        05564000
                                                                        05566000
  DELTAQ:=@DELTAQ-ORGQ;                <<DELTAQ PTS TO CI-Q>>           05568000
  DELTAPB:=ORGADR;                                                      05570000
  RESETCONTROL;                                                         05572000
END  <<PROCEDURE SOFTCONTROLY>>;                                        05574000
$PAGE "          PROCEDURE ERROR"                                       05576000
$CONTROL   SEGMENT=ERROR                                     <<13NOV77>>05578000
                                                                        05580000
                                                                        05582000
PROCEDURE ERROR(ERR);                                                   05584000
               VALUE ERR;                                               05586000
               INTEGER ERR;                                             05588000
BEGIN                                                                   05590000
  COMMENT:                                                              05592000
  << THIS ROUTINE PRINTS AN ERROR MESSAGE.  IT THEN PATCHES             05594000
  << UP THE STACK MARKER SO THAT WE RETURN TO 'GETCMDS' TO              05596000
  << REQUEST ADDITIONAL COMMANDS;                                       05598000
                                                                        05600000
                                                                        05602000
  COMMENT:                                                   <<22NOV77>>05604000
    LEN<II>:  LENGTH IN BYTES OF SOME MESSAGE (NOT MESSAGE     <<11.KM>>05606000
              <II>).  MAX LENGTH IS 76 (OR 68 FOR ALL CRT'S)   <<11.KM>>05608000
    INX<II>:  INDEX OF SOME MESSAGE                          <<30NOV77>>05610000
    INX(M):   INDEX OF MESSAGE <M>                           <<23NOV77>>05612000
    EMSG(N):  MESSAGE <M>, WHERE N=INX(M);                   <<22NOV77>>05614000
                                                             <<22NOV77>>05616000
  EQUATE LEN00= 15,  LEN01= 12,  LEN02= 13,  LEN03= 15,      <<22NOV77>>05618000
         LEN04= 12,  LEN05= 17,  LEN06= 19,  LEN07= 18,      <<22NOV77>>05620000
         LEN08= 21,  LEN09= 19,  LEN10= 18,  LEN11= 14,      <<22NOV77>>05622000
         LEN12= 17,  LEN13= 24,  LEN14= 23,  LEN15= 30,      <<30NOV77>>05624000
         LEN16= 29,  LEN17= 32,  LEN18= 22,  LEN19= 46,      <<23NOV77>>05626000
         LEN20= 17,  LEN21= 30,  LEN22= 33,  LEN23= 47,      <<23NOV77>>05628000
         LEN24= 18,  LEN25= 31,  LEN26= 34,  LEN27= 49,      <<23NOV77>>05630000
         LEN28= 20,  LEN29= 33,  LEN30= 36,  LEN31= 46,      <<23NOV77>>05632000
         LEN32= 17,  LEN33= 30,  LEN34= 33,  LEN35= 48,      <<23NOV77>>05634000
         LEN36= 19,  LEN37= 32,  LEN38= 35,  LEN39= 32,      <<30NOV77>>05636000
         LEN40= 33,  LEN41= 35,  LEN42= 32,  LEN43= 34,      <<01DEC77>>05638000
         LEN44= 34,  LEN45= 21,  LEN46= 26,  LEN47= 24,        <<11.KM>>05640000
          LEN48=56,LEN49=46,LEN50=41,LEN51=33,LEN52=27;        <<02321>>05642000
                                                             <<22NOV77>>05644000
  EQUATE INX01= LEN00,        INX02= INX01+LEN01,            <<22NOV77>>05646000
         INX03= INX02+LEN02,  INX04= INX03+LEN03,            <<22NOV77>>05648000
         INX05= INX04+LEN04,  INX06= INX05+LEN05,            <<22NOV77>>05650000
         INX07= INX06+LEN06,  INX08= INX07+LEN07,            <<22NOV77>>05652000
         INX09= INX08+LEN08,  INX10= INX09+LEN09,            <<22NOV77>>05654000
         INX11= INX10+LEN10,  INX12= INX11+LEN11,            <<22NOV77>>05656000
         INX13= INX12+LEN12,  INX14= INX13+LEN13,            <<22NOV77>>05658000
         INX15= INX14+LEN14,  INX16= INX15+LEN15,            <<22NOV77>>05660000
         INX17= INX16+LEN16,  INX18= INX17+LEN17,            <<22NOV77>>05662000
         INX19= INX18+LEN18,  INX20= INX19+LEN19,            <<22NOV77>>05664000
         INX21= INX20+LEN20,  INX22= INX21+LEN21,            <<22NOV77>>05666000
         INX39= INX22+LEN22,                                 <<30NOV77>>05668000
         INX23= INX39+LEN39,  INX24= INX23+LEN23,            <<30NOV77>>05670000
         INX25= INX24+LEN24,  INX26= INX25+LEN25,            <<22NOV77>>05672000
         INX40= INX26+LEN26,                                 <<30NOV77>>05674000
         INX27= INX40+LEN40,  INX28= INX27+LEN27,            <<30NOV77>>05676000
         INX29= INX28+LEN28,  INX30= INX29+LEN29,            <<22NOV77>>05678000
         INX41= INX30+LEN30,                                 <<30NOV77>>05680000
         INX31= INX41+LEN41,  INX32= INX31+LEN31,            <<30NOV77>>05682000
         INX33= INX32+LEN32,  INX34= INX33+LEN33,            <<22NOV77>>05684000
         INX42= INX34+LEN34,                                 <<30NOV77>>05686000
         INX35= INX42+LEN42,  INX36= INX35+LEN35,            <<30NOV77>>05688000
         INX37= INX36+LEN36,  INX38= INX37+LEN37,            <<22NOV77>>05690000
         INX43= INX38+LEN38,  INX44= INX43+LEN43,            <<01DEC77>>05692000
         INX45= INX44+LEN44,  INX46= INX45+LEN45,            <<01DEC77>>05694000
         INX47= INX46+LEN46,  INX48= INX47+LEN47,              <<11.KM>>05696000
          INX49=INX48+LEN48, INX50=INX49+LEN49,                <<02321>>05698000
          INX51=INX50+LEN50, INX52=INX51+LEN51,                <<02321>>05700000
          INX00=INX52+LEN52;                                   <<02321>>05702000
          << LAST + 1 MSG INDEX >>                             <<02321>>05704000
                                                             <<22NOV77>>05706000
  INTEGER ARRAY INX(*)=PB:=                                  <<22NOV77>>05708000
    <<00>>     0, INX01, INX02, INX03, INX04,                <<22NOV77>>05710000
    <<05>> INX05, INX06, INX07, INX08, INX09,                <<22NOV77>>05712000
    <<10>> INX10, INX11, INX12, INX13, INX14,                <<22NOV77>>05714000
    <<15>> INX15, INX16, INX17, INX18, INX19,                <<22NOV77>>05716000
    <<20>> INX20, INX21, INX22, INX39, INX23,                <<30NOV77>>05718000
    <<25>> INX24, INX25, INX26, INX40, INX27,                <<30NOV77>>05720000
    <<30>> INX28, INX29, INX30, INX41, INX31,                <<30NOV77>>05722000
    <<35>> INX32, INX33, INX34, INX42, INX35,                <<30NOV77>>05724000
    <<40>> INX36, INX37, INX38, INX43, INX44,                <<01DEC77>>05726000
   <<45>> INX45, INX46, INX47, INX48, INX49,                   <<02321>>05728000
   <<46>> INX50, INX51, INX52, INX00;                          <<02321>>05730000
                                                             <<22NOV77>>05732000
  BYTE ARRAY EMSG(*)=PB:=                                    <<22NOV77>>05734000
    <<00>> "INVALID COMMAND",                                <<22NOV77>>05736000
           "NO SUCH FILE",                                   <<22NOV77>>05738000
           "NO SUCH GROUP",                                  <<22NOV77>>05740000
           "NO SUCH ACCOUNT",                                <<22NOV77>>05742000
           "NO SUCH USER",                                   <<22NOV77>>05744000
    <<05>> "INVALID PARAMETER",                              <<22NOV77>>05746000
           "DUPLICATE PARAMETER",                            <<22NOV77>>05748000
           "INVALID DESIGNATOR",                             <<22NOV77>>05750000
           "ACCOUNT IS NOT LOG-ON",                          <<22NOV77>>05752000
           "GROUP IS NOT LOG-ON",                            <<22NOV77>>05754000
    <<10>> "USER IS NOT LOG-ON",                             <<22NOV77>>05756000
           "DISC I/O ERROR",                                 <<22NOV77>>05758000
           "MISSING PARAMETER",                              <<22NOV77>>05760000
           "INVALID FILESET FOR USER",                       <<22NOV77>>05762000
           "LOCKWORD IS NOT ALLOWED",                        <<30NOV77>>05764000
    <<15>> "CANNOT CLOSE LIST FILE--FSERR=",                   <<02321>>05766000
           "CANNOT OPEN LIST FILE--FSERR=",                    <<02321>>05768000
           "WRITE ERROR ON LIST FILE--FSERR=",                 <<02321>>05770000
           "INVALID LIST FILE NAME",                         <<22NOV77>>05772000
           "FILE NAME BEGINS WITH NUMERIC CHARACTER OR '#'", <<23NOV77>>05774000
    <<20>> "MISSING FILE NAME",                              <<30NOV77>>05776000
           "FILE NAME EXCEEDS 8 CHARACTERS",                 <<22NOV77>>05778000
           "MISSING DELIMITER AFTER FILE NAME",              <<22NOV77>>05780000
           "GENERIC FILE NAME IS NOT ALLOWED",               <<30NOV77>>05782000
           "GROUP NAME BEGINS WITH NUMERIC CHARACTER OR '#'",<<23NOV77>>05784000
    <<25>> "MISSING GROUP NAME",                             <<30NOV77>>05786000
           "GROUP NAME EXCEEDS 8 CHARACTERS",                <<30NOV77>>05788000
           "MISSING DELIMITER AFTER GROUP NAME",             <<22NOV77>>05790000
           "GENERIC GROUP NAME IS NOT ALLOWED",              <<30NOV77>>05792000
           "ACCOUNT NAME BEGINS WITH NUMERIC CHARACTER",     <<22NOV77>>05794000
             " OR '#'",                                      <<23NOV77>>05796000
    <<30>> "MISSING ACCOUNT NAME",                           <<30NOV77>>05798000
           "ACCOUNT NAME EXCEEDS 8 CHARACTERS",              <<22NOV77>>05800000
           "MISSING DELIMITER AFTER ACCOUNT NAME",           <<30NOV77>>05802000
           "GENERIC ACCOUNT NAME IS NOT ALLOWED",            <<30NOV77>>05804000
           "USER NAME BEGINS WITH NUMERIC CHARACTER OR '#'", <<23NOV77>>05806000
    <<35>> "MISSING USER NAME",                              <<30NOV77>>05808000
           "USER NAME EXCEEDS 8 CHARACTERS",                 <<22NOV77>>05810000
           "MISSING DELIMITER AFTER USER NAME",              <<22NOV77>>05812000
           "GENERIC USER NAME IS NOT ALLOWED",               <<30NOV77>>05814000
           "VOLUME NAME BEGINS WITH NUMERIC CHARACTER",      <<30NOV77>>05816000
             " OR '#'",                                      <<23NOV77>>05818000
    <<40>> "MISSING VOLUME NAME",                            <<30NOV77>>05820000
           "VOLUME NAME EXCEEDS 8 CHARACTERS",               <<22NOV77>>05822000
           "MISSING DELIMITER AFTER VOLUME NAME",            <<22NOV77>>05824000
           "GENERIC VOLUME NAME IS NOT ALLOWED",             <<01DEC77>>05826000
           "USER DOES NOT HAVE ""UV"" CAPABILITY",           <<01DEC77>>05828000
    <<45>> "PRIVATE VOLUME ERROR=",                          <<01DEC77>>05830000
           "COMMAND IS NOT IMPLEMENTED",                     <<01DEC77>>05832000
           "INVALID GENERATION INDEX",                         <<11.KM>>05834000
           "'>MOUNT' REQUIRED BEFORE LISTING FILES ON ",       <<11.KM>>05836000
          "PRIVATE VOLUME",                                    <<02321>>05838000
          "MPE COMMANDS MAY NOT BE EXECUTED FROM LISTDIR5",    <<*8656>>05840000
   <<50>> "ERROR FOUND ON INPUT. LISTDIR5 TERMINATED",         <<*8656>>05842000
          "EOF DETECTED. LISTDIR5 TERMINATED",                 <<*8656>>05844000
          "EOF DETECTED ON OUTPUT FILE";                       <<02321>>05846000
                                                             <<01DEC77>>05848000
  DEFINE SETCCE= BEGIN                                       <<30NOV77>>05850000
                   TOS:=QSTATUS;                             <<30NOV77>>05852000
                   ASSEMBLE(TSBC 6; TRBC 7);                            05854000
                   QSTATUS:=TOS;                                        05856000
                 END                        #;                          05858000
  DEFINE SETCCG= QSTATUS.(6:1):=0 #;                                    05860000
  ARRAY WMSG(0:39);                                          <<22NOV77>>05862000
  BYTE ARRAY MSG(*)=WMSG;                                    <<22NOV77>>05864000
  DOUBLE DELTAPB=Q-2;                                                   05866000
  INTEGER X=X,                                                          05868000
          DELTAQ=Q-0,                                                   05870000
          QSTATUS=Q-1,                                                  05872000
          FERR,                                                         05874000
          QERR,                                              <<13NOV77>>05876000
          LENGTH;                                            <<13NOV77>>05878000
  LOGICAL LERR=ERR;                                                     05880000
                                                                        05882000
          <<-------------------->>                                      05884000
                                                                        05886000
    SETCCE;                                                             05888000
    QERR:=LERR LAND %377;                                    <<13NOV77>>05890000
    MOVE MSG:="  **",2;                                      <<13NOV77>>05892000
    MOVE * := EMSG(INX(QERR)),(INX(QERR+1)-INX(QERR)),2;     <<13NOV77>>05894000
    LENGTH:=TOS-LOGICAL(@MSG);                               <<13NOV77>>05896000
    IF 15<=QERR<=17 THEN                    <<APPEND FILE ERROR CODE>>  05898000
      BEGIN                                                             05900000
        FCHECK((IF X=17 THEN OUT ELSE LASTOUT),FERR);                   05902000
        PRINT(WMSG,-(ASCII(FERR,10,MSG(LENGTH))+X),0);       <<22NOV77>>05904000
      END                                                               05906000
      ELSE                                                   <<01DEC77>>05908000
        IF QERR=PVERROR THEN           <<APPEND PV ERR#>>    <<01DEC77>>05910000
        BEGIN                                                <<01DEC77>>05912000
          PRINT(WMSG,-(ASCII(REQTYPE,10,MSG(LENGTH))+X),0);  <<01DEC77>>05914000
          PVINFO:=0;                                         <<01DEC77>>05916000
        END                                                  <<01DEC77>>05918000
      ELSE PRINT(WMSG,-LENGTH,0);                            <<13NOV77>>05920000
    IF <> THEN                                                          05922000
      BEGIN                                                             05924000
        IF NOT LERR&CSL(2) THEN QUIT(2)                                 05926000
          ELSE BEGIN                                                    05928000
            SETCCG;                                                     05930000
            ABORT:=2;                                                   05932000
          END;                                                          05934000
      END                                                               05936000
      ELSE                                                              05938000
           IF ERR >=0 AND ERR<>51 AND ERR<>50 THEN             <<02321>>05940000
          BEGIN                                                         05942000
                COMMENT:                                                05944000
                << RETURN TO 'REINIT' IN 'GETCMDS';                     05946000
            DELTAQ:=@DELTAQ-ORGQ;               <<DELTAQ PTS TO ORGQ>>  05948000
            DELTAPB:=ORGADR;                                            05950000
          END;                                                          05952000
END  <<PROCEDURE ERROR>>                                                05954000
;                                                                       05956000
$PAGE "          PROCEDURE FINDTOKEN"                                   05958000
$CONTROL   SEGMENT=CMD                                                  05960000
                                                                        05962000
                                                                        05964000
LOGICAL PROCEDURE FINDTOKEN(CMD,STR,MAXLEN,DELIM,BLNKSOK);              05966000
                          VALUE MAXLEN,DELIM,BLNKSOK;                   05968000
                          BYTE POINTER CMD,STR;                         05970000
                          INTEGER MAXLEN,DELIM;                         05972000
                          LOGICAL BLNKSOK;                              05974000
                          OPTION VARIABLE;                              05976000
BEGIN                                                                   05978000
  COMMENT:                                                              05980000
    << SCANS "CMD" FOR STRING OF CHARACTERS DELIMITED BY SPECIFIED      05982000
    << DELIMITER OR CR (CARRIAGE RETURN).  A BYTE PTR TO THE FIRST      05984000
    << NONBLANK CHARACTER IN TOKEN IS RETURNED IN "STR".  A CR IS       05986000
    << STORED FOLLOWING THE LAST NONBLANK CHARACTER IN THE TOKEN        05988000
    << AND THE TOKEN STRING IS UPSHIFTED.  "FINDTOKEN" RETURNS          05990000
    << TRUE WHEN A TOKEN IS SUCCESSFULLY SCANNED.  WE ALSO              05992000
    << SET "EOL" IF THE TERMINATOR WAS A CR IS INSTEAD OF THE           05994000
    << SPECIFIED DELIMITER.  THE BYTE PTR "CMD" IS LEFT POINTING        05996000
    << PAST THE DELIMITER, BUT WE DO NOT ADVANCE THE BYTE PTR           05998000
    << PAST THE CR.                                                     06000000
    <<                                                                  06002000
    << THE DEFAULT DELIMITER IS A SEMICOLON.  USUAL GROUNDS FOR         06004000
    << AN ERROR ARE:  EMBEDDED BLANKS AND A TOKEN THAT IS TOO           06006000
    << LONG.  NORMALLY, AN ERROR CAUSES A TRAP TO "ERROR".              06008000
    <<                                                                  06010000
    << REQUIRED PARAMETERS ARE:                                         06012000
    <<     CMD        -- BYTE PTR INTO THE COMMAND STRING.  THE         06014000
    <<                   STRING MUST BE DELIMITED BY A CR.  ON          06016000
    <<                   EXIT, THIS PTR IS LEFT POINTING PAST THE       06018000
    <<                   DELIMITER, BUT WE DO NOT ADVANCE THE PTR       06020000
    <<                   PAST THE CR.                                   06022000
    <<     STR        -- ON EXIT (IFF "FINDTOKEN" IS TRUE), A BYTE      06024000
    <<                   PTR TO THE FIRST NONBLANK CHARACTER OF         06026000
    <<                   THE TOKEN.  A CR IS STORED FOLLOWING THE       06028000
    <<                   LAST NONBLANK CHARACTER OF THE TOKEN AND       06030000
    <<                   THE TOKEN IS UPSHIFTED.                        06032000
    <<     STRLEN     -- MAXIMUM SIZED TOKEN ALLOWED.                   06034000
    << OPTIONAL PARAMETERS ARE:                                         06036000
    <<     DELIM      -- THE DELIMITER FOR THE TOKEN.  THE TOKEN        06038000
    <<                   IS TAKEN AS THAT STRING DELIMITED BY           06040000
    <<                   THIS SEPARATOR OR THE CR.  IF NOT              06042000
    <<                   SPECIFIED, THE DEFAULT DELIMITER IS A          06044000
    <<                   SEMICOLON.                                     06046000
    <<     BLNKSOK    -- IF SET TRUE, EMBEDDED BLANKS ARE PERMITTED     06048000
    <<                   IN THE TOKEN STRING.  LEADING AND TRAILING     06050000
    <<                   BLANKS ARE STILL NOT INCLUDED IN THE TOKEN.    06052000
    <<                   THE DEFAULT IS TO DISALLOW EMBEDDED BLANKS.    06054000
    << ;                                                                06056000
                                                                        06058000
  EQUATE CR=%15,                                                        06060000
         HICR=[8/CR,8/0],                                               06062000
         CRSCOL=[8/CR,8/";"],                                           06064000
         CRBLNK=[8/CR,8/" "];                                           06066000
  BYTE POINTER BPS0=S-0;                                                06068000
  INTEGER X=X,                                                          06070000
          S0=S-0;                                                       06072000
  LOGICAL PARMMASK=Q-4;                                      <<13NOV77>>06074000
                                                                        06076000
          <<-------------------->>                                      06078000
                                                                        06080000
    IF NOT PARMMASK THEN BLNKSOK:=FALSE;                     <<13NOV77>>06082000
    IF NOT PARMMASK&LSR(1) THEN DELIM:=";";                  <<30NOV77>>06084000
                                                                        06086000
        COMMENT:                                                        06088000
        << ISOLATE STRING.  LEFT-DEBLANK AND LOCATE DELIMITER.          06090000
        << SET @CMD AND EOL;                                            06092000
                                                                        06094000
    SCAN CMD WHILE CRBLNK,1;           <<SCAN LEADING BLNKS>>           06096000
    @STR:=S0;                          <<BPTR TO 1ST NONBLNK>>          06098000
    SCAN * UNTIL HICR+DELIM,1;         <<S0=@DELIM>>         <<30NOV77>>06100000
    IF CARRY THEN                      <<AT EOS>>                       06102000
      BEGIN                                                             06104000
        @CMD:=S0;                                                       06106000
        EOL:=TRUE;                                                      06108000
      END                                                               06110000
      ELSE BEGIN                                                        06112000
        @CMD:=S0+1;                    <<SKIP DELIMITER>>               06114000
        EOL:=FALSE;                                                     06116000
      END;                                                              06118000
                                                                        06120000
        COMMENT:                                                        06122000
        << RIGHT-DEBLANK AND DELIMIT STRING;                            06124000
                                                                        06126000
    X:=-1;                                                              06128000
    WHILE S0<>@STR AND BPS0(X)=" " DO TOS:=TOS-1;                       06130000
    BPS0:=CR;                          <<S0=BPTR TO LAST NONBLANK+1>>   06132000
    TOS:=S0-@STR;                      <<STRING LENGTH>>                06134000
    IF <> THEN                                                          06136000
      BEGIN                                                             06138000
        FINDTOKEN:=TRUE;                                                06140000
        IF TOS>MAXLEN THEN ERROR(5);                                    06142000
            COMMENT:                                                    06144000
            << S0=BPTR TO EOS.                                          06146000
            << UPSHIFT STR AND CHECK FOR EMBEDDED BLANKS;               06148000
        TOS:=@STR(-1);                                                  06150000
        DO BEGIN                                                        06152000
          TOS:=TOS+1;                                                   06154000
          MOVE * := BPS0 WHILE ANS,1;  <<UPSHIFT>>                      06156000
          IF BPS0=" " AND NOT BLNKSOK THEN ERROR(5);                    06158000
          ASSEMBLE(DDUP,CMP);                                           06160000
        END UNTIL =;                   <<END OF STR>>                   06162000
      END;                                                              06164000
END  <<PROCEDURE FINDTOKEN>>                                            06166000
;                                                                       06168000
$PAGE "          PROCEDURE HELP"                                        06170000
$CONTROL   SEGMENT=ERROR                                     <<13NOV77>>06172000
                                                                        06174000
                                                                        06176000
PROCEDURE HELP(CMD);                                                    06178000
VALUE CMD;                                                              06180000
BYTE POINTER CMD;                                                       06182000
BEGIN                                                                   06184000
  BYTE ARRAY LINES(*)=PB:=                                              06186000
     49,"CONTROL-Y MAY BE TYPED ANYTIME TO STOP THE OUTPUT",            06188000
     17,"FROM ANY COMMAND.",                                            06190000
      0,                                                                06192000
     18,"COMMAND SYNTAX IS:",                                           06194000
     42,"  LISTACCT  [<ASET>] [,<LISTFILE>] [;PASS]",                   06196000
     42,"  LISTGROUP [<GSET>] [,<LISTFILE>] [;PASS]",                   06198000
     42,"  LISTUSER  [<USET>] [,<LISTFILE>] [;PASS]",                   06200000
     42,"  LISTSEC    <FSET>  [,<LISTFILE>] [;PASS]",                   06202000
     49,"  LISTF      <FSET>  [,<LISTFILE>] [;PASS] [;MAP]",            06204000
     24,"  HELP      [<LISTFILE>]",                                     06206000
     40,"  MOUNT     [<VDESIG>] [;GEN=[<GENINX>]]",          <<30NOV77>>06208000
     10,"  DISMOUNT",                                        <<30NOV77>>06210000
      6,"  EXIT",                                                       06212000
      0,                                                                06214000
     32,"  <ASET>     IS AN ACCOUNT NAME.",                  <<??NOV77>>06216000
     56,"  <GSET>     IS A GROUP NAME, OPTIONALLY QUALIFIED BY AN",     06218000
     29,"                ACCOUNT NAME.",                     <<??NOV77>>06220000
     51,"                EXAMPLES:  LISTGROUP MYGROUP.MYACCT",          06222000
     45,"                           LISTGROUP @.MYACCT",                06224000
     40,"                           LISTGROUP @.@",                     06226000
     55,"  <FSET>     IS A FILE NAME, OPTIONALLY QUALIFIED BY A ",      06228000
     39,"                GROUP AND ACCOUNT NAME.",           <<??NOV77>>06230000
     54,"                EXAMPLES:  LISTF MYFILE.MYGROUP.MYACCT",       06232000
     42,"                           LISTF @.MYGROUP",                   06234000
     54,"  <LISTFILE> IS ANY VALID FILE DESIGNATOR, PRECEDED BY",       06236000
     53,"                AN ASTERISK TO BACK-REFERENCE A :FILE",        06238000
     55,"                COMMAND.  WITHOUT AN ASTERISK, THE FILE",      06240000
     56,"                DESIGNATOR MUST BE AN EXISTING TEMPORARY",     06242000
     34,"                OR PERMANENT FILE.",                           06244000
     46,"                EXAMPLE:  LISTACCT @, *PRINTER",               06246000
     52,"  <VDESIG>   IS A VOLUME-SET NAME OR ""*"", ",      <<30NOV77>>06248000
        "OPTIONALLY",                                        <<30NOV77>>06250000
     59,"                QUALIFIED BY A GROUP AND ACCOUNT ", <<30NOV77>>06252000
        "NAME.  ""*""",                                      <<30NOV77>>06254000
     60,"                SPECIFIES THE HOME VOLUME SET ",    <<30NOV77>>06256000
        "(THE DEFAULT).",                                    <<30NOV77>>06258000
     54,"  <GENINX>   IS A GENERATION INDEX (0-65535).  ",   <<30NOV77>>06260000
        """65535""",                                         <<30NOV77>>06262000
     53,"                DENOTES ANY GENERATION (THE ",      <<30NOV77>>06264000
        "DEFAULT).",                                         <<30NOV77>>06266000
      0,                                                     <<30NOV77>>06268000
     55,"AN <ASET>, <GSET> AND <FSET> NAME MAY BE ",         <<03DEC77>>06270000
        "GENERIC NAMES,",                                    <<03DEC77>>06272000
     53,"VIZ.:  A SEQUENCE OF UP TO 8 ALPHANUMERIC ",        <<03DEC77>>06274000
        "CHARACTERS,",                                       <<30NOV77>>06276000
     51,"""?"", ""#"" AND ""@"".  THE LATTER THREE ",        <<03DEC77>>06278000
        "CHARACTERS HAVE",                                   <<03DEC77>>06280000
     23,"THE FOLLOWING MEANINGS:",                           <<03DEC77>>06282000
     51,"     ""?"" MATCHES EXACTLY ONE ALPHANUMERIC ",      <<30NOV77>>06284000
        "CHARACTER",                                         <<30NOV77>>06286000
     46,"     ""#"" MATCHES EXACTLY ONE NUMERIC CHARACTER",  <<30NOV77>>06288000
     54,"     ""@"" MATCHES ZERO OR MORE ALPHANUMERIC ",     <<30NOV77>>06290000
        "CHARACTERS.",                                       <<30NOV77>>06292000
      8,"EXAMPLE:",                                          <<30NOV77>>06294000
     55,"     LISTF K#######.@     LISTS ALL EDIT/3000 ",    <<30NOV77>>06296000
        "TEMPORARY",                                         <<30NOV77>>06298000
     54,"                          FILES IN THE LOG-ON ",    <<30NOV77>>06300000
        "ACCOUNT.",                                          <<30NOV77>>06302000
      0,                                                     <<30NOV77>>06304000
     52,"A NON-MANAGER USER MAY NOT SPECIFY GENERIC GROUP ", <<30NOV77>>06306000
        "AND",                                               <<30NOV77>>06308000
     52,"ACCOUNT NAMES.  AN ACCOUNT MANAGER MAY NOT ",       <<30NOV77>>06310000
        "SPECIFY A",                                         <<30NOV77>>06312000
     21,"GENERIC ACCOUNT NAME.",                             <<30NOV77>>06314000
      0,                                                                06316000
     53,"""PASS"" PERMITS ACCOUNT AND SYSTEM MANAGERS TO ",  <<30NOV77>>06318000
        "DISPLAY",                                           <<30NOV77>>06320000
     49,"PASSWORDS, LOCKWORDS, CREATOR ID'S, AND FILE DISC", <<30NOV77>>06322000
     51,"ADDRESSES.  THE CREATOR OF A FILE IS ALSO ",        <<30NOV77>>06324000
        "PERMITTED",                                         <<30NOV77>>06326000
     45,"TO DISPLAY DISC ADDRESSES AND THE CREATOR ID.",     <<30NOV77>>06328000
      0,                                                                06330000
     53,"""MAP"" PERMITS THE FILE CREATOR AND ACCOUNT AND ", <<30NOV77>>06332000
        "SYSTEM",                                            <<30NOV77>>06334000
     40,"MANAGERS TO DISPLAY THE FILE EXTENT MAP.",          <<30NOV77>>06336000
      0,                                                     <<30NOV77>>06338000
     51,"THE ""MOUNT"" AND ""DISMOUNT"" COMMANDS CONTROL ",  <<30NOV77>>06340000
        "PRIVATE",                                           <<30NOV77>>06342000
     50,"VOLUMES.  COMMANDS SUBSEQUENT TO A ""MOUNT"" ",     <<01DEC77>>06344000
        "COMMAND",                                           <<01DEC77>>06346000
     54,"REFER TO ENTRIES ON THE PRIVATE VOLUME (EXCEPT ",   <<04DEC77>>06348000
        "FOR THE",                                           <<04DEC77>>06350000
     52,"""LISTUSER"" COMMAND WHICH ALWAYS DISPLAYS THE ",   <<04DEC77>>06352000
        "SYSTEM ",                                           <<04DEC77>>06354000
     53,"DIRECTORY ENTRY).  THE VOLUME REMAINS MOUNTED ",    <<04DEC77>>06356000
        "UNTIL A",                                           <<04DEC77>>06358000
     41,"SUBSEQUENT ""MOUNT"" OR ""DISMOUNT"" COMMAND.",     <<04DEC77>>06360000
    255;                                                                06362000
                                                             <<01DEC77>>06364000
  EQUATE CRBLNK=[8/%15,8/" "],                               <<01DEC77>>06366000
           FLAGGED18=[1/1,15/18],                                       06368000
           FLAGGED5=[1/1,15/5];                                         06370000
  ARRAY WBUF(0:35);                                                     06372000
  BYTE ARRAY BAS1(*)=S-1,                                               06374000
             BUF(*)=WBUF;                                               06376000
  BYTE POINTER QNAME;                                        <<01DEC77>>06378000
  INTEGER S1=S-1,                                                       06380000
          CHARS,                                                        06382000
          NXT:=0,                                                       06384000
          PAGE:=0;                                                      06386000
  LOGICAL EXIT:=FALSE,WAIT;                                             06388000
                                                                        06390000
          <<-------------------->>                                      06392000
                                                                        06394000
    INTEGER SUBROUTINE LEN;                                             06396000
    BEGIN                                                               06398000
      MOVE BAS1(1):=LINES(NXT),(1);                                     06400000
      IF S1=255 THEN LEN:=-1;                                           06402000
    END  <<INTEGER SUBROUTINE LEN>>;                                    06404000
                                                                        06406000
    LOGICAL SUBROUTINE CONT;                                            06408000
    BEGIN                                                               06410000
      FWRITE(OUT,WBUF,0,0);                                             06412000
     IF < THEN ERROR(17)                                       <<02321>>06414000
     ELSE IF > THEN ERROR(52);                                 <<02321>>06416000
      DO BEGIN                                                          06418000
        MOVE WBUF:="CONTINUE? (Y/N) ";                                  06420000
        FWRITE(OUT,WBUF,-15,%320);                                      06422000
     IF < THEN ERROR(17)                                       <<02321>>06424000
     ELSE IF > THEN ERROR(52);                                 <<02321>>06426000
        TOS:=READ(WBUF,-4);                                             06428000
        IF <> THEN QUIT(3);                                             06430000
        BUF:=LOGICAL(BUF) LAND %137;<<UPSHIFT>>                         06432000
      END UNTIL TOS>=1 AND (BUF="Y" OR BUF="N");                        06434000
      IF BUF="Y" THEN                                                   06436000
        BEGIN                                                           06438000
          CONT:=TRUE;                                                   06440000
          FWRITE(OUT,WBUF,0,0);                                         06442000
     IF < THEN ERROR(17)                                       <<02321>>06444000
     ELSE IF > THEN ERROR(52);                                 <<02321>>06446000
          PAGE:=0;                                                      06448000
        END;                                                            06450000
    END  <<LOGICAL SUBROUTINE CONT>>;                                   06452000
                                                                        06454000
           <<------------------->>                                      06456000
                                                                        06458000
    IF FINDTOKEN(CMD,QNAME,72,,TRUE) THEN                               06460000
       BEGIN                                                            06462000
       SCAN QNAME UNTIL CRBLNK;                                         06464000
       IF CARRY AND EOL THEN GETFNAME(QNAME,TRUE)                       06466000
       ELSE ERROR(FLAGGED18);                                           06468000
       END                                                              06470000
       ELSE IF NOT EOL  THEN ERROR(FLAGGED5);                           06472000
    WAIT:=FRELATE(STDIN,OUT);          <<IF INTERACTIVE>>    <<08FEB78>>06474000
    FWRITE(OUT,WBUF,0,0);                                               06476000
     IF < THEN ERROR(17)                                       <<02321>>06478000
     ELSE IF > THEN ERROR(52);                                 <<02321>>06480000
    WHILE NOT EXIT AND (CHARS:=LEN)>=0 DO                               06482000
    BEGIN                                                               06484000
      IF PAGE=22 AND WAIT AND NOT CONT THEN EXIT:=TRUE  <<CHECK>>       06486000
        ELSE BEGIN                                                      06488000
          MOVE BUF:=LINES(NXT+1),(CHARS);                               06490000
          FWRITE(OUT,WBUF,-CHARS,0);                                    06492000
     IF < THEN ERROR(17)                                       <<02321>>06494000
     ELSE IF > THEN ERROR(52);                                 <<02321>>06496000
          NXT:=NXT+CHARS+1;                                             06498000
          PAGE:=PAGE+1;                                                 06500000
        END;                                                            06502000
    END;                                                                06504000
END  <<PROCEDURE HELP>>;                                                06506000
$PAGE "          PROCEDURE GETGENNAME"                       <<13NOV77>>06508000
$CONTROL  SEGMENT=CMD                                                   06510000
                                                                        06512000
                                                                        06514000
PROCEDURE GETGENNAME(QNAME,ERRBASE,LEAFNAME,DELIM,GENERIC,   <<30NOV77>>06516000
                     LENGTH);                                <<30NOV77>>06518000
                    VALUE QNAME,ERRBASE,LEAFNAME,GENERIC,    <<06DEC77>>06520000
                          LENGTH;                            <<06DEC77>>06522000
                    BYTE POINTER QNAME;                                 06524000
                    INTEGER ERRBASE;                                    06526000
                    BYTE POINTER LEAFNAME,DELIM;             <<30NOV77>>06528000
                    INTEGER POINTER GENERIC,LENGTH;          <<06DEC77>>06530000
                    OPTION VARIABLE;                         <<30NOV77>>06532000
BEGIN <<PROCEDURE GETGENNAME>>                      <<ADDED>><<13NOV77>>06534000
  COMMENT:                                                              06536000
    SCAN "QNAME" FOR DIRECTORY NAME, VIZ:  UP TO 8 ALPHA-    <<20NOV77>>06538000
    NUMERIC CHARACTERS STARTING WITH ALPHABETIC, DELIMITED BY           06540000
    SPECIAL (ULTIMATELY A 'CR').  IF ERROR IS DETECTED,                 06542000
    OFFSET IS ADDED TO "ERRBASE" TO DETERMINE ERROR CODE.               06544000
    ROUTINE MOVES DIRECTORY NAME INTO "LEAFNAME" AND, IN                06546000
    "DELIM", RETURNS A POINTER TO DELIMITER.  "GENERIC" IS              06548000
    NONZERO IF DIRECTORY NAME CONTAINED "@", "?" OR "#".                06550000
                                                             <<20NOV77>>06552000
    NOTE THAT "@@" AND "@?" ARE AMBIGUOUS.  THESE ARE AUTO-  <<20NOV77>>06554000
    MATICALLY CORRECTED TO "@" AND "?@".  (ON THE OTHER HAND,<<30NOV77>>06556000
    "@#" IS MEANINGFUL AND IS NOT EQUIVALENT TO "#@".)       <<30NOV77>>06558000
                                                                        06560000
    IF "LENGTH" IS SPECIFIED, EMPTY NAME IS ACCEPTED AND     <<30NOV77>>06562000
    LENGTH OF NAME IS RETURNED.  IF "GENERIC" IS NOT         <<30NOV77>>06564000
    SPECIFIED, A GENERIC CHARACTER CAUSES AN ERROR TRAP.     <<30NOV77>>06566000
                                                             <<30NOV77>>06568000
    NOTE THAT WE ASSUME THAT TRAPS ARE OFF ON ENTRY.  ALSO   <<30NOV77>>06570000
    NOTE THAT NAME IS UPSHIFTED IN "QNAME" ITSELF.  CALLER   <<30NOV77>>06572000
    SHOULD BLANK-FILL "LEAFNAME" BEFORE CALL;                <<30NOV77>>06574000
                                                             <<30NOV77>>06576000
  DEFINE SKIPWILDCARD=                                       <<20NOV77>>06578000
           BEGIN                                             <<20NOV77>>06580000
             BPS1:=BPS0;               <<MOVE "?" OR "@">>   <<20NOV77>>06582000
             ASSEMBLE(INCB,INCA);      <<AND SKIP IT    >>   <<20NOV77>>06584000
             GENERIC:=GENERIC+1;                             <<20NOV77>>06586000
           END #,                                            <<20NOV77>>06588000
         SKIPALL'AT=                                         <<20NOV77>>06590000
           BEGIN                                             <<20NOV77>>06592000
             BPS1:="@";                <<MOVE "@" AND   >>   <<20NOV77>>06594000
             GENERIC:=GENERIC+1;       <<SKIP SUBSEQUENT>>   <<30NOV77>>06596000
             IGNOREALL'AT;                                   <<21NOV77>>06598000
           END #,                                            <<21NOV77>>06600000
         IGNOREALL'AT=                                       <<21NOV77>>06602000
           BEGIN                                             <<21NOV77>>06604000
             ASSEMBLE(INCB,INCA);                            <<21NOV77>>06606000
             SCAN * WHILE CR'AT,1;                           <<21NOV77>>06608000
           END #;                                            <<21NOV77>>06610000
                                                             <<30NOV77>>06612000
  DEFINE NOGENERIC= NOT PARMMASK.(14:1) #,                   <<30NOV77>>06614000
         NOLENGTH=  NOT PARMMASK #;                          <<30NOV77>>06616000
                                                                        06618000
  DEFINE QFIRSTNUMERIC= ERRBASE+FIRSTNUMERIC #,                         06620000
         QMISSINGNAME=  ERRBASE+MISSINGNAME #,                          06622000
         QNAMETOOLONG=  ERRBASE+NAMETOOLONG #,                          06624000
         QMISSINGDELIM= ERRBASE+MISSINGDELIM #,              <<30NOV77>>06626000
         QNOGENNAME=    ERRBASE+NOGENNAME #;                 <<30NOV77>>06628000
                                                                        06630000
  EQUATE FIRSTNUMERIC= 0,                                               06632000
         MISSINGNAME=  FIRSTNUMERIC+1,                                  06634000
         NAMETOOLONG=  MISSINGNAME+1,                                   06636000
         MISSINGDELIM= NAMETOOLONG+1,                        <<30NOV77>>06638000
         NOGENNAME=    MISSINGDELIM+1;                       <<30NOV77>>06640000
                                                                        06642000
  EQUATE CR=%15,                                                        06644000
         CRBLANK= [8/CR,8/" "],                                         06646000
         CR'AT=   [8/CR,8/"@"];                              <<20NOV77>>06648000
                                                                        06650000
  BYTE POINTER BPS0=S-0,                                                06652000
               BPS1=S-1;                                     <<30NOV77>>06654000
  INTEGER DUMGEN,                                            <<06DEC77>>06656000
          DUMLEN;                                            <<06DEC77>>06658000
  LOGICAL PARMMASK=Q-4;                                      <<30NOV77>>06660000
                                                                        06662000
                                                                        06664000
  IF NOGENERIC THEN @GENERIC:=@DUMGEN;                       <<06DEC77>>06666000
  IF NOLENGTH THEN @LENGTH:=@DUMLEN;                         <<06DEC77>>06668000
  SCAN QNAME WHILE CRBLANK,1;          <<SKIP LEAD BLANKS>>             06670000
  @QNAME:=TOS;                                                          06672000
  IF > THEN ERROR(QFIRSTNUMERIC);                            <<04DEC77>>06674000
  IF QNAME="#" THEN ERROR(IF NOGENERIC THEN QNOGENNAME       <<04DEC77>>06676000
                          ELSE QFIRSTNUMERIC);               <<04DEC77>>06678000
                                                                        06680000
  GENERIC:=0;                                                <<06DEC77>>06682000
  TOS:=TOS:=@QNAME;                    <<SCAN GENERIC NAME>>            06684000
  DO BEGIN                                                              06686000
    MOVE * := * WHILE ANS,0;                                 <<20NOV77>>06688000
    WHILE BPS0="?" OR BPS0="#" DO SKIPWILDCARD;              <<20NOV77>>06690000
    IF BPS0="@" THEN                                         <<20NOV77>>06692000
    BEGIN                                                    <<20NOV77>>06694000
      SKIPALL'AT;                      <<"@...@" ==> "@">>   <<22NOV77>>06696000
      WHILE BPS0="?" DO                <<"@?...?" ==> >>     <<22NOV77>>06698000
      BEGIN                            <<"?...?@"     >>     <<22NOV77>>06700000
        BPS1(-1):="?";                                       <<20NOV77>>06702000
        BPS1:="@";                                           <<20NOV77>>06704000
        IGNOREALL'AT;                  <<"@...@" ==> "@">>   <<22NOV77>>06706000
      END;                                                   <<20NOV77>>06708000
    END;                                                     <<20NOV77>>06710000
  END UNTIL BPS0=SPECIAL AND BPS0<>"#";                      <<20NOV77>>06712000
  @DELIM:=TOS;                                               <<30NOV77>>06714000
  LENGTH:=TOS-@QNAME;                                                   06716000
                                                                        06718000
  IF = AND NOLENGTH THEN ERROR(QMISSINGNAME);                <<30NOV77>>06720000
  IF GENERIC>0 AND NOGENERIC THEN ERROR(QNOGENNAME);         <<30NOV77>>06722000
  IF LENGTH>8 THEN ERROR(QNAMETOOLONG);                                 06724000
  MOVE LEAFNAME:=QNAME,(LENGTH);                                        06726000
  SCAN DELIM WHILE CRBLANK,1;          <<SKIP TRAIL BLANKS>> <<30NOV77>>06728000
  @DELIM:=TOS;                                               <<20NOV77>>06730000
  IF >= THEN ERROR(QMISSINGDELIM);     <<ALPHANUMERIC>>      <<20NOV77>>06732000
END  <<PROCEDURE GETGENNAME>>;                               <<20NOV77>>06734000
$PAGE   "          PROCEDURE GETJITINFO"                     <<01DEC77>>06736000
$CONTROL   SEGMENT=FMT2                                                 06738000
                                                                        06740000
                                                                        06742000
PROCEDURE GETJITINFO(STARTINX,DEFLEVEL,PARMS);                          06744000
                    VALUE STARTINX,DEFLEVEL;                            06746000
                    INTEGER STARTINX,DEFLEVEL;                          06748000
                    ARRAY PARMS;                                        06750000
                    OPTION PRIVILEGED;                                  06752000
BEGIN <<PROCEDURE GETJITINFO>>                      <<ADDED>><<01DEC77>>06754000
  EQUATE                                                       <<07073>>06756000
     JITLAN = 16, ! Jit home account name offset.              <<07073>>06758000
     JITLGN = 24, ! Jit logon group name offset.               <<07073>>06760000
     JITAIP = 32; ! Jit account index pointer offset.          <<07073>>06762000
                                                               <<07073>>06764000
  DOUBLE QJITIPS;                                                       06766000
  DOUBLE ARRAY DPARMS(*)=PARMS;                                         06768000
  INTEGER QJITAIP= QJITIPS,                                             06770000
          QJITGIP= QJITIPS+1;                                <<06DEC77>>06772000
  INTEGER PCBGLOBLOC;                                          <<07073>>06774000
  INTEGER ARRAY QARRAY(*)=Q-0;                                 <<07073>>06776000
  SWITCH DEFAULT:= NODEFAULT, ADEFAULT, GDEFAULT;                       06778000
  SUBR'MFDS4;                                                <<03DEC77>>06780000
                                                                        06782000
                                                                        06784000
  PXGLOBAL;  ! Set PCBGLOBLOC to be Q-rel offset to PXGLOBAL.  <<07073>>06786000
                                                                        06788000
  MFDS4(QJITIPS,PXG'JITDST,JITAIP,2);                          <<07073>>06790000
  CASE *STARTINX OF                                                     06792000
  BEGIN                                                                 06794000
    <<0>> D'INX:=0D;                                                    06796000
    <<1>> MFDS4(D'INX,PXG'JITDST,QJITAIP,2);                   <<07073>>06798000
    <<2>> BEGIN                                                         06800000
            MFDS4(D'INX,PXG'JITDST,QJITGIP.(8:8)+              <<07073>>06802000
                                   2*QJITGIP.(1:1),2);         <<07073>>06804000
            D'INX1.(0:1):=QJITGIP.(0:1);                                06806000
          END;                                                          06808000
  END;                                                                  06810000
  GOTO *DEFAULT(DEFLEVEL);                                              06812000
                                                                        06814000
GDEFAULT:                                                               06816000
  MFDS4(G'GNAME,PXG'JITDST,JITLGN,4);                          <<07073>>06818000
                                                                        06820000
ADEFAULT:                                                               06822000
  MFDS4(G'ANAME,PXG'JITDST,JITLAN,4);                          <<07073>>06824000
                                                                        06826000
NODEFAULT:                                                              06828000
                                                                        06830000
END  <<PROCEDURE GETJITINFO>>;                                          06832000
$PAGE "          PROCEDURE PRODUCEPARMS"                     <<13NOV77>>06834000
$CONTROL  SEGMENT=CMD                                                   06836000
                                                                        06838000
                                                                        06840000
PROCEDURE PRODUCEPARMS(LEAFLEVEL,QNAME,PARMS,DELIM);                    06842000
                      VALUE LEAFLEVEL,QNAME;                            06844000
                      INTEGER LEAFLEVEL;                                06846000
                      BYTE POINTER QNAME;                               06848000
                      ARRAY PARMS;                                      06850000
                      BYTE POINTER DELIM;                               06852000
BEGIN <<PROCEDURE PRODUCEPARMS>>                    <<ADDED>><<13NOV77>>06854000
  COMMENT:                                                              06856000
    PARSES FULLY-QUALIFIED "LEAFLEVEL" NAME IN "QNAME" AND              06858000
    SETS UP DIRECSCAN PARAMETERS IN "PARMS".  RETURNS FINAL             06860000
    DELIMITER IN "DELIM".  NAMES IN "QNAME" MAY CONTAIN BLANK           06862000
    BLANKS AROUND DELIMITERS.  LOCKWORD FOLLOWING FILE NAME             06864000
    IS DISALLOWED.  CALLER MUST ENSURE THAT FIRST NAME IS               06866000
    PRESENT -- ELSE, "MISSING NAME" ERROR WILL RESULT.                  06868000
                                                                        06870000
    LEAFLEVEL = 0: FILES (F[.G[.A]])                                    06872000
                1: GROUPS (G[.A])                                       06874000
                2: ACCOUNTS (A)                                         06876000
                3: USERS (U[.A])                                        06878000
                4: VOLUME SETS (V[.G[.A]])                              06880000
                                                                        06882000
    STARTLEVEL = 0: GLOBAL SEARCH FOR F.G.A, V.G.A, U[.A], A            06884000
                 1: USE ACCT INX PTR FOR F.G, V[.G]                     06886000
                 2: USE GROUP INX PTR FOR F                             06888000
                                                                        06890000
    ENDLEVEL = 0: F[.G[.A]], @[.G[.A]]                                  06892000
               1: G[.A], @[.A]                                          06894000
               2: @.@.@, A                                              06896000
               3: U[.A], @[.A]                                          06898000
               4: V[.G[.A]], @[.G[.A]]                                  06900000
                                                             <<01DEC77>>06902000
    RESULT IS RETURNED IN "PARMS" IN THE FORM:               <<01DEC77>>06904000
                                                             <<01DEC77>>06906000
      *****************                                      <<01DEC77>>06908000
      * D'INX   (2WD) * 0                                    <<01DEC77>>06910000
      *---------------*                                      <<01DEC77>>06912000
      * D'TYPE  (1WD) * 2                                    <<01DEC77>>06914000
      *---------------*                                      <<01DEC77>>06916000
      * D'FNAME (4WD) * 3      "D'XXX" CONTAIN THE NAMES USED<<01DEC77>>06918000
      * D'VNAME       *        FOR THE DIRECTORY SEARCH.  THE<<01DEC77>>06920000
      *---------------*        NAMES MUST BE IN ONE OF THE   <<01DEC77>>06922000
      * D'GNAME (4WD) * 7      FOLLOWING FORMS:              <<01DEC77>>06924000
      * D'UNAME       *          F.G.A     @.@.A             <<01DEC77>>06926000
      *---------------*          @.G.A     @.@.@             <<01DEC77>>06928000
      * D'ANAME (4WD) * 11                                   <<01DEC77>>06930000
      *               *                                      <<01DEC77>>06932000
      *---------------*                                      <<01DEC77>>06934000
      * G'FNAME (4WD) * 15     "G'XXX" CONTAIN THE GENERIC   <<01DEC77>>06936000
      * G'VNAME       *        NAMES ACTUALLY SPECIFIED.     <<01DEC77>>06938000
      *---------------*        THESE ARE USED BY THE "RECIP" <<01DEC77>>06940000
      * G'GNAME (4WD) * 19     PROCEDURE TO DETERMINE A MATCH<<01DEC77>>06942000
      * G'UNAME       *        DURING THE DIRECTORY SEARCH.  <<01DEC77>>06944000
      *---------------*                                      <<01DEC77>>06946000
      * G'ANAME (4WD) * 23                                   <<01DEC77>>06948000
      *               *                                      <<01DEC77>>06950000
      *****************                                      <<01DEC77>>06952000
    ;                                                        <<01DEC77>>06954000
  DEFINE TURNOFFTRAPS=                                                  06956000
           BEGIN                                                        06958000
             PUSH(STATUS);                                              06960000
             TOS.(2:1):=0;                                              06962000
             SET(STATUS);                                               06964000
           END #;                                                       06966000
                                                                        06968000
  EQUATE NOINX= 0,                                                      06970000
         ACCTINX= 1,                                                    06972000
         GROUPINX= 2;                                                   06974000
                                                                        06976000
  INTEGER ARRAY INITPARMS(*)=PB:=3(0),3("@       "),12("  ");           06978000
  INTEGER ARRAY INITSTART(*)=PB:=                                       06980000
    GROUPINX,ACCTINX,NOINX,NOINX,ACCTINX;                               06982000
  INTEGER ARRAY INITDEF(*)=PB:=                                         06984000
    GROUPINX,ACCTINX,NOINX,ACCTINX,GROUPINX;                            06986000
  INTEGER ARRAY INITBASE(*)=PB:=                                        06988000
    FNAMEBASE,GNAMEBASE,ANAMEBASE,UNAMEBASE,VNAMEBASE;                  06990000
                                                                        06992000
  DOUBLE ARRAY DPARMS(*)=PARMS;                                         06994000
  INTEGER STARTINX,                                          <<30NOV77>>06996000
          DEFLEVEL,                                          <<30NOV77>>06998000
          ERRBASE,                                                      07000000
          GENERIC,                                                      07002000
          ALLLEVEL:=0;                                                  07004000
  SWITCH PARSER:=FILES,GROUPS,ACCOUNTS,USERS,VSDS;                      07006000
                                                                        07008000
                                                                        07010000
  TURNOFFTRAPS;                        <<FOR BYTE ADR ARITH>>           07012000
  MOVE PARMS:=INITPARMS,(27);          <<F.G.A="@.@.@">>                07014000
  STARTINX:=INITSTART(LEAFLEVEL);                                       07016000
  DEFLEVEL:=INITDEF(LEAFLEVEL);                              <<30NOV77>>07018000
  ERRBASE:=INITBASE(LEAFLEVEL);                                         07020000
  GOTO *PARSER(LEAFLEVEL);                                              07022000
                                                                        07024000
  <<**********************>>                                            07026000
  << PARSE QUALIFIED NAME >>                                            07028000
  <<**********************>>                                            07030000
                                                                        07032000
FILES:                                                                  07034000
VSDS:                                                                   07036000
  GETGENNAME(QNAME,ERRBASE,G'FNAME,QNAME,GENERIC);           <<01DEC77>>07038000
  IF GENERIC>0 THEN ALLLEVEL:=1;                                        07040000
  IF QNAME="/" THEN ERROR(NOLOCKWORD);                                  07042000
  IF QNAME<>"." THEN GO COMPLETEPARMS;                                  07044000
  @QNAME:=@QNAME+1;                                                     07046000
  ERRBASE:=GNAMEBASE;                                                   07048000
  STARTINX:=DEFLEVEL:=ACCTINX;                               <<30NOV77>>07050000
                                                                        07052000
GROUPS:                                                                 07054000
USERS:                                                                  07056000
  GETGENNAME(QNAME,ERRBASE,G'GNAME,QNAME,GENERIC);           <<01DEC77>>07058000
  IF GENERIC>0 THEN ALLLEVEL:=2;                                        07060000
  IF QNAME<>"." THEN GO COMPLETEPARMS;                                  07062000
  @QNAME:=@QNAME+1;                                                     07064000
  ERRBASE:=ANAMEBASE;                                                   07066000
  STARTINX:=DEFLEVEL:=NOINX;                                            07068000
                                                                        07070000
ACCOUNTS:                                                               07072000
  GETGENNAME(QNAME,ERRBASE,G'ANAME,QNAME,GENERIC);           <<01DEC77>>07074000
  IF GENERIC>0 THEN ALLLEVEL:=3;                                        07076000
                                                                        07078000
COMPLETEPARMS:                                                          07080000
  @DELIM:=@QNAME;                                                       07082000
  D'TYPE.(STARTLEVELF):=STARTINX;                            <<19DEC77>>07084000
  D'TYPE.(TOLEVELF):=LEAFLEVEL;                                         07086000
                                                                        07088000
  <<***************************>>                                       07090000
  << SET UP STARTLEVEL, INDEX, >>                                       07092000
  << DEFAULT GROUP/ACCT NAMES  >>                                       07094000
  <<***************************>>                                       07096000
                                                                        07098000
  IF STARTINX<>NOINX OR DEFLEVEL<>NOINX THEN                 <<19DEC77>>07100000
  BEGIN                                                                 07102000
    GETJITINFO(STARTINX,DEFLEVEL,PARMS);                     <<01DEC77>>07104000
  END;                                                                  07106000
                                                                        07108000
  <<*****************>>                                                 07110000
  << SET UP ENDLEVEL >>                                                 07112000
  <<*****************>>                                                 07114000
                                                                        07116000
  CASE *ALLLEVEL OF BEGIN              <<SET ENDLEVELFX>>               07118000
    <<0>> BEGIN                                                         07120000
            MOVE D'FNAME:=G'FNAME,(12);                                 07122000
            D'TYPE.(ENDLEVELFX):=LEAFLEVEL;                             07124000
          END;                                                          07126000
    <<1>> BEGIN                                                         07128000
            MOVE D'GNAME:=G'GNAME,(8);                                  07130000
            D'TYPE.(ENDLEVELFX):=ALLXXX+LEAFLEVEL;                      07132000
          END;                                                          07134000
    <<2>> BEGIN                                                         07136000
            MOVE D'ANAME:=G'ANAME,(4);                                  07138000
            D'TYPE.(ENDLEVELFX):=                                       07140000
              IF LEAFLEVEL=USERLEVEL THEN ALLUSERS                      07142000
              ELSE ALLGROUPS;                                           07144000
          END;                                                          07146000
    <<3>> D'TYPE.(ENDLEVELFX):=ALLACCTS;                                07148000
  END;                                                                  07150000
END  <<PROCEDURE PRODUCEPARMS>>;                                        07152000
$PAGE   "          PROCEDURE PARSEMOUNT"                     <<01DEC77>>07154000
$CONTROL   SEGMENT=CMD                                                  07156000
                                                                        07158000
                                                                        07160000
PROCEDURE PARSEMOUNT(PARMS,CMD);                                        07162000
                  VALUE CMD;                                            07164000
                  INTEGER ARRAY PARMS;                                  07166000
                  BYTE POINTER CMD;                                     07168000
BEGIN <<PROCEDURE PARSEMOUNT>>                      <<ADDED>><<01DEC77>>07170000
  COMMENT                                                               07172000
    PARSES >MOUNT COMMAND WITH THE FOLLOWING FORM (WHERE ":"            07174000
    REPRESENTS SEMICOLON AND "<...>" DENOTES REQUIRED                   07176000
    PARAMETER):                                                         07178000
                                                                        07180000
      MOUNT [<*    >[.GNAME[.ANAME]]] [:GEN=[GENINX]]                   07182000
             <VNAME>                                                    07184000
                                                                        07186000
    BLANKS ARE PERMITTED AROUND SEPARATORS.  IF NO "VNAME"              07188000
    IS SPECIFIED, THE DEFAULT IS "*" (HOME VOLUME SET).                 07190000
    IF NO "GENINX" IS SPECIFIED, THE DEFAULT IS "65535"                 07192000
    (ANY GENERATION).  NOTE THAT "VNAME", "GNAME" AND                   07194000
    "ANAME" MUST BE ACTUAL (IE., NON-GENERIC) NAMES.  NOTE              07196000
    ALSO THAT THIS FORM DIFFERS SLIGHTLY FROM THE :MOUNT                07198000
    COMMAND (IE., MORE FLEXIBLE).                                       07200000
                                                                        07202000
    THE CALLER SHOULD CHECK FOR "SM" OR "UV" CAPABILITY                 07204000
    PRIOR TO CALL.                                           <<04DEC77>>07206000
                                                                        07208000
    RESULT IS RETURNED IN "PARMS" IN THE FORM:                          07210000
                                                                        07212000
      *******************                                    <<03DEC77>>07214000
      * VS'GENINX (1WD) * 0                                  <<03DEC77>>07216000
      *-----------------*                                    <<03DEC77>>07218000
      * VS'NAME   (4WD) * 1                                  <<03DEC77>>07220000
      *                 *                                    <<03DEC77>>07222000
      *-----------------*                                    <<03DEC77>>07224000
      * VS'GNAME  (4WD) * 5                                  <<03DEC77>>07226000
      *                 *                                    <<03DEC77>>07228000
      *-----------------*                                    <<03DEC77>>07230000
      * VS'ANAME  (4WD) * 9                                  <<03DEC77>>07232000
      *                 *                                    <<03DEC77>>07234000
      *******************                                    <<03DEC77>>07236000
    ;                                                                   07238000
                                                                        07240000
  DEFINE TURNOFFTRAPS=                 <<FOR BYTE ADR ARITH>>           07242000
           BEGIN                                                        07244000
             PUSH(STATUS);                                              07246000
             TOS.(2:1):=0;                                              07248000
             SET(STATUS);                                               07250000
           END #;                                                       07252000
  DEFINE SM= LOCAP.(0:1) #,                                             07254000
         AM= LOCAP.(1:1) #;                                             07256000
  EQUATE CR= %15,                                                       07258000
         CRBLANK= [8/CR,8/" "],                                         07260000
         VOLLEVEL= 0,                                                   07262000
         GROUPLEVEL= 1,                                                 07264000
         ACCTLEVEL= 2,                                                  07266000
         NOLEVEL= 3;                                                    07268000
  BYTE ARRAY BPARMS(*)=PARMS;                                           07270000
  BYTE POINTER QNAME,                                                   07272000
               STR=QNAME;                                               07274000
  DOUBLE DGENINX;                                                       07276000
  INTEGER QGENINX1=DGENINX,                                             07278000
          QGENINX2=DGENINX+1,                                           07280000
          LENGTH,                                                       07282000
          DEFLEVEL;                                                     07284000
                                                                        07286000
  SWITCH DEFAULT:=VDEFAULT,GDEFAULT,ADEFAULT,NODEFAULT;                 07288000
  INTRINSIC DBINARY;                                                    07290000
                                                                        07292000
                                                                        07294000
  <<***************************>>                                       07296000
  << PARSE QUALIFIED VSET NAME >>                                       07298000
  <<***************************>>                                       07300000
                                                                        07302000
  TURNOFFTRAPS;                                                         07304000
  MOVE PARMS:=(0,12("  "));                                  <<08FEB78>>07306000
                                                                        07308000
  IF NOT FINDTOKEN(CMD,QNAME,72,,1) THEN DEFLEVEL:=VOLLEVEL             07310000
  ELSE BEGIN                                                            07312000
    GETGENNAME(QNAME,VNAMEBASE,VS'NAME,QNAME,,LENGTH);       <<03DEC77>>07314000
    IF LENGTH=0 THEN                                                    07316000
    BEGIN                                                               07318000
      IF QNAME<>"*" THEN ERROR(VMISSINGNAME);                           07320000
      MOVE VS'NAME:="*       ";                              <<03DEC77>>07322000
      SCAN QNAME(1) WHILE CRBLANK,1;                                    07324000
      @QNAME:=TOS;                                                      07326000
      IF >= THEN ERROR(VMISSINGDELIM);                                  07328000
    END;                                                                07330000
    IF QNAME="/" THEN ERROR(NOLOCKWORD);                                07332000
                                                                        07334000
    IF QNAME<>"." THEN DEFLEVEL:=GROUPLEVEL                             07336000
    ELSE BEGIN                                                          07338000
      GETGENNAME(QNAME(1),GNAMEBASE,VS'GNAME,QNAME);         <<03DEC77>>07340000
      IF QNAME<>"." THEN DEFLEVEL:=ACCTLEVEL                            07342000
      ELSE BEGIN                                                        07344000
        GETGENNAME(QNAME(1),ANAMEBASE,VS'ANAME,QNAME);       <<03DEC77>>07346000
        DEFLEVEL:=NOLEVEL;                                              07348000
      END;                                                              07350000
    END;                                                                07352000
    IF QNAME<>CR THEN ERROR(BADDESIG);                                  07354000
  END;                                                                  07356000
                                                                        07358000
  GOTO *DEFAULT(DEFLEVEL);                                              07360000
                                                                        07362000
VDEFAULT:                                                               07364000
  MOVE VS'NAME:="*       ";                                  <<03DEC77>>07366000
GDEFAULT:                                                               07368000
  MOVE VS'BGNAME:=LOGRP,(8);                                 <<03DEC77>>07370000
                                                                        07372000
ADEFAULT:                                                               07374000
  MOVE VS'BANAME:=LOACCT,(8);                                <<03DEC77>>07376000
                                                                        07378000
NODEFAULT:                                                              07380000
                                                                        07382000
  <<*************************>>                                         07384000
  <<  PARSE "GEN=" PARAMETER >>                                         07386000
  <<*************************>>                                         07388000
                                                                        07390000
  IF EOL THEN VS'GENINX:=65535                               <<03DEC77>>07392000
  ELSE BEGIN                                                            07394000
    IF NOT FINDTOKEN(CMD,STR,72,"=")                                    07396000
       THEN ERROR(MISSINGPARAM);                                        07398000
    IF EOL OR STR<>("GEN",CR) THEN ERROR(BADPARAM);                     07400000
    IF NOT FINDTOKEN(CMD,STR,72) THEN VS'GENINX:=65535       <<03DEC77>>07402000
    ELSE BEGIN                                                          07404000
      SCAN STR UNTIL CR,1;                                              07406000
      LENGTH:=TOS-@STR;                                                 07408000
      DGENINX:=DBINARY(STR,LENGTH);                                     07410000
      IF <> OR QGENINX1<>0 THEN ERROR(BADGENINX);                       07412000
      VS'GENINX:=QGENINX2;                                   <<03DEC77>>07414000
    END;                                                                07416000
    IF NOT EOL THEN ERROR(BADPARAM);                                    07418000
  END;                                                                  07420000
END  <<PROCEDURE PARSEMOUNT>>;                                          07422000
$PAGE "          PROCEDURE GETNAME"                          <<14NOV77>>07424000
$CONTROL   SEGMENT=CMD                                       <<13NOV77>>07426000
                                                             <<13NOV77>>07428000
                                                             <<13NOV77>>07430000
LOGICAL PROCEDURE GETNAME(QNAME,STR,EON,ERR,DELIM);                     07432000
                         VALUE STR,ERR,DELIM;                           07434000
                         BYTE POINTER QNAME,STR;                        07436000
                         INTEGER EON,ERR,DELIM;                         07438000
                         OPTION VARIABLE;                               07440000
BEGIN                                                                   07442000
  COMMENT:                                                              07444000
  << SCANS QUALIFIED NAME (SEE 'GETCMDS' FOR SYNTAX) FOR NEXT           07446000
  << NAME OR "@" (DELIMITED BY PERIOD OR EON).  SOME CHECKS             07448000
  << ARE MADE HERE:  THE "@" MUST BE IMMEDIATELY FOLLOWED BY            07450000
  << A PERIOD, OR THE FIRST CHAR OF THE NAME MUST BE ALPHABETIC         07452000
  << AND THE NAME MUST BE NO LONGER THAN EIGHT CHARACTERS.              07454000
  << 'GETNAME' IS FALSE WHEN A "@" IS RETURNED OR A NONFATAL            07456000
  << ERROR IS DETECTED. STATUS RETURNED IS:                  <<02DEC77>>07458000
  <<  CCE--NO ERROR.                                         <<02DEC77>>07460000
  <<  CCG--NONFATAL ERROR. RETURNED ONLY WHEN CALLER         <<02DEC77>>07462000
  <<       HAS SET SIGN BIT IN "ERR".(NORMALLY, ERROR CAUSES <<02DEC77>>07464000
  <<       A RETURN TO COMMAND INTERPRETER);                 <<02DEC77>>07466000
                                                                        07468000
                                                                        07470000
  EQUATE CR=%15,                                                        07472000
         HICR=[8/CR,8/0];                                    <<02DEC77>>07474000
  BYTE POINTER TERM;                        <<PTR TO EON OR PERIOD>>    07476000
  INTEGER S0=S-0,                                                       07478000
          QSTATUS=Q-1,                                                  07480000
          RESULT=GETNAME;                                               07482000
  LOGICAL PARMMASK=Q-4;                                      <<13NOV77>>07484000
                                                                        07486000
      DEFINE SETCCE=QSTATUS.(6:2):=2#,                                  07488000
             SETCCG=QSTATUS.(6:2):=0#;                                  07490000
                                                                        07492000
                                                                        07494000
      SUBROUTINE QERROR;                                                07496000
      BEGIN                                                             07498000
      ERROR(ERR);<<RETURN IF SIGN BIT IS SET>>                          07500000
      SETCCG;                                                           07502000
      ASSEMBLE(EXIT 6);                                                 07504000
      END;                                                              07506000
          <<-------------------->>                                      07508000
                                                                        07510000
    IF NOT PARMMASK THEN DELIM:=".";                         <<02DEC77>>07512000
    SCAN QNAME UNTIL HICR+DELIM,1;                           <<02DEC77>>07514000
    TOS:=S0-@QNAME;                                                     07516000
    IF = OR TOS>8 THEN QERROR;                                          07518000
    @TERM:=TOS;                                                         07520000
    MOVE STR:=QNAME WHILE AN,0;                                         07522000
    <<DELB;>>                                                           07524000
    IF TOS<>@TERM THEN                                                  07526000
      BEGIN                                                             07528000
        IF QNAME="@" AND @QNAME(1)=@TERM THEN                           07530000
          BEGIN                                                         07532000
            STR:="@";                                                   07534000
          END                                                           07536000
          ELSE QERROR;                                                  07538000
      END                                                               07540000
      ELSE BEGIN                                                        07542000
        IF STR<>ALPHA THEN QERROR;                                      07544000
        RESULT:=RESULT+1;                                               07546000
      END;                                                              07548000
    IF TERM=CR THEN EON:=EON+1;                                         07550000
    @QNAME:=@TERM(1);                       <<SKIP PERIOD>>             07552000
END  <<PROCEDURE GETNAME>>                                              07554000
;                                                                       07556000
$PAGE "    PROCEDURE  GETFNAME    "                                     07558000
$CONTROL SEGMENT=CMD                                                    07560000
                                                                        07562000
      PROCEDURE GETFNAME(QNAME,NONFATAL);                               07564000
      VALUE QNAME,NONFATAL;                                             07566000
      BYTE POINTER QNAME;                                               07568000
      LOGICAL NONFATAL;                                                 07570000
                                                                        07572000
      BEGIN                                                             07574000
      DEFINE FLAGGED18=18 CAT NONFATAL(0:15:1)#;                        07576000
      EQUATE CRSLASH=[8/%15,8/"/"];                                     07578000
      BYTE POINTER BPS0=S-0;                                            07580000
      INTEGER X=X;                                                      07582000
      LOGICAL EON:=FALSE;                                               07584000
                                                                        07586000
      SUBROUTINE QERROR(ERR);                                           07588000
      VALUE ERR;                                                        07590000
      INTEGER ERR;                                                      07592000
      BEGIN                                                             07594000
      IF ERR > 0 THEN ERROR(ERR CAT NONFATAL(0:15:1));                  07596000
      ASSEMBLE(EXIT 2);                                                 07598000
      END;                                                              07600000
                                                                        07602000
                                                                        07604000
COMMENT:                                                                07606000
                                                                        07608000
      << SYNTAX CHECK FILENAME. MUST BE FORM:                           07610000
      <<   [* : $ ] NAME [/NAME][.NAME[.NAME]];                         07612000
                                                                        07614000
      TOS:=@QNAME;                                                      07616000
      IF BPS0="*" OR BPS0="$" THEN                                      07618000
      TOS:=TOS+1;                                                       07620000
      SCAN BPS0 UNTIL CRSLASH;                                          07622000
      IF NOCARRY AND NOT GETNAME(BPS0,BPS0,EON,FLAGGED18,"/")           07624000
      THEN QERROR(IF > THEN -1 ELSE 18);                                07626000
      X:=3;                                                             07628000
      DO                                                                07630000
      BEGIN                                                             07632000
      IF NOT GETNAME(BPS0,BPS0,EON,FLAGGED18)                           07634000
      THEN QERROR(IF > THEN -1 ELSE 18);                                07636000
      END                                                               07638000
      UNTIL DXBZ OR EON;                                                07640000
                                                                        07642000
      IF NOT EON THEN QERROR(18);                                       07644000
      LASTOUT:=FOPEN(QNAME,%2507,%101);                                 07646000
      IF <> THEN QERROR(16);                                            07648000
      FGETINFO(OUT:=LASTOUT,,,,,DEVTYP);                                07650000
      TOS:=0;                                                           07652000
      IF DEVTYP.(8:8)=LPDEV THEN TOS:=TOS+1;                            07654000
      LP:=LASTLP:=TOS;                                                  07656000
      END;<<PROCEDURE GETFNAME>>                                        07658000
                                                                        07660000
                                                                        07662000
$PAGE "          PROCEDURE GETQNAME"                                    07664000
$CONTROL   SEGMENT=CMD                                                  07666000
                                                                        07668000
                                                                        07670000
PROCEDURE GETQNAME(PARMS,CMD,CMDTYP);                                   07672000
                  VALUE CMDTYP;                                         07674000
                  ARRAY PARMS;                                          07676000
                  BYTE POINTER CMD;                                     07678000
                  INTEGER CMDTYP;                                       07680000
BEGIN <<PROCEDURE GETQNAME>>                     <<REPLACED>><<13NOV77>>07682000
  COMMENT:                                                              07684000
    PARSES QUALIFIED NAME BASED ON "CMDTYP" -- SEE "GETCMDS"            07686000
    FOR SYNTAX.  ROUTINE ENSURES THAT USER IS QUALIFIED TO              07688000
    REFERENCE DESIGNATOR (VIZ, USER IS "SM" OR "AM");                   07690000
                                                                        07692000
  DEFINE NOTSM= INTEGER(LOCAP)>=0 #,                                    07694000
         AM=    LOCAP&CSL(2) #;                                         07696000
  EQUATE CR= %15;                                                       07698000
                                                                        07700000
  BYTE ARRAY BPARMS(*)=PARMS;                                           07702000
  BYTE POINTER QNAME,                                                   07704000
               STR;                                                     07706000
  DOUBLE ARRAY DPARMS(*)=PARMS;                                         07708000
  INTEGER X=X,                                                          07710000
          GEOL;                                                         07712000
  LOGICAL EON;                                                          07714000
                                                                        07716000
                                                                        07718000
  TOS:=EON:=INTEGER(FINDTOKEN(CMD,STR,72,,1))+1;                        07720000
  GEOL:=EOL;                                                            07722000
  EOL:=S0;                                                              07724000
  IF NOT TOS THEN                                                       07726000
  BEGIN                                                                 07728000
    EON:=INTEGER(FINDTOKEN(STR,QNAME,26,",",1))+1;           <<22NOV77>>07730000
  END;                                                                  07732000
                                                                        07734000
  IF NOT EON THEN                      <<NAME SPECIFIED>>    <<22NOV77>>07736000
  BEGIN                                                                 07738000
    PRODUCEPARMS(CMDTYP,QNAME,PARMS,QNAME);                             07740000
    IF QNAME<>CR THEN ERROR(BADDESIG);                                  07742000
  END                                                                   07744000
  ELSE BEGIN                           <<DEFAULT SET>>       <<22NOV77>>07746000
    IF NOT (GROUPLEVEL<=CMDTYP<=USERLEVEL) THEN ERROR(12);   <<22NOV77>>07748000
    MOVE G'BANAME:=LOACCT,(8);                                          07750000
    IF CMDTYP=USERLEVEL THEN MOVE G'BUNAME:=LOUSR,(8)        <<30NOV77>>07752000
    ELSE MOVE G'BGNAME:=LOGRP,(8);                           <<30NOV77>>07754000
    MOVE D'GNAME:=G'GNAME,(8);         <<G'GNAME=G'UNAME>>   <<30NOV77>>07756000
    D'TYPE:=0;                                                          07758000
    D'TYPE.(TOLEVELF):=CMDTYP;                                          07760000
    D'TYPE.(ENDLEVELF):=CMDTYP;                                         07762000
    D'INX:=0D;                                                          07764000
  END;                                                                  07766000
                                                                        07768000
  IF D'TYPE.(ALLFLAG) THEN                                              07770000
  BEGIN                                                                 07772000
    ALLCLASS:=1;                                                        07774000
    IF CMDTYP=0 THEN FIRSTTIME:=TRUE;                                   07776000
  END;                                                                  07778000
                                                                        07780000
  IF NOTSM THEN                                                         07782000
  BEGIN                                                                 07784000
    IF CMDTYP=0 THEN                                                    07786000
    BEGIN                                                               07788000
      X:=D'TYPE.(ENDLEVELFX);                                           07790000
      IF NOT AM THEN                                                    07792000
      BEGIN                                                             07794000
        IF ALLGROUPS<=X<=ALLACCTS THEN ERROR(13);                       07796000
      END                                                               07798000
      ELSE                                                              07800000
        IF (X=ALLACCTS OR X=ALLGROUPS) AND                              07802000
           G'BANAME<>LOACCT,(8) THEN ERROR(13);                         07804000
    END                                                                 07806000
    ELSE                                                                07808000
      IF G'BANAME<>LOACCT,(8) THEN ERROR(8)                             07810000
    ELSE                                                                07812000
      IF NOT AM THEN                                                    07814000
      BEGIN                                                             07816000
        IF CMDTYP<2 THEN                                                07818000
        BEGIN                                                           07820000
          IF G'BGNAME<>LOGRP,(8) THEN ERROR(9);                         07822000
        END                                                             07824000
        ELSE                                                            07826000
          IF > AND G'BUNAME<>LOUSR,(8) THEN ERROR(10);                  07828000
      END;                                                              07830000
  END;                                                                  07832000
                                                                        07834000
  <<*****************>>                                                 07836000
  << 'OUT' PARAMETER >>                                                 07838000
  <<*****************>>                                                 07840000
                                                                        07842000
  IF NOT EOL THEN                                                       07844000
  BEGIN                                                                 07846000
    IF NOT FINDTOKEN(STR,QNAME,27) THEN ERROR(12);                      07848000
    GETFNAME(QNAME,FALSE);                                              07850000
  END;                                                                  07852000
  EOL:=GEOL;                                                            07854000
END  <<PROCEDURE GETQNAME>>;                                            07856000
$PAGE "          PROCEDURE GETCMDS"                                     07858000
$CONTROL   SEGMENT=CMD                                                  07860000
                                                                        07862000
                                                                        07864000
PROCEDURE GETCMDS;                                                      07866000
BEGIN                                                                   07868000
  COMMENT                                                               07870000
  << THIS ROUTINE PROMPTS FOR AND READS COMMANDS FROM $STDIN.           07872000
  << ALL COMMANDS MUST START IN COL #1 -- THE COMMAND KEYWORD           07874000
  << MUST BE TERMINATED BY A BLANK OR SOME SPECIAL;                     07876000
                                                                        07878000
                                                                        07880000
  DEFINE SM= LOCAP.(0:1) #,                                  <<01DEC77>>07882000
         UV= LOCAP.(7:1) #;                                  <<01DEC77>>07884000
                                                             <<19DEC77>>07886000
  DEFINE PV'NAME=  PV'PARMS #,                               <<19DEC77>>07888000
         PV'GNAME= PV'PARMS(4) #,                            <<19DEC77>>07890000
         PV'ANAME= PV'PARMS(8) #;                            <<19DEC77>>07892000
                                                             <<19DEC77>>07894000
  DEFINE PVGROUP= LOGICAL(D'INX1.(PVF)) #;                     <<11.KM>>07896000
  EQUATE CR=%15,                                                        07898000
         MAXLEN=9,                                           <<01DEC77>>07900000
         LISTUSERCMD=3,                                      <<04DEC77>>07902000
         MOUNTCMD=4,                                         <<01DEC77>>07904000
         DISMOUNTCMD=5,                                      <<01DEC77>>07906000
         UNCOND'NOBIND=-2;                                   <<08FEB78>>07908000
  ARRAY QMEM(*)=Q+0,                                                    07910000
        PARMS(0:26),                                         <<13NOV77>>07912000
        PV'PARMS(0:11),                                      <<19DEC77>>07914000
        WCMD(0:36);                                                     07916000
  BYTE ARRAY ORGCMD(*)=WCMD;                                 <<13NOV77>>07918000
  BYTE POINTER CMD,                                                     07920000
               STR;                                                     07922000
  INTEGER X=X,                                                          07924000
          S0=S-0,                                                       07926000
          Q0=Q-0,                                                       07928000
          DUMMY;                                                        07930000
  LABEL REINIT;                                                         07932000
  LOGICAL PROMPT:="> ";                                      <<13NOV77>>07934000
  INTRINSIC DEBUG;                                           <<04DEC77>>07936000
  PROCEDURE MOUNT; OPTION EXTERNAL;                          <<02DEC77>>07938000
  PROCEDURE DISMOUNT; OPTION EXTERNAL;                       <<02DEC77>>07940000
                                                                        07942000
          <<-------------------->>                                      07944000
                                                                        07946000
    TOS:=@REINIT;                                                       07948000
    ASSEMBLE(LDI 0; DEL);                   <<SET CCE>>                 07950000
    PUSH(STATUS);                                                       07952000
    ORGADR:=TOS;                            <<FOR                 >>    07954000
    ORGTOS:=@S0;                            <<    UPSTACK         >>    07956000
    ORGQ:=@Q0;                              <<            RECOVERY>>    07958000
    XCONTRAP(@CONTROLY,DUMMY);                                          07960000
                                                                        07962000
REINIT:                                                                 07964000
    TOS:=ORGTOS;                            <<IN CASE OF ERROR>>        07966000
    SET(S);                                                             07968000
    OUT:=ORGOUT;                                                        07970000
    LP:=ORGLP;                                                          07972000
    IF LASTOUT<>0 THEN                                                  07974000
      BEGIN                                                             07976000
        FCLOSE(LASTOUT,0,0);                                            07978000
        IF <> THEN ERROR([1/1,15/15]);                                  07980000
        LASTOUT:=0;                                                     07982000
      END;                                                              07984000
    @CMD:=@ORGCMD;                                                      07986000
    EOL:=GIVEPASS:=SECONLY:=EXTMAP:=ALLCLASS:=0;                        07988000
    PVFLAG:=0;                                                 <<06137>>07990000
    DO BEGIN                                                            07992000
      PRINT(PROMPT,-1,%320);                                            07994000
      IF <> THEN QUIT(2);                                               07996000
          TOS := READX(WCMD,-72);                              <<02321>>07998000
          IF < THEN BEGIN  << CCL FOUND WITH INPUT >>          <<02321>>08000000
              ERROR(50);                                       <<02321>>08002000
              TERMINATE;                                       <<02321>>08004000
              END                                              <<02321>>08006000
          ELSE IF > THEN BEGIN << CCG FOUND WITH INPUT: EOF>>  <<02321>>08008000
              ERROR(51);                                       <<02321>>08010000
              TERMINATE;                                       <<02321>>08012000
              END                                              <<02321>>08014000
          ELSE IF WCMD.(0:8) = ":" THEN BEGIN                  <<02321>>08016000
              ERROR(49);                                       <<02321>>08018000
              GOTO REINIT;                                     <<02321>>08020000
              END;                                             <<02321>>08022000
      IF ECHO THEN                                                      08024000
        BEGIN                                                           08026000
          PRINT(WCMD,-S0,0);                                            08028000
          IF <> THEN QUIT(2);                                           08030000
        END;                                                            08032000
      X:=TOS;                                                           08034000
    END UNTIL <>;                                                       08036000
    CMD(X):=CR;                                                         08038000
    MOVE CMD:=CMD WHILE ANS,1;              <<SCAN KEYWORD>>            08040000
        COMMENT:                                                        08042000
        << SEARCH FOR APPROPRIATE COMMAND BASED ON LENGTH OF            08044000
        << KEYWORD;                                                     08046000
    IF (X:=S0-@CMD)<=MAXLEN THEN                                        08048000
      BEGIN                                                             08050000
        CASE *X OF BEGIN                                                08052000
          GOTO ERR;                                                     08054000
     BEGIN                                                     <<02321>>08056000
     IF CMD <> "E" AND CMD <> "e" THEN GO TO ERR;              <<02321>>08058000
     @CMD := TOS;                                              <<02321>>08060000
     FINDTOKEN(CMD,STR,72);  <<NO PARMS ALLOWED >>             <<02321>>08062000
      IF NOT EOL THEN ERROR(5);                                <<02321>>08064000
     IF PVINFO <> 0 THEN                                       <<02321>>08066000
         BEGIN                                                 <<02321>>08068000
         REQTYPE := UNCOND'NOBIND;                             <<02321>>08070000
         CALLPVPROC(DISMOUNT,PV'NAME,PV'GNAME,                 <<02321>>08072000
                    PV'ANAME,REQTYPE,0,PVINFO);                <<02321>>08074000
         END;                                                  <<02321>>08076000
     TERMINATE;                                                <<02321>>08078000
     END;                                                      <<02321>>08080000
          GOTO ERR;                                                     08082000
          GOTO ERR;                                                     08084000
          BEGIN                                                         08086000
            IF CMD="HELP" THEN                                          08088000
              BEGIN                                                     08090000
                HELP(*);                                                08092000
                GO REINIT;                                              08094000
              END                                                       08096000
              ELSE BEGIN                                                08098000
                IF CMD<>"EXIT" THEN GOTO ERR;                           08100000
                @CMD:=TOS;                                              08102000
                FINDTOKEN(CMD,STR,72); <<NO PARMS ALLOWED>>  <<30NOV77>>08104000
                IF NOT EOL THEN ERROR(5);                               08106000
                IF PVINFO<>0 THEN                            <<19DEC77>>08108000
                BEGIN                                        <<19DEC77>>08110000
                  REQTYPE:=UNCOND'NOBIND;                    <<08FEB78>>08112000
                  CALLPVPROC(DISMOUNT,PV'NAME,PV'GNAME,      <<19DEC77>>08114000
                             PV'ANAME,REQTYPE,0,PVINFO);     <<08FEB78>>08116000
                END;                                         <<19DEC77>>08118000
                TERMINATE;                                              08120000
              END;                                                      08122000
          END;                                                          08124000
          BEGIN                                                         08126000
            IF CMD="LISTF" THEN CMDTYP:=0                    <<02DEC77>>08128000
            ELSE IF CMD="MOUNT" THEN CMDTYP:=MOUNTCMD        <<02DEC77>>08130000
            ELSE                                             <<04DEC77>>08132000
              IF CMD="DEBUG" AND SM THEN                     <<04DEC77>>08134000
              BEGIN                                          <<04DEC77>>08136000
                DEBUG;                                       <<04DEC77>>08138000
                GOTO REINIT;                                 <<04DEC77>>08140000
              END                                            <<04DEC77>>08142000
            ELSE GOTO ERR;                                   <<04DEC77>>08144000
          END;                                                          08146000
          GOTO ERR;                                                     08148000
          BEGIN                                                         08150000
            IF CMD<>"LISTSEC" THEN GOTO ERR;                            08152000
            CMDTYP:=0;                                                  08154000
            SECONLY:=1;                                                 08156000
          END;                                                          08158000
          BEGIN                                                         08160000
            IF CMD="LISTACCT" THEN CMDTYP:=2                 <<02DEC77>>08162000
            ELSE IF CMD="LISTUSER" THEN CMDTYP:=LISTUSERCMD  <<04DEC77>>08164000
            ELSE IF CMD="DISMOUNT" THEN CMDTYP:=DISMOUNTCMD  <<02DEC77>>08166000
            ELSE GOTO ERR;                                   <<02DEC77>>08168000
          END;                                                          08170000
          BEGIN                                                         08172000
            IF CMD<>"LISTGROUP" THEN GOTO ERR;                          08174000
            CMDTYP:=1;                                                  08176000
          END;                                                          08178000
        END;                                                            08180000
      END                                                               08182000
      ELSE BEGIN                                                        08184000
ERR:                                                                    08186000
        ERROR(0);                           <<INVALID COMMAND>>         08188000
      END;                                                              08190000
    @CMD:=TOS;                              <<PTR TO TERMINATOR>>       08192000
                                                             <<01DEC77>>08194000
    <<*********************************>>                    <<01DEC77>>08196000
    << PROCESS MOUNT/DISMOUNT COMMANDS >>                    <<01DEC77>>08198000
    <<*********************************>>                    <<01DEC77>>08200000
                                                             <<01DEC77>>08202000
    IF CMDTYP=MOUNTCMD OR CMDTYP=DISMOUNTCMD THEN            <<02DEC77>>08204000
    BEGIN                                                    <<02DEC77>>08206000
      IF NOT SM AND NOT UV THEN ERROR(NONUV);                <<02DEC77>>08208000
      IF CMDTYP=MOUNTCMD THEN PARSEMOUNT(PARMS,CMD)          <<02DEC77>>08210000
      ELSE                                                   <<02DEC77>>08212000
        IF FINDTOKEN(CMD,STR,72) OR                          <<02DEC77>>08214000
           NOT EOL THEN ERROR(BADPARAM);                     <<02DEC77>>08216000
                                                             <<02DEC77>>08218000
      REQTYPE:=UNCOND'NOBIND;                                <<08FEB78>>08220000
      IF PVINFO<>0 THEN                <<DISMOUNT>>          <<02DEC77>>08222000
      BEGIN                                                  <<02DEC77>>08224000
        CALLPVPROC(DISMOUNT,PV'NAME,PV'GNAME,PV'ANAME,       <<19DEC77>>08226000
                   REQTYPE,0,PVINFO);                        <<08FEB78>>08228000
        IF CARRY THEN ERROR(PVERROR);                        <<06DEC77>>08230000
        PVINFO:=0;                                           <<02DEC77>>08232000
      END;                                                   <<02DEC77>>08234000
                                                             <<02DEC77>>08236000
      IF CMDTYP=MOUNTCMD THEN          <<MOUNT>>             <<02DEC77>>08238000
      BEGIN                                                  <<02DEC77>>08240000
        CALLPVPROC(MOUNT,VS'NAME,VS'GNAME,VS'ANAME,REQTYPE,  <<03DEC77>>08242000
                   VS'GENINX,PVINFO);                        <<03DEC77>>08244000
        IF CARRY THEN ERROR(PVERROR);                        <<06DEC77>>08246000
        MOVE PV'NAME:=VS'NAME,(12);                          <<19DEC77>>08248000
      END;                                                   <<02DEC77>>08250000
      GOTO REINIT;                                           <<02DEC77>>08252000
    END;                                                     <<02DEC77>>08254000
                                                             <<01DEC77>>08256000
    <<****************************>>                         <<01DEC77>>08258000
    << PROCESS DIRECTORY COMMANDS >>                         <<01DEC77>>08260000
    <<****************************>>                         <<01DEC77>>08262000
                                                             <<02DEC77>>08264000
    GETQNAME(PARMS,CMD,CMDTYP);                              <<02DEC77>>08266000
    CASE *CMDTYP OF                                          <<02DEC77>>08268000
    BEGIN                                                    <<02DEC77>>08270000
      <<0>> BEGIN                                            <<08FEB78>>08272000
              IF PVINFO.(MVTABXF)<>0 THEN                      <<11.KM>>08274000
                BEGIN             <<GLOBAL SEARCH OF PV DIR>>  <<11.KM>>08276000
                D'TYPE.(STARTLEVELF):=0;                       <<11.KM>>08278000
                END                                            <<11.KM>>08280000
              ELSE IF PVGROUP THEN ERROR(NOMOUNT);             <<11.KM>>08282000
              D'TYPE.(HITFLAG):=1;                             <<11.KM>>08284000
              IF SECONLY THEN D'TYPE.(STARTLEVELF):=0;         <<11.KM>>08286000
            END;                                             <<08FEB78>>08288000
      <<1>> BEGIN                                            <<02DEC77>>08290000
              D'TYPE.(HITFLAG):=1;                           <<02DEC77>>08292000
              D'TYPE.(STARTLEVELF):=0;                       <<02DEC77>>08294000
            END;                                             <<02DEC77>>08296000
      <<2>> ;                                                <<02DEC77>>08298000
      <<3>> D'TYPE.(HITFLAG):=1;                             <<02DEC77>>08300000
    END;                                                     <<02DEC77>>08302000
                                                             <<02DEC77>>08304000
        COMMENT:                                                        08306000
        << SCAN "PASS" AND/OR "MAP";                                    08308000
    WHILE NOT EOL DO                                                    08310000
      BEGIN                                                             08312000
        IF FINDTOKEN(CMD,STR,4) THEN                                    08314000
          BEGIN                                                         08316000
            IF STR=("PASS",CR) THEN                                     08318000
              BEGIN                                                     08320000
                IF GIVEPASS THEN ERROR(6);                              08322000
                GIVEPASS:=1;                                            08324000
              END                                                       08326000
              ELSE                                                      08328000
                IF CMDTYP=0 AND NOT SECONLY THEN                        08330000
                  BEGIN                                                 08332000
                    IF STR=("MAP",CR) THEN                              08334000
                      BEGIN                                             08336000
                        IF EXTMAP THEN ERROR(6);                        08338000
                        EXTMAP:=1;                                      08340000
                      END                                               08342000
                      ELSE ERROR(5);                                    08344000
                  END                                                   08346000
                  ELSE ERROR(5);                                        08348000
          END                                                           08350000
          ELSE ERROR(12);                                               08352000
      END;                                                              08354000
    NXTLN:=61;                                                          08356000
    COMMENT:                                                   <<06137>>08358000
      << IN THE CASE OF SECONLY WE SHOULD ALWAYS START OUR     <<06137>>08360000
      << SEARCH IN THE SYSTEM DIRC AND THEN MOVE OVER TO       <<06137>>08362000
      << THE PV DIRC IFF WE HAVE A MOUNTED PV AND THE INFO     <<06137>>08364000
      << WE NEED IS ON THAT PV;                                <<06137>>08366000
                                                               <<06137>>08368000
    MVTABX:=IF CMDTYP=LISTUSERCMD OR CMDTYP=0 THEN 0           <<06137>>08370000
            ELSE PVINFO.(MVTABXF);                           <<04DEC77>>08372000
    PVDONE := FALSE;                                           <<*8675>>08374000
    TOS:=CALLDIRECSCAN(FMTENTRY,PARMS,MVTABX);               <<04DEC77>>08376000
    IF CARRY AND NOT PVFLAG THEN ERROR(S1+1);                  <<06137>>08378000
                     << PVFLAG = TRUE MEANS THAT ERROR >>      <<06137>>08380000
                     << CONDITION HAS BEEN TAKEN CARE  >>      <<06137>>08382000
                     << OF IN FMTENTRY.                >>      <<*JIMB*>08384000
    IF ABORT<>0 THEN QUIT(ABORT);                                       08386000
    <<DDEL;>>                                                           08388000
    GO REINIT;                                                          08390000
END  <<PROCEDURE GETCMDS>>                                              08392000
;                                                                       08394000
$PAGE "          PROCEDURE OUTERBLOCK"                                  08396000
$CONTROL   SEGMENT=CMD                                                  08398000
                                                                        08400000
                                                                        08402000
PROCEDURE OUTERBLOCK;                                                   08404000
BEGIN                                                                   08406000
    INTEGER LENGTH;                                          <<01DEC77>>08408000
                                                             <<01DEC77>>08410000
                                                             <<01DEC77>>08412000
    SUBROUTINE WRITEMSG(ENDBUF,CCTL); VALUE ENDBUF,CCTL;     <<01DEC77>>08414000
                       BYTE POINTER ENDBUF; INTEGER CCTL;    <<01DEC77>>08416000
    BEGIN                                                    <<01DEC77>>08418000
      LENGTH:=LOGICAL(@ENDBUF)-LOGICAL(@BUF);                <<01DEC77>>08420000
      PRINT(WBUF,-LENGTH,CCTL);                              <<01DEC77>>08422000
      IF <> THEN QUIT(2);                                    <<01DEC77>>08424000
    END  <<SUBROUTINE WRITEMSG>>;                            <<01DEC77>>08426000
                                                             <<01DEC77>>08428000
                                                             <<01DEC77>>08430000
    MOVE BUF:=LDIRID,2;                <<PRINT HEADERS>>     <<01DEC77>>08432000
   MOVE BUF(VUFPOS) := OFFICIAL'VUUFF;                         <<04298>>08434000
    WRITEMSG(*,0);                                           <<01DEC77>>08436000
    GETPRIVMODE;                                               <<07241>>08438000
    IF PCB'SIZE <> MPEV'PCB'SIZE THEN                          <<07241>>08440000
       BEGIN                                                   <<07241>>08442000
       GENMSG (2,1259);                                        <<*7980>>08444000
       TERMINATE;                                              <<07241>>08446000
       END;                                                    <<07241>>08448000
    GETUSERMODE;                                               <<07241>>08450000
    MOVE BUF:="TYPE 'HELP' FOR AID",2;                       <<04DEC77>>08452000
    WRITEMSG(*,"0");                                         <<01DEC77>>08454000
    MOVE WBUF:=WBUF(-1),(40);          <<BLANK USED PORTION>><<01DEC77>>08456000
                                                             <<02DEC77>>08458000
    STDIN:=FOPEN(,%44);                <<OPEN $STDIN>>                  08460000
    IF <> THEN QUIT(4);                                                 08462000
    TOS:="OUT ";                                                        08464000
    ORGOUT:=FOPEN(BAS1,(IF USERDEV THEN %517 ELSE %2517),%101);         08466000
    DDEL;                              <<OPEN LIST FILE>>    <<01DEC77>>08468000
    IF <> THEN QUIT(1);                                                 08470000
    FGETINFO(ORGOUT,,,,,DEVTYP);                                        08472000
    IF DEVTYP.(8:8)=LPDEV THEN ORGLP:=1;                                08474000
    WHO(ECHO,DLOCAP,,LOUSR,LOGRP,LOACCT,HOMGRP,LOTERM);                 08476000
    ECHO:=NOT (ECHO&LSR(1));                                            08478000
END  <<PROCEDURE OUTERBLOCK>>                                           08480000
;                                                                       08482000
$PAGE ""                                                                08484000
    IF USERSPECD THEN USERDEV:=1;                            <<01DEC77>>08486000
    OUTERBLOCK;                                                         08488000
    GETCMDS;                                                            08490000
END.                                                                    08492000
