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