$CONTROL USLINIT,CODE,MAP,SOURCE                                        00010000
<< UDC -- MODULE 82 >>                                                  00015000
<< HP32002C MPE SOURCE C.00.00 >>                                       00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$CONTROL SEGMENT=UDC,MAIN=USER'DEF'CMDS                                 00055000
BEGIN                                                                   00060000
EQUATE                                                                  00065000
   CCG           = 0,                                                   00070000
   CCL           = 1,                                                   00075000
   CCE           = 2;                                                   00080000
                                                                        00085000
INTEGER                                                                 00090000
   STATUS = Q-1,                                                        00095000
   S0 =S-0,                                                             00100000
   X = X;                                                               00105000
                                                                        00110000
BYTE POINTER BPS0 = S-0;                                                00115000
POINTER PS0 = S-0;                                                      00120000
DOUBLE POINTER DPS0 = S-0;                                              00125000
ARRAY DB2(*)=DB+2;                                             <<00416>>00130000
                                                                        00135000
DEFINE                                                                  00140000
   EXECUTORHEAD =                                              <<00884>>00145000
      (PARMSP,ERRNUM,PARMNUM);                                 <<00884>>00150000
      BYTE ARRAY PARMSP;                                       <<00884>>00155000
      INTEGER ERRNUM,PARMNUM #,                                <<00884>>00160000
   NOERRORS =  (ERRNUM <= 0) #,                                <<00884>>00165000
   CONDCODE      = STATUS.(6:2)#,                                       00170000
   CCGRETN       = BEGIN                                                00175000
                      CONDCODE := CCG;                                  00180000
                      GO OUTL;                                          00185000
                   END#,                                                00190000
   CCLRETN            = BEGIN                                           00195000
                      CONDCODE := CCL;                                  00200000
                      GO OUTL;                                          00205000
                   END#,                                                00210000
   DEF'MOVEFROMDSEG   =                                                 00215000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                           00220000
         VALUE TARGET,DSTN,OFFSET,COUNT;                                00225000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                              00230000
      BEGIN                                                             00235000
         X :          = TOS; << SAVE RETURN ADDRESS >>                  00240000
         ASSEMBLE(MFDS 0);                                              00245000
         TOS :        = X; << RESTORE RETURN ADDRESS >>                 00250000
      END #,                                                            00255000
                                                                        00260000
   DEF'MOVETODSEG     =                                                 00265000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                             00270000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                                00275000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                              00280000
      BEGIN                                                             00285000
         X :          = TOS;                                            00290000
         ASSEMBLE(MTDS 0);                                              00295000
         TOS :        = X;                                              00300000
      END #;                                                            00305000
$INCLUDE INCLPXG                                               <<06601>>00310000
$INCLUDE INCLCAP                                               <<06601>>00315000
                                                                        00320000
$INCLUDE INCLCIS                                               <<04603>>00325000
LOGICAL UDCDSTNO = CIS'UDC0;                                   <<04603>>00330000
DEFINE                                                         <<04603>>00335000
   UDCTYPE'               = (6:2)#;                            <<04603>>00340000
EQUATE                                                         <<00416>>00345000
   DIRCREAD = 1,                                               <<00884>>00350000
   DIRCWRITE = 2,                                              <<00884>>00355000
   UDCTYPE'USER=0,                                             <<00416>>00360000
   UDCTYPE'ACCOUNT=1,                                          <<00416>>00365000
   UDCTYPE'SYSTEM=2,                                           <<00416>>00370000
   UDCTYPE'NUMLEVELS     = 3,  << User, Account, & System >>   <<04651>>00375000
   GETUSERENTRY=%630,        <<DIRECSCAN FOR USER ENTRY>>      <<00416>>00380000
   GETACCTENTRY=%420,        <<DIRECSCAN FOR ACCT ENTRY>>      <<00416>>00385000
   SYSGLOBUDCFLAG=%1376,     <<SYSTEM UDC'S EXIST FLAG>>       <<00416>>00390000
   USERUDCPTR  = 18,                                           <<00884>>00395000
   ACCTUDCPTR  = 28,                                           <<00884>>00400000
   SYSUDCPTR   = 29,                                           <<00884>>00405000
   UMAXJOB=17,               <<UDC EXIST BIT IN USER ENTRY>>   <<00416>>00410000
   AMAXJOB=27;               <<UDC EXIST BITS IN ACCT ENTRY>>  <<00416>>00415000
                                                               <<00416>>00420000
DEFINE                                                         <<00416>>00425000
   USERUDCBIT=UMAXJOB).(1:1#,<<USER UDC BIT>>                  <<00416>>00430000
   ACCTUDCBIT=AMAXJOB).(1:1#,<<ACCT UDC BIT>>                  <<00416>>00435000
   SYSUDCBIT=AMAXJOB).(0:1#; <<SYSTEM UDC BIT>>                <<00416>>00440000
                                                                        00445000
                                                                        00450000
EQUATE                                                                  00455000
   CR                    = %15,                                         00460000
   DISABLEBREAK          = 14,                                          00465000
   ENABLEBREAK           = 15,                                          00470000
   NOUDCGLOBALSM1        = 4,  << THERE ARE 5 GLOBAL CELLS>>            00475000
                                                                        00480000
                                                                        00485000
   FSYSSET               = 8,                                           00490000
   CISET                 = 2,                                           00495000
   SETSEVEN              = 7,                                  << 8156>>00500000
   UDCMAXPARMS           = 16,                                          00505000
   MAXSCPARMS            = 50,                                 <<01510>>00510000
   MAXSCPARMSM1          = MAXSCPARMS - 1,                     <<01510>>00515000
   PINFOSIZE             = UDCMAXPARMS*3 -1,                            00520000
                                                                        00525000
   BUFFSIZE              = 72,                                          00530000
   BUFFSIZEW             = 36,                                          00535000
   DIRSIZEM1             = 2047,                               <<01314>>00540000
   DIRSIZEB              = 4096,                               <<01314>>00545000
   DIRHEAD               = 1,                                           00550000
   DIRHEADSIZE           = 4,                                           00555000
   DIRHEADSIZEB          = DIRHEADSIZE*2,                               00560000
   DIRMAXCMDSIZE         = 16,                                          00565000
   DIRMAXENTRYSIZE       = DIRMAXCMDSIZE/2 +DIRHEADSIZE,                00570000
   DIRENTRYSIZE          = 1,                                           00575000
   DIRRECNO              = 1,                                           00580000
   DIRBODYRECNO          = 2,                                           00585000
   DIRFILENO             = 6,                                           00590000
   DIRCMDLEN             = 7,                                           00595000
   DIRCMD                = 8,                                           00600000
                                                                        00605000
   UDCBUFFSIZE           = 40*4,                               <<05021>>00610000
   UDCRECSIZE            = 40,                                          00615000
   UDCRECSIZEB           = UDCRECSIZE*2,                                00620000
   TERMSIZE              = 72,                                          00625000
   TERMSIZEWM1           = TERMSIZE/2 -1,                               00630000
   UDCINITSTACKSIZE      = %5000, << GUESS AT STACK SIZE >>             00635000
                                                                        00640000
   << COMMAND.PUB.SYS >>                                                00645000
                                                                        00650000
   COMFREEHEAD           = 0,                                           00655000
   COMMAXUSE             = 2,                                           00660000
   COMUSE                = 3,                                           00665000
   COMLINK               = 0,                                           00670000
   COMENTRYTYPE          = 1,                                           00675000
   COMUNAME              = 4,                                           00680000
   COMANAME              = 12,                                          00685000
   COMFNAME              = 4,                                           00690000
   COMFREEENTRY          = 0,                                           00695000
   COMUSERENTRY          = 1,                                           00700000
   COMFILEENTRY          = 2,                                           00705000
   COMRECSIZE            = 20,                                          00710000
   COMRECSIZEM1          = COMRECSIZE -1,                               00715000
                                                                        00720000
      << ERRORS >>                                                      00725000
                                                                        00730000
      << 1901-1909 INITUDC ERRORS                     >>                00735000
      << 1910-1929 FILE ERRORS                      >>                  00740000
      << 1930-1939 SETCATALOG,SHOWCATALOG,HELP      >>                  00745000
      << 1940-1959 ERRORS IN UDC HEAD, BODY & IMAGE >>                  00750000
      << 1970-1977 INITUDC WARNINGS              >>            <<04631>>00755000
                                                                        00760000
      << ERROR TYPES FOR ERROR PROCEDURE >>                             00765000
                                                                        00770000
   FERR                  = 0,                                           00775000
   UDCERR                = 1,                                           00780000
   SYNERR                = 2,                                           00785000
   SYNERRNOL             = 3,                                           00790000
   UDCFERR               = 4,                                           00795000
   IMAGERR               = 5,                                           00800000
                                                                        00805000
      << EOF INDICATOR >>                                               00810000
                                                                        00815000
   EOFOUND               = 5,                                  <<00884>>00820000
   NOSUCHCOMUSER         = 1904, << User not in Command file >><<00884>>00825000
                                                                        00830000
      << ERRORS IN INITUDC (:SETCATALOG OR LOGON) >>                    00835000
                                                                        00840000
   AMPERSANDERR          = 1905, << CONT. AT END OF FILE >>             00845000
   CMDNOTALPHA           = 1906,                                        00850000
   STACKOVERFLOW         = 1907,                                        00855000
   GETDATASEGERR         = 1908,                                        00860000
   TOOMANYCMDSFORDIR     = 1909,                                        00865000
                                                                        00870000
      << ERRORS IN  COMMAND.PUB.SYS >>                                  00875000
                                                                        00880000
   COMOPENFAIL           = 1910,                                        00885000
   COMEOF                = 1911,                                        00890000
   COMLOCKFAIL           = 1912,                                        00895000
   COMUNLOCKFAIL         = 1913,                                        00900000
   COMREADFAIL           = 1914,                                        00905000
   COMWRITEFAIL          = 1915,                                        00910000
                                                               <<04846>>00915000
   << Errors in handling UDC files in SETCATALOG. >>           <<04846>>00920000
 LOCKWORDERR           = 1916, << Couldn't find lockword. >>   <<04846>>00925000
                                                               <<04846>>00930000
                                                                        00935000
      << ERRORS IN 'SHOWCATALOG' >>                                     00940000
                                                                        00945000
   SHOWCATLISTOPENF      = 1921,                                        00950000
   SHOWCATLISTWRITEF     = 1922,                                        00955000
                                                                        00960000
      << ERRORS IN UDC FILE >>                                          00965000
   UDCOPENFAIL           = 1923,                                        00970000
   UDCREADFAIL           = 1924,                                        00975000
   UDCIFS'NEQ'ENDIFS     = 1925,                               <<00835>>00980000
   UDCEMPTY              = 1926,                               <<01306>>00985000
                                                                        00990000
      << INFO MESSGES & HEADERS >>                                      00995000
                                                                        01000000
   UDCHELPHEAD           = 1930,                                        01005000
   NOCATALOGS            = 1931, <<:SHOWCATALOG>>                       01010000
   USEDLISTFILE          = 1932, <<:SHOWCATALOG>>                       01015000
                                                                        01020000
      << CI ERROR NUMBERS (SETCATALOG & SHOWCATALOG) >>                 01025000
                                                                        01030000
   EXPECTLISTFILE        = 1933, <<:SHOWCATALOG>>              <<00884>>01035000
   NOBACKORSYS           = 1934, <<:SETCATALOG>>               <<00884>>01040000
   UKNKEYWORD            = 1935, <<:SETCATALOG>>               <<00884>>01045000
   SETCAT2MPARMS         = 1936, <<:SETCATALOG>>               <<00884>>01050000
   NEEDSMCAP             = 1937, <<:SETCATALOG>>               <<00884>>01055000
   NEEDAMCAP             = 1938, <<:SETCATALOG>>               <<00884>>01060000
   NOBOTHSYSACC          = 1939, <<:SETCATALOG>>               <<00884>>01065000
                                                                        01070000
      << ERRORS IN PARSING UDC HEAD & UDC IMAGE >>                      01075000
                                                                        01080000
   TOOMANYREC            = 1940,                                        01085000
   PARMNOTALPHA          = 1941,                                        01090000
   TOOMANYPARMS          = 1942,                                        01095000
   MISSINGDEFAULT        = 1943,                                        01100000
   NOCLOSEQUOTE          = 1944,                                        01105000
   INVDELIM              = 1945,                                        01110000
   EXCESSPARMS           = 1946,                                        01115000
   UNKNOWNPARM           = 1947,                                        01120000
   MISSINGPARM           = 1948,                                        01125000
   TOOLONG               = 1949,                                        01130000
   EXPECTPARM            = 1950,                                        01135000
   IGNORED               = 1952,                                        01140000
   FMLNAMENOTALPHA       = 1953, << 1ST CHAR. NOT ALPHA >>              01145000
   INVFORMALNAME         = 1954, << SPECIAL CHAR. IN NAME >>            01150000
    CMDTOOLONG            = 1951, << UDC NAME TOO LONG >>      <<01023>>01155000
   NOTYPEMIX             = 1955, << NO KEYWORD AND POSITIO-  >><<01049>>01160000
                                  <<NAL IN SAME UDC COMMAND  >><<01049>>01165000
   UNKNOWNOPTION         = 1956, << UNKNOWN OPTION KEYWORD >>  <<01529>>01170000
   IGN'USERLEVEL         = 1927, << User UDC level ignored >>  <<06034>>01175000
   IGN'ACCTLEVEL         = 1928, << Account UDCs ignored   >>  <<06034>>01180000
   IGN'SYSLEVEL          = 1929, << System UDCs ignored    >>  <<06034>>01185000
                                                                        01190000
                                                                        01195000
   INITUDCFAILED         = 1960, <<USED IN SETCATALOG. NO MSG>><<00884>>01200000
   UDC'FLUSHED           = 1961, << USED IN FEEDCI.  NO MSG. >><<01288>>01205000
                                                               <<04631>>01210000
      << INITUDC WARNINGS >>                                   <<04631>>01215000
                                                               <<04631>>01220000
   LISTWARN              =1970,                                <<04631>>01225000
   LOGONWARN             =1971,                                <<04631>>01230000
   NOHELPWARN            =1972,                                <<04631>>01235000
   NOBREAKWARN           =1973,                                <<04631>>01240000
   NOLISTWARN            =1974,                                <<04631>>01245000
   NOLOGONWARN           =1975,                                <<04631>>01250000
   HELPWARN              =1976,                                <<04631>>01255000
   BREAKWARN             =1977,                                <<04631>>01260000
                                                               << 8156>>01265000
    << Errors in :SETCATALOG ...; USER= specification. >>      << 8156>>01270000
   USERWANTSEQS          = 1980,                               << 8156>>01275000
   EXPTUSERSPEC          = 1981,                               << 8156>>01280000
   BADUSERSPEC           = 1982,                               << 8156>>01285000
   NEEDSMCAP2            = 1983,                               << 8156>>01290000
   NEEDAMCAP2            = 1984,                               << 8156>>01295000
   NOUSERANDOTHER        = 1985,                               << 8156>>01300000
                                                               << 8156>>01305000
<< Messages used by :SHOWCATALOG ;USER= >>                     << 8156>>01310000
   BADSHOWSYN            = 1990,                               << 8156>>01315000
   BADSHOWUSERSPEC       = 1991,                               << 8156>>01320000
   SHOWUSERDOTAT         = 1992,                               << 8156>>01325000
   TOOMANYSHOWPARMS      = 1993,                               << 8156>>01330000
   SHOWCOMOPENFAIL       = 1994,                               << 8156>>01335000
   SHOWNEEDSSM           = 1995,                               << 8156>>01340000
   SHOWNEEDSAM           = 1996,                               << 8156>>01345000
                                                               << 8156>>01350000
   SHOWSYSUDCFS          = 150,   << From $SET 7. >>           << 8156>>01355000
   NOSYSUDCFS            = 151,                                << 8156>>01360000
   SHOWACCTUDCFS         = 152,                                << 8156>>01365000
   NOACCTUDCFS           = 153,                                << 8156>>01370000
   SHOWUSERUDCFS         = 154,                                << 8156>>01375000
   NOUSERUDCFS           = 155,                                << 8156>>01380000
                                                               << 8156>>01385000
   ENDOFEQUATES          = 0;                                  <<00884>>01390000
                                                                        01395000
INTRINSIC FOPEN,FCHECK,FREAD,FREADDIR,FPOINT,READ,PRINT,DEBUG,          01400000
   FCONTROL,SEARCH,ZSIZE,FWRITE,                                        01405000
   FGETINFO,FCLOSE,FUNLOCK,FLOCK,FWRITEDIR,FSPACE,WHO;                  01410000
                                                                        01415000
PROCEDURE CIERR(ERRNUM,ERRADR,PARMASK,PARM);                            01420000
   VALUE ERRNUM,PARMASK,PARM;                                           01425000
   INTEGER ERRNUM,PARMASK,PARM;                                         01430000
   BYTE ARRAY ERRADR;                                                   01435000
   OPTION VARIABLE,EXTERNAL;                                            01440000
                                                                        01445000
INTEGER PROCEDURE DEBLANK(BUFF,WIDTH);                                  01450000
   VALUE WIDTH; INTEGER WIDTH;                                          01455000
   BYTE ARRAY BUFF; OPTION EXTERNAL;                                    01460000
                                                                        01465000
DOUBLE PROCEDURE DIRECSCAN(TYPE,LINKAGE,ANAME,GUNAME,                   01470000
      FNAME,RECIP,PARMS,MVTABX);                                        01475000
   VALUE TYPE,LINKAGE,MVTABX;                                           01480000
   INTEGER TYPE,MVTABX;                                                 01485000
   DOUBLE LINKAGE;                                                      01490000
   ARRAY ANAME,GUNAME,FNAME,PARMS;                                      01495000
   INTEGER PROCEDURE RECIP;                                             01500000
   OPTION EXTERNAL,VARIABLE;                                            01505000
                                                                        01510000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<00884>>01515000
   VALUE FNUM;  INTEGER FNUM,PARMNUM;                          <<00884>>01520000
   OPTION EXTERNAL;                                            <<00884>>01525000
                                                               <<00884>>01530000
INTEGER PROCEDURE FINDPARM(STRING,PARMPTR,DELPTR);                      01535000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      01540000
   OPTION VARIABLE,EXTERNAL;                                            01545000
                                                                        01550000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);                01555000
   VALUE TYPE;BYTE ARRAY TARGET,BA1,BA2,BA3,BA4;                        01560000
   INTEGER TYPE;OPTION EXTERNAL;                                        01565000
                                                                        01570000
INTEGER PROCEDURE GENMSG(A,B,C,D,E,F,G,H,I,J,K,L,M);                    01575000
   VALUE A,B,C,D,E,F,G,H,I,J,K,L,M;                                     01580000
   LOGICAL A,B,C,D,E,F,G,H,I,J,K,L,M;                                   01585000
   OPTION VARIABLE,EXTERNAL;                                            01590000
                                                                        01595000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                           01600000
   VALUE MEMSIZE,VDSIZE;INTEGER MEMSIZE,VDSIZE;                         01605000
   OPTION EXTERNAL;                                                     01610000
                                                                        01615000
INTEGER PROCEDURE MYCOMMAND                                    <<00884>>01620000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);        <<00884>>01625000
   VALUE MAXPARMS;                                             <<00884>>01630000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                            <<00884>>01635000
   INTEGER MAXPARMS,NUMPARMS;                                  <<00884>>01640000
   DOUBLE ARRAY PARMS;                                         <<00884>>01645000
   BYTE POINTER DEFN;                                          <<00884>>01650000
   OPTION VARIABLE,EXTERNAL;                                   <<00884>>01655000
                                                               <<00884>>01660000
INTEGER PROCEDURE NEXTPARM(STRING,PARMPTR,DELPTR);                      01665000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      01670000
   OPTION VARIABLE,EXTERNAL;                                            01675000
                                                                        01680000
                                                                        01685000
   << FOPEN ENTRY POINT >>                                              01690000
INTEGER PROCEDURE PVOPEN(FD,FO,AO,R,D,FM,U,B,N,FS,NE,I,FC);             01695000
   VALUE FO,AO,R,U,B,N,FS,NE,I,FC;                                      01700000
   BYTE ARRAY FD,D,FM;                                                  01705000
   LOGICAL FO,AO;                                                       01710000
   INTEGER R,U,B,N,NE,I,FC;                                             01715000
   DOUBLE FS;                                                           01720000
   OPTION VARIABLE,EXTERNAL;                                            01725000
                                                                        01730000
PROCEDURE QUALIFYFILENAME(OLDFNAME,NEWFNAME);                           01735000
   BYTE ARRAY OLDFNAME,NEWFNAME;                                        01740000
   OPTION EXTERNAL;                                                     01745000
                                                                        01750000
PROCEDURE RELDATASEG(EN);VALUE EN;INTEGER EN;                           01755000
   OPTION EXTERNAL;                                                     01760000
                                                                        01765000
                                                               <<04810>>01770000
LOGICAL PROCEDURE SETCRITICAL;                                 <<04810>>01775000
OPTION EXTERNAL;                                               <<04810>>01780000
                                                               <<04810>>01785000
PROCEDURE RESETCRITICAL( PARM );                               <<04810>>01790000
   VALUE PARM;  LOGICAL PARM;                                  <<04810>>01795000
OPTION EXTERNAL;                                               <<04810>>01800000
                                                               <<04810>>01805000
LOGICAL PROCEDURE REQUESTSERVICE; OPTION EXTERNAL;                      01810000
                                                                        01815000
PROCEDURE SETSERVICE(DISP); VALUE DISP;LOGICAL DISP;                    01820000
   OPTION EXTERNAL;                                                     01825000
PROCEDURE SUDDENDEATH(NUMBER);                                 <<00863>>01830000
   VALUE NUMBER; INTEGER NUMBER;                               <<00863>>01835000
   OPTION EXTERNAL;                                            <<00863>>01840000
                                                               <<04846>>01845000
INTEGER PROCEDURE FGETLOCKWORD( FNUM, LOCKWORD, LEN );         <<04846>>01850000
   VALUE FNUM;                                                 <<04846>>01855000
   INTEGER FNUM, LEN;                                          <<04846>>01860000
   BYTE ARRAY LOCKWORD;                                        <<04846>>01865000
OPTION EXTERNAL;                                               <<04846>>01870000
                                                                        01875000
   << COMMANDINTERP ENTRY POINT >>                                      01880000
PROCEDURE UDCCI(COMLEN);                                                01885000
   VALUE COMLEN;                                                        01890000
   INTEGER COMLEN;                                                      01895000
   OPTION EXTERNAL;                                                     01900000
                                                                        01905000
   << OPTION FORWARDS >>                                                01910000
INTEGER PROCEDURE CHECKFILENAME'(A,B,C,D);                     <<00226>>01915000
VALUE A;                                                       <<00226>>01920000
DOUBLE A;                                                      <<00226>>01925000
LOGICAL B,C,D;                                                 <<00226>>01930000
OPTION EXTERNAL;                                               <<00226>>01935000
                                                                        01940000
                                                                        01945000
                                                                        01950000
PROCEDURE ERROR(ERRNO,TYPE,EPTR,BASEPTR);                               01955000
   VALUE ERRNO,TYPE,EPTR,BASEPTR; INTEGER ERRNO,TYPE;                   01960000
   BYTE POINTER EPTR,BASEPTR; OPTION VARIABLE,FORWARD;                  01965000
                                                                        01970000
INTEGER PROCEDURE GETCOMREC(COMFN,ERRNO);                               01975000
   VALUE COMFN; INTEGER COMFN,ERRNO;                                    01980000
   OPTION FORWARD;                                                      01985000
                                                                        01990000
PROCEDURE FINDCOMUSER(COMFN,UNAME,ANAME,UDCS,UREC,FREC,ERRNO); <<00884>>01995000
   VALUE COMFN;  BYTE ARRAY UNAME,ANAME; LOGICAL UDCS;         <<00884>>02000000
   INTEGER COMFN,UREC,FREC,ERRNO; OPTION FORWARD;              <<00884>>02005000
                                                                        02010000
PROCEDURE INITUDCNO( SHOW, SETCATCOMFN );                      <<03734>>02015000
   VALUE   SHOW, SETCATCOMFN;                                  <<03734>>02020000
   LOGICAL SHOW;                                               <<03734>>02025000
   INTEGER SETCATCOMFN;                                        <<03734>>02030000
   OPTION VARIABLE, FORWARD;                                   <<03734>>02035000
                                                                        02040000
INTEGER PROCEDURE OPTIONO(STRING); VALUE STRING;                        02045000
   BYTE POINTER STRING; OPTION FORWARD;                                 02050000
                                                                        02055000
INTEGER PROCEDURE RECIPUDC(NTRY,LEVEL,INX,SIRS);                        02060000
   VALUE LEVEL,INX,SIRS;                                                02065000
   INTEGER LEVEL,INX;                                                   02070000
   DOUBLE SIRS;ARRAY NTRY; OPTION FORWARD;                              02075000
                                                                        02080000
PROCEDURE READFILE(FN,RECNO,BUFF',ERRNO);                               02085000
   VALUE FN;INTEGER FN,RECNO,ERRNO;ARRAY BUFF';                         02090000
   OPTION FORWARD;                                                      02095000
                                                                        02100000
PROCEDURE RELCOMREC(COMFN,RECNO,ERRNO);                                 02105000
   VALUE COMFN,RECNO; INTEGER COMFN,RECNO,ERRNO;                        02110000
   OPTION FORWARD;                                                      02115000
                                                                        02120000
PROCEDURE SEARCHCOMFILE(COMFN,UNAME,ANAME,UREC,FREC,ERRNO);    <<00884>>02125000
   VALUE COMFN;  BYTE ARRAY UNAME,ANAME;                       <<00884>>02130000
   INTEGER COMFN,UREC,FREC,ERRNO;                              <<00884>>02135000
   OPTION VARIABLE,FORWARD;                                    <<00884>>02140000
                                                               <<00884>>02145000
LOGICAL PROCEDURE SEARCHUDC(STRING,OFFSET,UDCFN,                        02150000
      RECNO,BODYRECNO,OPTIONS);                                         02155000
   INTEGER OFFSET,UDCFN,RECNO,BODYRECNO;                                02160000
   LOGICAL OPTIONS;                                                     02165000
   BYTE ARRAY STRING; OPTION FORWARD;                                   02170000
                                                                        02175000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                                 02180000
   VALUE OFFSET; INTEGER OFFSET;                                        02185000
   BYTE ARRAY COMIMAGE; OPTION FORWARD;                                 02190000
                                                                        02195000
PROCEDURE UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);           <<00884>>02200000
   LOGICAL UDCSEXIST;                                          <<00884>>02205000
   INTEGER RECNO;                                              <<00884>>02210000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>02215000
   OPTION FORWARD;                                             <<00884>>02220000
                                                               <<00884>>02225000
PROCEDURE UDCDIRCREAD(UNAME,ANAME,UDCSEXIST,RECNO);            <<00884>>02230000
   LOGICAL UDCSEXIST;                                          <<00884>>02235000
   INTEGER RECNO;                                              <<00884>>02240000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>02245000
   OPTION FORWARD;                                             <<00884>>02250000
                                                               <<00884>>02255000
LOGICAL PROCEDURE UDCHELP(COMIMAGE);                                    02260000
   VALUE COMIMAGE;                                                      02265000
   BYTE POINTER COMIMAGE;                                               02270000
   OPTION FORWARD;                                                      02275000
                                                                        02280000
PROCEDURE UPSHIFT(PTR); VALUE PTR; BYTE POINTER PTR;                    02285000
   OPTION FORWARD;                                                      02290000
                                                                        02295000
                                                                        02300000
$TITLE "CLOSEUDC"                                                       02305000
PROCEDURE CLOSEUDC(DSTNO);                                     <<00884>>02310000
   VALUE DSTNO;  INTEGER DSTNO;                                <<00884>>02315000
   OPTION UNCALLABLE;                                                   02320000
BEGIN                                                                   02325000
                                                                        02330000
INTEGER                                                                 02335000
   OFFSET,                                                              02340000
   FILENO,                                                              02345000
   PREVFILENO,                                                 <<00884>>02350000
   LENGTH;                                                              02355000
ARRAY DIR'(0:DIRHEADSIZE); BYTE ARRAY DIR(*) = DIR';                    02360000
                                                                        02365000
SUBROUTINE DEF'MOVEFROMDSEG;                                            02370000
                                                                        02375000
OFFSET := PREVFILENO := 0;                                     <<00884>>02380000
DO BEGIN                                                                02385000
   MOVEFROMDSEG(@DIR',DSTNO,OFFSET,DIRHEADSIZE);               <<00884>>02390000
   FILENO := DIR(DIRFILENO);                                            02395000
   LENGTH := DIR(DIRENTRYSIZE);                                         02400000
   IF FILENO <> PREVFILENO THEN                                <<00884>>02405000
      BEGIN                                                    <<00884>>02410000
      FCLOSE(FILENO,0,0);                                      <<00884>>02415000
      PREVFILENO := FILENO;                                    <<00884>>02420000
      END;                                                     <<00884>>02425000
   OFFSET := OFFSET + LENGTH;                                  <<00884>>02430000
END UNTIL LENGTH = 0;                                                   02435000
                                                                        02440000
END; << CLOSEUDC >>                                                     02445000
$TITLE "CXSETCATALOG"                                          <<00884>>02450000
PROCEDURE CXSETCATALOG EXECUTORHEAD;                           <<00884>>02455000
   OPTION UNCALLABLE;                                          <<00884>>02460000
COMMENT                                                        <<00884>>02465000
   Command executor for the SETCATALOG command.                <<00884>>02470000
   Syntax:                                                     <<00884>>02475000
;                                                              <<00884>>02480000
<< The syntax for this command is as follows:              >>  << 8156>>02485000
<<                                                         >>  << 8156>>02490000
<<  :SETCATALOG [udcfile[,udcfile...]][;ACCOUNT]           >>  << 8156>>02495000
<<                                    [;SYSTEM]            >>  << 8156>>02500000
<<                                    [;USER=user[.acct]]  >>  << 8156>>02505000
<<                                                         >>  << 8156>>02510000
<< Only one keyword can be specified in any invocation.    >>  << 8156>>02515000
                                                               <<00884>>02520000
COMMENT                                                        <<00884>>02525000
   This command activates the user defined commands (UDC's) in <<00884>>02530000
   the specified UDC files. The UDC's can be made to apply to t<<00884>>02535000
   user, ACCOUNT, or SYSTEM depending on the optional paramters<<00884>>02540000
   chosen. The SHOW parameter causes the UDC file names and    <<00884>>02545000
   user defined commands to be listed as they are initialized. <<00884>>02550000
   If no UDC files are specified then any existing UDC's are   <<00884>>02555000
   deactivated at the specified level (user, ACCOUNT, or       <<00884>>02560000
   SYSTEM).                                                    <<00884>>02565000
                                                               <<00884>>02570000
   Execution strategy:                                         <<00884>>02575000
      1) Check syntax.                                         <<00884>>02580000
            Any file names are passed through CHECKFILENAME'.  <<00884>>02585000
            Backreferenced and system defined files (except    <<00884>>02590000
            $NULL) are rejected. Extra parameters are parsed   <<00884>>02595000
            and capability checks are made for the use of the  <<00884>>02600000
            ACCOUNT and SYSTEM parameters.                     <<00884>>02605000
      2) Save current UDC information.                         <<00884>>02610000
            The UDC DST number is saved. The UDC directory     <<00884>>02615000
            COMMAND.PUB.SYS is searched to locate UDC files    <<00884>>02620000
            for this UDC level.                                <<00884>>02625000
      3) Enter new UDC file names into UDC directory.          <<00884>>02630000
            File names are added as a linked list. A user and  <<00884>>02635000
            account entry is added pointing to the file names. <<00884>>02640000
      4) Initialize new UDC's.                                 <<00884>>02645000
            The location of the file names is written into the <<00884>>02650000
            system directory. INITUDC is called to activate    <<00884>>02655000
            the new UDC's.                                     <<00884>>02660000
      5) Deactivate old UDC's.                                 <<00884>>02665000
            Old UDC files are closed. Old UDC extra data segmen<<00884>>02670000
            is released. Old file names in COMMAND.PUB.SYS are <<00884>>02675000
            released.                                          <<00884>>02680000
                                                               <<03734>>02685000
                                                               <<03734>>02690000
   Fix Information:                                            <<03734>>02695000
                                                               <<03734>>02700000
      * It was discovered that the FLOCKing and FUNLOCKing of  <<03734>>02705000
        COMMAND.PUB.SYS was not sufficient to prevent windows  <<03734>>02710000
        in which simultaneous :SETCATALOGs or concurrent       <<03734>>02715000
        :SETCATALOGs and logons from causing corruption of the <<03734>>02720000
        COMMAND.PUB.SYS file.  This fix keeps COMMAND.PUB.SYS  <<03734>>02725000
        locked as long as it is opened by either CXSETCATALOG  <<03734>>02730000
        or INITUDC (for logon).  Note, however, that the       <<03734>>02735000
        procedures RELCOMREC and GETCOMREC now expect the      <<03734>>02740000
        COMFN file to be locked by the calling procedure:      <<03734>>02745000
        they no longer do any locking/unlocking.  These two    <<03734>>02750000
        procedures could be called from the CI when a          <<03734>>02755000
        :PURGE{USER/ACCT} is being executed.  Also note that   <<03734>>02760000
        the externals for INITUDC (specifically INITUDCNO)     <<03734>>02765000
        have been changed to allow CXSETCATALOG to pass the    <<03734>>02770000
        file number of the opened and locked COMMAND.PUB.SYS.  <<03734>>02775000
                                                               <<03734>>02780000
                                                               <<03767>>02785000
      * Fix number 3734 introduced another bug.  Before that   <<03767>>02790000
        fix, INITUDC would FCLOSE COMMAND.PUB.SYS after any    <<03767>>02795000
        logon UDC was executed.  Fix 3734 used that FCLOSE to  <<03767>>02800000
        also FUNLOCK COMMAND.PUB.SYS--the result of this was   <<03767>>02805000
        that COMMAND.PUB.SYS would stay locked while any job   <<03767>>02810000
        or session was executing a logon UDC.  This meant that <<03767>>02815000
        other jobs would not logon.  This was fixed by moving  <<03767>>02820000
        the FCLOSE to before the logon UDC execution.          <<03767>>02825000
                                                               <<03767>>02830000
      * When a UDC file has a lockword on it, a user could     <<04846>>02835000
        have rejected the use of that UDC file by supplying a  <<04846>>02840000
        bad lockword when prompted for it at logon--this may   <<04846>>02845000
        not be acceptable for account or system UDCs.  This    <<04846>>02850000
        fix will always append the lockword into the COMMAND   <<04846>>02855000
        entry.  Note that COMMAND.PUB.SYS is opened with       <<04846>>02860000
        EXECUTE access, thus users can be prevented from       <<04846>>02865000
        viewing the UDC lockwords in COMMAND.                  <<04846>>02870000
                                                               << 8156>>02875000
      * This change extends :SETCATALOG so that a user can     << 8156>>02880000
        have the ability to :SETCATALOG another user's UDCs.   << 8156>>02885000
        This is performed by using the new :USER= keyword.     << 8156>>02890000
        Note the security checks:  a user with AM capability   << 8156>>02895000
        can :SETCATALOG for any user in his/her account, and   << 8156>>02900000
        a user with SM capability can :SETCATALOG for any      << 8156>>02905000
        user on the system.  Also note that INITUDC is not     << 8156>>02910000
        called if the :USER= keyword is used.  This means a    << 8156>>02915000
        user can :SETCATALOG for himself and have the UDCs     << 8156>>02920000
        take effect only when that user next logs on.          << 8156>>02925000
                                                               << 8156>>02930000
      * This change introduces the :USER= keyword to           << 8156>>02935000
        :SETCATALOG.  This allows a more general interface     << 8156>>02940000
        for the setting up of user UDCs.                       << 8156>>02945000
                                                               << 8156>>02950000
   ;                                                           <<00884>>02955000
                                                               <<00884>>02960000
BEGIN                                                          <<00884>>02965000
DEFINE                                                         <<00884>>02970000
   PARMADDR  = IPARMS(2*PARMNUM) #,                            <<00884>>02975000
   PARMLEN   = IPARMS(2*PARMNUM+1).(0:8) #,                    <<00884>>02980000
   NEXTDELIM = IPARMS(2*PARMNUM+1).(11:5) #,                   <<00884>>02985000
   DELIMSDEF = [8/",",8/";",8/"=",8/%15]D #;                   << 8156>>02990000
                                                               <<00884>>02995000
EQUATE                                                         <<00884>>03000000
   MAXPARMS   = MAXSCPARMS,                                    <<01510>>03005000
   COMMA      = 0,                                             <<00884>>03010000
   SEMICOLON  = 1,                                             <<00884>>03015000
   EQUALS     = 2,                                             << 8156>>03020000
   CR         = 3;                                             << 8156>>03025000
                                                               <<00884>>03030000
LOGICAL                                                        <<00884>>03035000
   DMY,                                                        <<00884>>03040000
   USERSPECD,     << TRUE if USER keyword used. >>             << 8156>>03045000
   SHOW,          << TRUE => 'SHOW' parm specified >>          <<00884>>03050000
   ACCOUNT,       << TRUE => 'ACCOUNT' parm specified >>       <<00884>>03055000
   SYSTEM,        << TRUE => 'SYSTEM' parm specified >>        <<00884>>03060000
   NEWUDCFILES,   << TRUE => new UDC file(s) specified >>      <<00884>>03065000
   UDCSEXIST,     << used for updating directory >>            <<00884>>03070000
   OLDUDCSEXIST,  << TRUE => UDC's currently exist(this level)><<00884>>03075000
   OLDCRIT,       << From SETCRITICAL.             >>          <<04810>>03080000
   UNLOCKOK,      << Able to UNLOCK COMMAND.PUB.SYS.  >>       <<04810>>03085000
   OLDDSTNO;      << current UDC extra DST no. >>              <<00884>>03090000
                                                               <<00884>>03095000
INTEGER                                                        <<00884>>03100000
   I,             << Index Variable.                    >>     << 8156>>03105000
   NIL := 0,      << used for updating directory >>            <<00884>>03110000
   NUMPARMS,      << number of parameters specified >>         <<00884>>03115000
   LASTFILEPARM,  << PARMS index of last UDC file >>           <<00884>>03120000
   ERRNO,         << error return value >>                     <<00884>>03125000
   RELEASE'ERR,   << error return value >>                     <<00884>>03130000
   RECNO,         << used for entering  file names >>          <<00884>>03135000
   OLDRECNO,      << location in comfile of current udc files ><<00884>>03140000
   COMFN;         << command file number >>                    <<00884>>03145000
                                                               <<00884>>03150000
BYTE POINTER                                                   <<00884>>03155000
   PARMPTR;                                                    <<00884>>03160000
                                                               <<00884>>03165000
DOUBLE                                                         <<00884>>03170000
   DELIMS := DELIMSDEF;                                        << 8156>>03175000
                                                               <<00884>>03180000
DOUBLE ARRAY                                                   <<00884>>03185000
   PARMS(0:MAXPARMS-1);                                        <<00884>>03190000
                                                               <<00884>>03195000
ARRAY                                                          <<00884>>03200000
   IPARMS(*) = PARMS,                                          <<00884>>03205000
   REC'(0:COMRECSIZEM1);                                       <<00884>>03210000
                                                               << 8156>>03215000
<< The following declarations are used for the second      >>  << 8156>>03220000
<< call to MYCOMMAND used to parse the subparameters for   >>  << 8156>>03225000
<< the "USER=" keyword.                                    >>  << 8156>>03230000
   EQUATE                                                      << 8156>>03235000
      MAXUSERSPECPARMS   = 3;                                  << 8156>>03240000
                                                               << 8156>>03245000
   BYTE ARRAY                                                  << 8156>>03250000
      USERDELIMS(0:5);                                         << 8156>>03255000
                                                               << 8156>>03260000
   INTEGER                                                     << 8156>>03265000
      NUMUSERSPECPARMS   := 0;                                 << 8156>>03270000
                                                               << 8156>>03275000
   DOUBLE ARRAY                                                << 8156>>03280000
      USERPARMS(0:MAXUSERSPECPARMS);                           << 8156>>03285000
                                                               << 8156>>03290000
   INTEGER ARRAY                                               << 8156>>03295000
      IUSERPARMS(*) = USERPARMS;                               << 8156>>03300000
                                                               << 8156>>03305000
   DEFINE                                                      << 8156>>03310000
      USERP1ADDR        = IUSERPARMS #,                        << 8156>>03315000
      USERP1LEN         = IUSERPARMS(1).(0:8) #,               << 8156>>03320000
      SPECIALSINP1      = ( IUSERPARMS(1).(10:1) = 1 ) #,      << 8156>>03325000
      USERP1DELIMDOT    = ( IUSERPARMS(1).(11:5) = 0 ) #,      << 8156>>03330000
      BADP1DELIM        = ( ( IUSERPARMS(1).(11:5) = 1 )       << 8156>>03335000
                            LOR                                << 8156>>03340000
                            ( IUSERPARMS(1).(11:5) = 3 ) )#,   << 8156>>03345000
      USERP2ADDR        = IUSERPARMS(2) #,                     << 8156>>03350000
      USERP2LEN         = IUSERPARMS(3).(0:8) #,               << 8156>>03355000
      SPECIALSINP2      = ( IUSERPARMS(3).(10:1) = 1 ) #;      << 8156>>03360000
                                                               << 8156>>03365000
BYTE ARRAY                                                     <<00884>>03370000
   REC(*) = REC',                                              <<00884>>03375000
   LOCKWORD(0:7),        << Holds UDC file lockword, if any >> <<04846>>03380000
   USNAME(0:7),     << User name specified by USER >>          << 8156>>03385000
   ASNAME(0:7),     << Account name specified by USER >>       << 8156>>03390000
   UNAME(0:7),                                                 <<00884>>03395000
   ANAME(0:7);                                                 <<00884>>03400000
                                                               <<06601>>03405000
ARRAY QARRAY(*) = Q + 0;                                       <<06601>>03410000
INTEGER PCBGLOBLOC;                                            <<06601>>03415000
POINTER UCAPPTR;                                               <<06601>>03420000
                                                               <<00884>>03425000
BYTE ARRAY             << add new parameters here >>           <<00884>>03430000
   PKEYLIST(0:1) = PB :=                                       <<00884>>03435000
      6,4,"SHOW",                                              <<00884>>03440000
      9,7,"ACCOUNT",                                           <<00884>>03445000
      8,6,"SYSTEM",                                            <<00884>>03450000
      6,4,"USER",                                              << 8156>>03455000
      0;                                                       <<00884>>03460000
EQUATE PKEYLISTLEN = 30;                                       << 8156>>03465000
BYTE ARRAY KEYLIST(0:PKEYLISTLEN-1);                           <<00884>>03470000
                                                               <<00884>>03475000
<<***********************************************************>><<00884>>03480000
<<  COMFILE'ERR                                              >><<00884>>03485000
<<    Gets file system error number.                         >><<00884>>03490000
<<    Closes Command file.                                   >><<00884>>03495000
<<    Calls CIERR setting ERRNUM.                            >><<00884>>03500000
<<***********************************************************>><<00884>>03505000
SUBROUTINE COMFILE'ERR(ERR);                                   <<00884>>03510000
VALUE ERR;  INTEGER ERR;                                       <<00884>>03515000
   BEGIN                                                       <<00884>>03520000
   IF NOERRORS THEN                                            <<00884>>03525000
      BEGIN                                                    <<00884>>03530000
      FERROR'(COMFN,PARMNUM); << Gets FS err #. Closes file. >><<00884>>03535000
      CIERR(ERRNUM := IF ERR = EOFOUND THEN COMEOF ELSE ERR);  <<00884>>03540000
      END;                                                     <<00884>>03545000
   END;                                                        <<00884>>03550000
<<***********************************************************>><<00884>>03555000
<<  RELEASERECS                                              >><<00884>>03560000
<<    Returns records in Command file to the free list.      >><<00884>>03565000
<<    RECNUM is the head of a linked list of records.        >><<00884>>03570000
<<***********************************************************>><<00884>>03575000
SUBROUTINE RELEASERECS(RECNUM);                                <<00884>>03580000
   VALUE RECNUM; INTEGER RECNUM;                               <<00884>>03585000
   BEGIN                                                       <<00884>>03590000
   WHILE (RECNUM <> 0) AND NOERRORS DO                         <<00884>>03595000
      BEGIN                                                    <<00884>>03600000
      FREADDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNUM));          <<00884>>03605000
      IF <> THEN COMFILE'ERR(COMREADFAIL)                      <<00884>>03610000
      ELSE                                                     <<00884>>03615000
         BEGIN                                                 <<00884>>03620000
         RELCOMREC(COMFN,RECNUM,RELEASE'ERR);                  <<00884>>03625000
         IF RELEASE'ERR <> 0 THEN COMFILE'ERR(RELEASE'ERR)     <<00884>>03630000
         ELSE RECNUM := REC'(COMLINK);                         <<00884>>03635000
         END;                                                  <<00884>>03640000
      END;                                                     <<00884>>03645000
   END; << RELEASERECS >>                                      <<00884>>03650000
<<***********************************************************>><<00884>>03655000
<<  GETREC                                                   >><<00884>>03660000
<<    Locates a free record in Command file.                 >><<00884>>03665000
<<***********************************************************>><<00884>>03670000
INTEGER SUBROUTINE GETREC;                                     <<00884>>03675000
   BEGIN                                                       <<00884>>03680000
   GETREC := GETCOMREC(COMFN,ERRNO);                           <<00884>>03685000
   IF ERRNO > 0 THEN                                           <<00884>>03690000
      BEGIN                                                    <<00884>>03695000
      RELEASERECS(RECNO);                                      <<00884>>03700000
      COMFILE'ERR(ERRNO);                                      <<00884>>03705000
      END;                                                     <<00884>>03710000
   END;  << GETREC >>                                          <<00884>>03715000
                                                               <<00884>>03720000
<<***********************************************************>><<00884>>03725000
<<  PARSEUDCFILENAMES                                        >><<00884>>03730000
<<     Validates file names (if any).                        >><<00884>>03735000
<<     Flags $NULL files as parms of zero length.            >><<00884>>03740000
<<***********************************************************>><<00884>>03745000
SUBROUTINE PARSEUDCFILENAMES;                                  <<00884>>03750000
   BEGIN                                                       <<00884>>03755000
   MYCOMMAND(PARMSP,DELIMS,MAXPARMS,NUMPARMS,PARMS);           <<00884>>03760000
   IF > THEN CIERR(ERRNUM := SETCAT2MPARMS,,%10000,MAXPARMS)   <<00884>>03765000
   ELSE                                                        <<00884>>03770000
      BEGIN                                                    <<00884>>03775000
      NEWUDCFILES := FALSE;                                    <<00884>>03780000
      PARMNUM := -1;                                           <<00884>>03785000
      IF NUMPARMS > 0 THEN                                     <<00884>>03790000
                                                               <<00884>>03795000
         DO BEGIN                                              <<00884>>03800000
            PARMNUM := PARMNUM + 1;                            <<00884>>03805000
            @PARMPTR := PARMADDR;                              <<00884>>03810000
            IF PARMLEN > 0 THEN                                <<00884>>03815000
               BEGIN                                           <<00884>>03820000
               ERRNO :=                                        <<00884>>03825000
                  CHECKFILENAME'(PARMS(PARMNUM)&LSR(8),DMY,DMY,<<00884>>03830000
                                 DMY);                         <<00884>>03835000
               IF <> THEN                                      <<00884>>03840000
                  IF > THEN                                    <<00884>>03845000
                       << Backreferenced or system defined file<<00884>>03850000
                     IF ERRNO = 6 <<$NULL>> THEN               <<00884>>03855000
                        PARMLEN := 0  <<Allow, but flag it >>  <<00884>>03860000
                     ELSE                                      <<00884>>03865000
                        CIERR(ERRNUM := NOBACKORSYS,PARMPTR)   <<00884>>03870000
                  ELSE                                         <<00884>>03875000
                       << Bad file syntax >>                   <<00884>>03880000
                     CIERR(ERRNUM := ERRNO,PARMPTR)            <<00884>>03885000
               ELSE                                            <<00884>>03890000
                  << Appears to be good file >>                <<00884>>03895000
                  NEWUDCFILES := TRUE;                         <<00884>>03900000
               END;                                            <<00884>>03905000
            END                                                <<00884>>03910000
         UNTIL (NEXTDELIM <> COMMA) OR (ERRNUM > 0);           <<00884>>03915000
                                                               <<00884>>03920000
      END;                                                     <<00884>>03925000
   LASTFILEPARM := PARMNUM;                                    <<00884>>03930000
   PARMNUM := PARMNUM + 1;                                     <<00884>>03935000
   END; << PARSEUDCFILENAMES >>                                <<00884>>03940000
                                                               <<00884>>03945000
<<***********************************************************>><<00884>>03950000
<<  PARSEXTRAPARMS                                           >><<00884>>03955000
<<     Sets flags indicating which extra parms were chosen.  >><<00884>>03960000
<<     Determines UDC level (user, ACCOUNT, SYSTEM). Verfies >><<00884>>03965000
<<     user has proper capabilities to use ACCOUNT or SYSTEM >><<00884>>03970000
<<     options.                                              >><<00884>>03975000
<<***********************************************************>><<00884>>03980000
SUBROUTINE PARSEXTRAPARMS;                                     <<00884>>03985000
   BEGIN                                                       <<00884>>03990000
   MOVE KEYLIST := PKEYLIST,(PKEYLISTLEN);                     <<00884>>03995000
   SHOW := ACCOUNT := SYSTEM := FALSE;                         <<00884>>04000000
   WHO(,,,UNAME,,ANAME);                                       <<00884>>04005000
                                                               <<00884>>04010000
   WHILE (PARMNUM < NUMPARMS) AND NOERRORS DO                  <<00884>>04015000
      BEGIN                                                    <<00884>>04020000
      @PARMPTR := PARMADDR;                                    <<00884>>04025000
      CASE SEARCH(PARMPTR,PARMLEN,KEYLIST) OF                  <<00884>>04030000
         BEGIN                                                 <<00884>>04035000
                                                               <<00884>>04040000
         << 0: Unknown keyword >>                              <<00884>>04045000
            CIERR(ERRNUM := UKNKEYWORD,PARMPTR);               <<00884>>04050000
                                                               <<00884>>04055000
         << 1: Show>>                                          <<00884>>04060000
            SHOW := TRUE;                                      <<00884>>04065000
                                                               <<00884>>04070000
         << 2: Account>>                                       <<00884>>04075000
            BEGIN                                              <<00884>>04080000
            IF USERSPECD THEN                                  << 8156>>04085000
            BEGIN                                              << 8156>>04090000
               CIERR( ERRNUM := NOUSERANDOTHER );              << 8156>>04095000
               GOTO OUTLOOP;                                   << 8156>>04100000
            END;                                               << 8156>>04105000
            PXGLOBAL;                                          <<06601>>04110000
            @UCAPPTR := @PXG'USERATTRIBUTES;                   <<06601>>04115000
            IF UCAPAM = 0 THEN                                 <<06601>>04120000
               CIERR(ERRNUM := NEEDAMCAP,PARMPTR);             <<00884>>04125000
            ACCOUNT := TRUE;                                   <<00884>>04130000
            MOVE UNAME := "@       ";<< @ indicates all users>><<00884>>04135000
            END;                                               <<00884>>04140000
                                                               <<00884>>04145000
         << 3: System>>                                        <<00884>>04150000
            BEGIN                                              <<00884>>04155000
            IF USERSPECD THEN                                  << 8156>>04160000
            BEGIN                                              << 8156>>04165000
               CIERR( ERRNUM := NOUSERANDOTHER );              << 8156>>04170000
               GOTO OUTLOOP;                                   << 8156>>04175000
            END;                                               << 8156>>04180000
            PXGLOBAL;                                          <<06601>>04185000
            @UCAPPTR := @PXG'USERATTRIBUTES;                   <<06601>>04190000
            IF UCAPSM = 0 THEN                                 <<06601>>04195000
               CIERR(ERRNUM := NEEDSMCAP,PARMPTR);             <<00884>>04200000
            SYSTEM := TRUE;                                    <<00884>>04205000
            MOVE UNAME := "@       ";<< @ indicates all users>><<00884>>04210000
            MOVE ANAME := "@       ";<< @ indicates all accts>><<00884>>04215000
            END;                                               <<00884>>04220000
                                                               << 8156>>04225000
         << 4:  User >>                                        << 8156>>04230000
            BEGIN                                              << 8156>>04235000
                                                               << 8156>>04240000
            USERSPECD := TRUE;                                 << 8156>>04245000
                                                               << 8156>>04250000
            IF (ACCOUNT LOR SYSTEM) THEN                       << 8156>>04255000
            BEGIN                                              << 8156>>04260000
               CIERR( ERRNUM := NOUSERANDOTHER );              << 8156>>04265000
               GOTO OUTLOOP;                                   << 8156>>04270000
            END;                                               << 8156>>04275000
                                                               << 8156>>04280000
            IF NEXTDELIM <> EQUALS                             << 8156>>04285000
               THEN CIERR( ERRNUM := USERWANTSEQS )            << 8156>>04290000
            ELSE                                               << 8156>>04295000
            BEGIN                                              << 8156>>04300000
                                                               << 8156>>04305000
            << The USER keyword specifies a user for whom  >>  << 8156>>04310000
            << the :SETCATALOG is being executed.  Get the >>  << 8156>>04315000
            << specifications into the USNAME and ASNAME   >>  << 8156>>04320000
            << arrays.                                     >>  << 8156>>04325000
               I := 0;                                         << 8156>>04330000
               IF PARMNUM = NUMPARMS                           << 8156>>04335000
                  THEN CIERR(ERRNUM:=EXPTUSERSPEC, PARMPTR);   << 8156>>04340000
               PARMNUM := PARMNUM + 1;                         << 8156>>04345000
               @PARMPTR := PARMADDR;                           << 8156>>04350000
                                                               << 8156>>04355000
               MOVE USNAME := "        ";                      << 8156>>04360000
               MOVE ASNAME := "        ";                      << 8156>>04365000
               MOVE USERDELIMS := ".,;=  ";                    << 8156>>04370000
               USERDELIMS(4) := %15;  << Carriage Return >>    << 8156>>04375000
               MYCOMMAND(PARMPTR,USERDELIMS,MAXUSERSPECPARMS,  << 8156>>04380000
                         NUMUSERSPECPARMS,USERPARMS );         << 8156>>04385000
               @PARMPTR := USERP1ADDR;                         << 8156>>04390000
               IF SPECIALSINP1   LOR                           << 8156>>04395000
                  ( NOT ( 1 <= USERP1LEN <= 8 ))  THEN         << 8156>>04400000
               BEGIN                                           << 8156>>04405000
                  CIERR( ERRNUM := BADUSERSPEC, PARMPTR );     << 8156>>04410000
                  RETURN;                                      << 8156>>04415000
               END                                             << 8156>>04420000
               ELSE MOVE USNAME := PARMPTR, (USERP1LEN);       << 8156>>04425000
                                                               << 8156>>04430000
               IF USERP1DELIMDOT THEN                          << 8156>>04435000
               BEGIN    << Expect an account name. >>          << 8156>>04440000
                  @PARMPTR := USERP2ADDR;                      << 8156>>04445000
                  IF SPECIALSINP2   LOR                        << 8156>>04450000
                     ( NOT ( 1 <= USERP2LEN <= 8 )) THEN       << 8156>>04455000
                  BEGIN                                        << 8156>>04460000
                     CIERR( ERRNUM:=BADUSERSPEC,PARMPTR );     << 8156>>04465000
                     RETURN;                                   << 8156>>04470000
                  END                                          << 8156>>04475000
                  ELSE MOVE ASNAME := PARMPTR,(USERP2LEN);     << 8156>>04480000
               END                                             << 8156>>04485000
               ELSE IF BADP1DELIM THEN                         << 8156>>04490000
               BEGIN                                           << 8156>>04495000
                  CIERR( ERRNUM := BADUSERSPEC, PARMPTR );     << 8156>>04500000
                  GOTO OUTLOOP;                                << 8156>>04505000
               END                                             << 8156>>04510000
               ELSE MOVE ASNAME := ANAME, (8);                 << 8156>>04515000
                                                               << 8156>>04520000
            << Check for appropriate capabilities.      >>     << 8156>>04525000
               PXGLOBAL;                                       << 8156>>04530000
               @UCAPPTR := @PXG'USERATTRIBUTES;                << 8156>>04535000
               IF (ASNAME <> ANAME, (8)) LAND (UCAPSM=0)       << 8156>>04540000
                  THEN CIERR(ERRNUM:=NEEDSMCAP2, PARMPTR)      << 8156>>04545000
                  ELSE MOVE ANAME := ASNAME, (8);              << 8156>>04550000
               IF (USNAME <> UNAME, (8)) LAND (UCAPAM=0)       << 8156>>04555000
                  THEN CIERR(ERRNUM:=NEEDAMCAP2, PARMPTR)      << 8156>>04560000
                  ELSE MOVE UNAME := USNAME, (8);              << 8156>>04565000
                                                               << 8156>>04570000
               END;                                            << 8156>>04575000
                                                               << 8156>>04580000
               IF NOT (NOERRORS) THEN RETURN;                  << 8156>>04585000
                                                               << 8156>>04590000
            END;  << USER case. >>                             << 8156>>04595000
                                                               << 8156>>04600000
         END; << CASE >>                                       <<00884>>04605000
      PARMNUM := PARMNUM + 1;                                  <<00884>>04610000
                                                               << 8156>>04615000
OUTLOOP:                                                       << 8156>>04620000
                                                               << 8156>>04625000
      END; << WHILE >>                                         <<00884>>04630000
                                                               <<00884>>04635000
   IF ACCOUNT AND SYSTEM THEN                                  <<00884>>04640000
      CIERR(ERRNUM := NOBOTHSYSACC);                           <<00884>>04645000
                                                               << 8156>>04650000
   IF USERSPECD LAND (ACCOUNT LOR SYSTEM)                      << 8156>>04655000
      THEN CIERR( ERRNUM := NOUSERANDOTHER );                  << 8156>>04660000
                                                               << 8156>>04665000
   END; << PARSEXTRAPARMS >>                                   <<00884>>04670000
                                                               <<00884>>04675000
<<***********************************************************>><<03734>>04680000
<<  OPENCOMFILE                                              >><<03734>>04685000
<<     Opens and locks COMMAND.PUB.SYS.                      >><<03734>>04690000
<<***********************************************************>><<03734>>04695000
SUBROUTINE OPENCOMFILE;                                        <<03734>>04700000
   BEGIN                                                       <<03734>>04705000
                                                               <<03734>>04710000
   MOVE REC := "COMMAND.PUB.SYS ";                             <<03734>>04715000
   COMFN := FOPEN( REC, 1, %346 );  << Old, Share, Lock, Xeq >><<03734>>04720000
   IF <> THEN COMFILE'ERR( COMOPENFAIL )                       <<03734>>04725000
   ELSE                                                        <<03734>>04730000
   BEGIN                                                       <<03734>>04735000
      OLDCRIT := SETCRITICAL;                                  <<04810>>04740000
      FLOCK( COMFN, TRUE );                                    <<03734>>04745000
      IF <> THEN COMFILE'ERR( COMLOCKFAIL );                   <<03734>>04750000
   END;                                                        <<03734>>04755000
                                                               <<03734>>04760000
END;  << OPENCOMFILE >>                                        <<03734>>04765000
                                                               <<03734>>04770000
                                                               <<03734>>04775000
                                                               <<03734>>04780000
<<***********************************************************>><<03734>>04785000
<<  CLOSECOMFILE                                             >><<03734>>04790000
<<     Unlocks and closes COMMAND.PUB.SYS.                   >><<03734>>04795000
<<***********************************************************>><<03734>>04800000
SUBROUTINE CLOSECOMFILE;                                       <<03734>>04805000
   BEGIN                                                       <<03734>>04810000
                                                               <<03734>>04815000
   FUNLOCK( COMFN );                                           <<03734>>04820000
   IF = THEN UNLOCKOK := TRUE                                  <<04810>>04825000
        ELSE UNLOCKOK := FALSE;                                <<04810>>04830000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>04835000
   IF NOT UNLOCKOK                                             <<04810>>04840000
      THEN COMFILE'ERR( COMUNLOCKFAIL )                        <<04810>>04845000
   ELSE  FCLOSE( COMFN, 0, 0 );                                <<03734>>04850000
                                                               <<03734>>04855000
END;  << CLOSECOMFILE >>                                       <<03734>>04860000
                                                               <<03734>>04865000
                                                               <<03734>>04870000
<<***********************************************************>><<00884>>04875000
<<  GETOLDUDCINFO                                            >><<00884>>04880000
<<    Opens and locks COMMAND.PUB.SYS.                       >><<03734>>04885000
<<    Saves UDC extra data segment number.                   >><<00884>>04890000
<<    Gets record number in Command file of current UDC's.   >><<00884>>04895000
<<***********************************************************>><<00884>>04900000
SUBROUTINE GETOLDUDCINFO;                                      <<00884>>04905000
   BEGIN                                                       <<00884>>04910000
      OLDDSTNO := UDCDSTNO;                                    <<04603>>04915000
      FINDCOMUSER(COMFN,UNAME,ANAME,OLDUDCSEXIST,OLDRECNO,DMY, <<00884>>04920000
                  ERRNO);                                      <<00884>>04925000
      IF ERRNO = NOSUCHCOMUSER THEN                            <<00884>>04930000
            << User not found in comfile, yet directory >>     <<00884>>04935000
            << indicates that UDC's exist.  Set exist    >>    <<00884>>04940000
            << flag so that directory will be updated.   >>    <<00884>>04945000
         OLDUDCSEXIST := FALSE                                 <<00884>>04950000
      ELSE                                                     <<00884>>04955000
         IF ERRNO <> 0 THEN  COMFILE'ERR(ERRNO)                <<00884>>04960000
         ELSE                                                  <<00884>>04965000
            BEGIN  << No errors >>                             <<00884>>04970000
            IF NOT OLDUDCSEXIST THEN                           <<00884>>04975000
               BEGIN                                           <<00884>>04980000
                  << Directory indicates no UDC's exist.    >> <<00884>>04985000
                  << Search comfile anyway since new comfile>> <<00884>>04990000
                  << may have been installed since last      >><<00884>>04995000
                  << directory update. >>                      <<00884>>05000000
               OLDRECNO := 1;  << Begin search at beginning >> <<00884>>05005000
               SEARCHCOMFILE(COMFN,UNAME,ANAME,OLDRECNO,,      <<00884>>05010000
                                                        ERRNO);<<00884>>05015000
               IF ERRNO <> 0 THEN                              <<00884>>05020000
                  IF ERRNO = EOFOUND THEN OLDRECNO := 0        <<00884>>05025000
                  ELSE COMFILE'ERR(ERRNO);                     <<00884>>05030000
               END;                                            <<00884>>05035000
            END;                                               <<00884>>05040000
                                                               <<03734>>05045000
   END;                                                        <<00884>>05050000
                                                               <<00884>>05055000
<<***********************************************************>><<00884>>05060000
<<  ENTERFILENAMES                                           >><<00884>>05065000
<<    Enters UDC file names into Command file.               >><<00884>>05070000
<<    Enters user and account names with pointer to file     >><<00884>>05075000
<<    names.                                                 >><<00884>>05080000
<<    Leaves 'RECNO' pointing to user and account names.     >><<00884>>05085000
<<***********************************************************>><<00884>>05090000
SUBROUTINE ENTERFILENAMES;                                     <<00884>>05095000
   BEGIN                                                       <<00884>>05100000
                                                               <<00884>>05105000
   RECNO := 0;                                                 <<00884>>05110000
   PARMNUM := LASTFILEPARM;                                    <<00884>>05115000
                                                               <<00884>>05120000
   DO BEGIN                                                    <<00884>>05125000
      IF PARMLEN > 0 THEN                                      <<00884>>05130000
         BEGIN                                                 <<00884>>05135000
         REC' := "  ";                                         <<00884>>05140000
         MOVE REC'(1) := REC',(COMRECSIZEM1);                  <<00884>>05145000
         @PARMPTR := PARMADDR;                                 <<00884>>05150000
         QUALIFYFILENAME(PARMPTR,REC(COMFNAME));               <<00884>>05155000
         REC'(COMENTRYTYPE) := COMFILEENTRY;                   <<00884>>05160000
         REC'(COMLINK) := RECNO;                               <<00884>>05165000
         RECNO := GETREC;                                      <<00884>>05170000
         IF NOERRORS THEN                                      <<00884>>05175000
            BEGIN                                              <<00884>>05180000
            FWRITEDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNO));    <<00884>>05185000
            IF <> THEN                                         <<00884>>05190000
               BEGIN                                           <<00884>>05195000
               RELEASERECS(RECNO);                             <<00884>>05200000
               COMFILE'ERR(COMWRITEFAIL);                      <<00884>>05205000
               END;                                            <<00884>>05210000
            END;                                               <<00884>>05215000
         END;                                                  <<00884>>05220000
      PARMNUM := PARMNUM - 1;                                  <<00884>>05225000
      END                                                      <<00884>>05230000
   UNTIL (PARMNUM = -1) OR (ERRNUM > 0);                       <<00884>>05235000
                                                               <<00884>>05240000
   IF NOERRORS THEN                                            <<00884>>05245000
      BEGIN << Add entry with user and acct pointing to files>><<00884>>05250000
      REC' := "  ";                                            <<00884>>05255000
      MOVE REC'(1) := REC',(COMRECSIZEM1);                     <<00884>>05260000
      REC'(COMENTRYTYPE) := COMUSERENTRY;                      <<00884>>05265000
      MOVE REC(COMUNAME) := UNAME,(8);                         <<00884>>05270000
      MOVE REC(COMANAME) := ANAME,(8);                         <<00884>>05275000
      REC'(COMLINK) := RECNO;                                  <<00884>>05280000
      RECNO := GETREC;                                         <<00884>>05285000
      IF NOERRORS THEN                                         <<00884>>05290000
         BEGIN                                                 <<00884>>05295000
         FWRITEDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNO));       <<00884>>05300000
         IF <> THEN                                            <<00884>>05305000
            BEGIN                                              <<00884>>05310000
            RELEASERECS(RECNO);                                <<00884>>05315000
            COMFILE'ERR(COMWRITEFAIL);                         <<00884>>05320000
            END;                                               <<00884>>05325000
         END;                                                  <<00884>>05330000
      END;                                                     <<00884>>05335000
                                                               <<00884>>05340000
   END; << ENTERFILENAMES >>                                   <<00884>>05345000
                                                               <<00884>>05350000
<<***********************************************************>><<00884>>05355000
<<  INITNEWUDCS                                              >><<00884>>05360000
<<    Updates directory to point to new UDC's.               >><<00884>>05365000
<<    Calls INITUDCNO to process and activate new UDC's.     >><<00884>>05370000
<<    Restores old UDC's if an error occurs.                 >><<00884>>05375000
<<***********************************************************>><<00884>>05380000
SUBROUTINE INITNEWUDCS;                                        <<00884>>05385000
   BEGIN                                                       <<00884>>05390000
   UDCSEXIST := TRUE;                                          <<00884>>05395000
   UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);                  <<00884>>05400000
   FCONTROL(COMFN,2,DMY);  << Write out buffers >>             <<00884>>05405000
                                                               << 8156>>05410000
<< If the ;USER= keyword was specified, all that needs to  >>  << 8156>>05415000
<< be done here is to update the directory for the user.   >>  << 8156>>05420000
<< Since this is now done, we may return.  UDCs are not    >>  << 8156>>05425000
<< set up when ;USER= was specified.                       >>  << 8156>>05430000
   IF USERSPECD THEN RETURN;                                   << 8156>>05435000
                                                               << 8156>>05440000
   UDCDSTNO := 0;                                              <<04603>>05445000
   INITUDCNO( SHOW, COMFN );                                   <<03734>>05450000
   IF INTEGER(UDCDSTNO) <= 0 THEN                              <<04846>>05455000
      BEGIN  << Error occured. Restore old UDC's >>            <<00884>>05460000
                                                               <<04846>>05465000
   << Handle the case of problems with FGETLOCKWORD.    >>     <<04846>>05470000
      IF INTEGER(UDCDSTNO) < 0 THEN                            <<04846>>05475000
      BEGIN                                                    <<04846>>05480000
         CIERR( ERRNUM := LOCKWORDERR );                       <<04846>>05485000
      END;                                                     <<04846>>05490000
                                                               <<04846>>05495000
      UDCDSTNO := OLDDSTNO;                                    <<04603>>05500000
      UDCDIRCWRITE(UNAME,ANAME,OLDUDCSEXIST,OLDRECNO);         <<00884>>05505000
      RELEASERECS(RECNO);                                      <<00884>>05510000
      ERRNUM := INITUDCFAILED;                                 <<00884>>05515000
      END;                                                     <<00884>>05520000
   END;  << INITNEWUDCS >>                                     <<00884>>05525000
                                                               <<00884>>05530000
<<***********************************************************>><<00884>>05535000
<<  CLOSEOLDUDCS                                             >><<00884>>05540000
<<    Closes previous UDC files (if any).                    >><<00884>>05545000
<<    Releases UDC extra data segment.                       >><<00884>>05550000
<<    Updates directory Command file pointer.                >><<00884>>05555000
<<    Flags old UDC information as invalid. (In case in UDC) >><<00884>>05560000
<<    Removes previous file names from Command file.         >><<00884>>05565000
<<***********************************************************>><<00884>>05570000
SUBROUTINE CLOSEOLDUDCS;                                       <<00884>>05575000
   BEGIN                                                       <<00884>>05580000
                                                               << 8156>>05585000
<< If the ;USER= keyword was specified, do not change the  >>  << 8156>>05590000
<< current user's UDC setup.  Return the old COMMAND file  >>  << 8156>>05595000
<< records to the free list.  Note that if no new UDCs     >>  << 8156>>05600000
<< exist, the specified user's directory entry is updated  >>  << 8156>>05605000
<< here to indicate that that user has no UDCs.            >>  << 8156>>05610000
   IF USERSPECD THEN                                           << 8156>>05615000
   BEGIN                                                       << 8156>>05620000
      RELEASERECS( OLDRECNO );                                 << 8156>>05625000
      IF NOT NEWUDCFILES THEN                                  << 8156>>05630000
      BEGIN                                                    << 8156>>05635000
         UDCSEXIST := FALSE;                                   << 8156>>05640000
         UDCDIRCWRITE( UNAME, ANAME, UDCSEXIST, NIL );         << 8156>>05645000
      END;                                                     << 8156>>05650000
      RETURN;                                                  << 8156>>05655000
   END;                                                        << 8156>>05660000
                                                               << 8156>>05665000
   IF OLDDSTNO > 0 THEN                                        <<00884>>05670000
      BEGIN                                                    <<00884>>05675000
      CLOSEUDC(OLDDSTNO);                                      <<00884>>05680000
      RELDATASEG(OLDDSTNO);                                    <<00884>>05685000
      END;                                                     <<00884>>05690000
   IF NOT NEWUDCFILES THEN                                     <<00884>>05695000
      BEGIN  << No new UDC's to be activated. >>               <<00884>>05700000
      UDCDSTNO := 0;                                           <<04603>>05705000
      UDCSEXIST := FALSE;                                      <<00884>>05710000
      UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,NIL);                 <<00884>>05715000
         << Must reinit in case UDC's exist at other levels. >><<00884>>05720000
      INITUDCNO( FALSE, COMFN );                               <<03734>>05725000
      END;                                                     <<00884>>05730000
   CIS'UDCFLUSH := TRUE;  << FLAG OLD UDC INFO INVALID >>      <<04603>>05735000
   RELEASERECS(OLDRECNO);                                      <<00884>>05740000
                                                               <<03734>>05745000
   END; << CLOSEOLDUDCS >>                                     <<00884>>05750000
                                                               <<00884>>05755000
<<*************************>>                                  <<00884>>05760000
<<  Main Procedure Body    >>                                  <<00884>>05765000
<<*************************>>                                  <<00884>>05770000
                                                               <<00884>>05775000
USERSPECD := FALSE;                                            << 8156>>05780000
PARSEUDCFILENAMES;                                             <<00884>>05785000
IF NOERRORS THEN                                               <<00884>>05790000
   BEGIN                                                       <<00884>>05795000
   PARSEXTRAPARMS;                                             <<00884>>05800000
   IF NOERRORS THEN                                            <<00884>>05805000
      BEGIN                                                    <<00884>>05810000
      OPENCOMFILE;                                             <<03734>>05815000
      GETOLDUDCINFO;                                           <<00884>>05820000
      IF NOERRORS THEN                                         <<00884>>05825000
         IF NEWUDCFILES THEN                                   <<00884>>05830000
            BEGIN                                              <<00884>>05835000
            ENTERFILENAMES;                                    <<00884>>05840000
            IF NOERRORS THEN                                   <<00884>>05845000
               BEGIN                                           <<00884>>05850000
               INITNEWUDCS;                                    <<00884>>05855000
               IF NOERRORS THEN                                <<00884>>05860000
                  CLOSEOLDUDCS;                                <<00884>>05865000
               END;                                            <<00884>>05870000
            END                                                <<00884>>05875000
         ELSE                                                  <<00884>>05880000
            CLOSEOLDUDCS;                                      <<00884>>05885000
      CLOSECOMFILE;                                            <<03734>>05890000
      END;                                                     <<00884>>05895000
   END;                                                        <<00884>>05900000
                                                               <<00884>>05905000
END; << CXSETCATALOG >>                                        <<00884>>05910000
$PAGE "SHOWCOMF:  Shows the UDC files for the specified user." << 8156>>05915000
LOGICAL PROCEDURE SHOWCOMF( UNAME, ANAME, COMF, LISTF );       << 8156>>05920000
   VALUE COMF, LISTF;                                          << 8156>>05925000
   BYTE ARRAY UNAME, ANAME;                                    << 8156>>05930000
   INTEGER COMF, LISTF;                                        << 8156>>05935000
OPTION PRIVILEGED, UNCALLABLE;                                 << 8156>>05940000
BEGIN                                                          << 8156>>05945000
                                                               << 8156>>05950000
<<*********************************************************>>  << 8156>>05955000
<<                                                         >>  << 8156>>05960000
<< This procedure looks in COMMAND.PUB.SYS (file COMF) for >>  << 8156>>05965000
<< a user entry associated with UNAME and ANAME.  If an    >>  << 8156>>05970000
<< entry exists, SHOWCOMF returns TRUE and will print the  >>  << 8156>>05975000
<< file names (stripped of lockwords) to the file LISTF    >>  << 8156>>05980000
<< (if LISTF = 0 or 2, the listing will go to $STDLIST).   >>  << 8156>>05985000
<< If no associated user entry is found, SHOWCOMF will     >>  << 8156>>05990000
<< return a false.  Other than the printing of the file    >>  << 8156>>05995000
<< names, this procedure will do no printing and will do   >>  << 8156>>06000000
<< no error checking.  This procedure is used primarily    >>  << 8156>>06005000
<< :SHOWCATALOG when the ;USER= keyword is specified.      >>  << 8156>>06010000
<<                                                         >>  << 8156>>06015000
<< Jon Cohen                                    8/13/83    >>  << 8156>>06020000
<<                                                         >>  << 8156>>06025000
<<*********************************************************>>  << 8156>>06030000
                                                               << 8156>>06035000
LOGICAL ARRAY LBUF(0:36);                                      << 8156>>06040000
BYTE    ARRAY BBUF(*) = LBUF;                                  << 8156>>06045000
                                                               << 8156>>06050000
LOGICAL ARRAY REC'(0:19);                                      << 8156>>06055000
BYTE    ARRAY REC(*) = REC';                                   << 8156>>06060000
                                                               << 8156>>06065000
BYTE    POINTER PTR,                                           << 8156>>06070000
                SPTR;                                          << 8156>>06075000
                                                               << 8156>>06080000
LOGICAL       UDCSEXIST;       << TRUE if UDCs found.      >>  << 8156>>06085000
                                                               << 8156>>06090000
INTEGER       RECNO,                                           << 8156>>06095000
              DUM,             << Dummy variable.          >>  << 8156>>06100000
              ERR,             << For FINDCOMUSER call.    >>  << 8156>>06105000
              LISTFN;          << Local LISTF copy.        >>  << 8156>>06110000
                                                               << 8156>>06115000
INTRINSIC     FREADDIR,                                        << 8156>>06120000
              FWRITE;                                          << 8156>>06125000
                                                               << 8156>>06130000
                                                               << 8156>>06135000
                                                               << 8156>>06140000
SUBROUTINE VISITENTRY;                                         << 8156>>06145000
BEGIN                                                          << 8156>>06150000
                                                               << 8156>>06155000
<< This subroutine is used for the printing of the file    >>  << 8156>>06160000
<< name to the specified list file.                        >>  << 8156>>06165000
                                                               << 8156>>06170000
<< Clear the buffer.                                       >>  << 8156>>06175000
   BBUF := " ";                                                << 8156>>06180000
   MOVE BBUF(1) := BBUF, (71);                                 << 8156>>06185000
                                                               << 8156>>06190000
<< Copy the file name into the buffer.  Strip out a lock-  >>  << 8156>>06195000
<< word if present.                                        >>  << 8156>>06200000
   MOVE BBUF(5) := REC(COMFNAME), (36);                        << 8156>>06205000
   SCAN BBUF(5) UNTIL "/.", 1;                                 << 8156>>06210000
   IF CARRY THEN   << Found a "/". >>                          << 8156>>06215000
   BEGIN                                                       << 8156>>06220000
      @PTR := TOS;                                             << 8156>>06225000
      MOVE PTR(1) := PTR(1) WHILE AN, 1;                       << 8156>>06230000
      @SPTR := TOS;                                            << 8156>>06235000
      MOVE PTR := SPTR, (19);                                  << 8156>>06240000
   END                                                         << 8156>>06245000
   ELSE   DEL;                                                 << 8156>>06250000
                                                               << 8156>>06255000
<< Print the record to the list file.                      >>  << 8156>>06260000
   FWRITE( LISTFN, LBUF, 18, 0 );                              << 8156>>06265000
                                                               << 8156>>06270000
END;  << VISITENTRY >>                                         << 8156>>06275000
                                                               << 8156>>06280000
                                                               << 8156>>06285000
                                                               << 8156>>06290000
<< Start of main code for SHOWCOMF.                        >>  << 8156>>06295000
                                                               << 8156>>06300000
<< Resolve the list file.                                  >>  << 8156>>06305000
   IF LISTF = 0                                                << 8156>>06310000
      THEN LISTFN := 2                                         << 8156>>06315000
      ELSE LISTFN := LISTF;                                    << 8156>>06320000
                                                               << 8156>>06325000
<< First, try to find a user entry in COMMAND.PUB.SYS for  >>  << 8156>>06330000
<< this user.                                              >>  << 8156>>06335000
   ERR := 0;                                                   << 8156>>06340000
   UDCSEXIST := TRUE;   << Assume so, for now.  This will  >>  << 8156>>06345000
                        << be varified by the following    >>  << 8156>>06350000
                        << procedure call.                 >>  << 8156>>06355000
   FINDCOMUSER( COMF,UNAME,ANAME,UDCSEXIST,RECNO,DUM,ERR );    << 8156>>06360000
   IF (NOT UDCSEXIST) LOR (ERR = NOSUCHCOMUSER) THEN           << 8156>>06365000
   BEGIN                                                       << 8156>>06370000
      SHOWCOMF := FALSE;                                       << 8156>>06375000
      RETURN;                                                  << 8156>>06380000
   END                                                         << 8156>>06385000
   ELSE  SHOWCOMF := TRUE;                                     << 8156>>06390000
                                                               << 8156>>06395000
<< A user entry has been found.  Search down the list of   >>  << 8156>>06400000
<< UDC file entries associated with this user.             >>  << 8156>>06405000
   FREADDIR( COMF, REC', COMRECSIZE, DOUBLE(RECNO) );          << 8156>>06410000
   RECNO := REC'(COMLINK);  << Pointer to first file entry >>  << 8156>>06415000
                                                               << 8156>>06420000
   WHILE RECNO <> 0 DO                                         << 8156>>06425000
   BEGIN                                                       << 8156>>06430000
      FREADDIR( COMF, REC', COMRECSIZE, DOUBLE(RECNO) );       << 8156>>06435000
      VISITENTRY;                                              << 8156>>06440000
      RECNO := REC'(COMLINK);                                  << 8156>>06445000
   END;                                                        << 8156>>06450000
                                                               << 8156>>06455000
<< A blank line for to make it pretty.                    >>   << 8156>>06460000
   FWRITE( LISTFN, LBUF, 0, 0 );                               << 8156>>06465000
                                                               << 8156>>06470000
END;  << SHOWCOMF >>                                           << 8156>>06475000
$TITLE "CXSHOWCATALOG"                                                  06480000
PROCEDURE CXSHOWCATALOG(PARMSP,ERRNUM,PARMNUM);                         06485000
   BYTE ARRAY PARMSP;                                                   06490000
   INTEGER ERRNUM,PARMNUM;                                              06495000
   OPTION UNCALLABLE;                                                   06500000
<<*********************************************************>>  << 8156>>06505000
<<                                                         >>  << 8156>>06510000
<< SHOWCATALOG was enhanced to have the following syntax:  >>  << 8156>>06515000
<<                                                         >>  << 8156>>06520000
<<     :SHOWCATALOG [[LISTFILE] [;USER=<user>[.<acct>]]]   >>  << 8156>>06525000
<<                                                         >>  << 8156>>06530000
<< Where <user> and <acct> are less than eight characters  >>  << 8156>>06535000
<< long and contain only alphanumerics (first character    >>  << 8156>>06540000
<< alpha).  If present, the UDC files used by the that     >>  << 8156>>06545000
<< user are listed to the listfile on all levels (i.e.     >>  << 8156>>06550000
<< user, account, and system).  If <user> = "@", then only >>  << 8156>>06555000
<< the account level UDC files are listed.  If both <user> >>  << 8156>>06560000
<< and <acct> = "@", then only the system level UDC files  >>  << 8156>>06565000
<< are listed.  If the USER keyword is not specified, then >>  << 8156>>06570000
<< the caller's UDC files are listed and formatted.        >>  << 8156>>06575000
<<                                                         >>  << 8156>>06580000
<<                                                         >>  << 8156>>06585000
<< Jon Cohen                                     8/13/83   >>  << 8156>>06590000
<<                                                         >>  << 8156>>06595000
<<*********************************************************>>  << 8156>>06600000
                                                               << 8156>>06605000
BEGIN                                                                   06610000
                                                                        06615000
INTEGER                                                                 06620000
   LEN,                                                                 06625000
   OFFSET,                                                              06630000
   ENTRYLEN,                                                            06635000
   LASTFN,                                                              06640000
   BLEN,                                                                06645000
   PLEN,                                                                06650000
   LISTFN;                                                              06655000
                                                                        06660000
BYTE POINTER                                                            06665000
   PARMPTR,                                                             06670000
   ENDIMAGE;                                                            06675000
                                                                        06680000
LOGICAL                                                                 06685000
   SETLIST;                                                             06690000
                                                                        06695000
BYTE ARRAY DEV(0:2);                                                    06700000
                                                                        06705000
ARRAY DIR'(0:DIRMAXENTRYSIZE); BYTE ARRAY DIR(*) = DIR';                06710000
ARRAY BUFF'(0:14);BYTE ARRAY BUFF(*)=BUFF';                    <<00416>>06715000
                                                               << 8156>>06720000
<< The following declarations are used for command parse.  >>  << 8156>>06725000
   DEFINE                                                      << 8156>>06730000
      DELIMDEF     = [8/";",8/"=",8/".",8/%15]D #;             << 8156>>06735000
                                                               << 8156>>06740000
   EQUATE                                                      << 8156>>06745000
      MAXSHOWPARMS      = 5,  << Actually one more than    >>  << 8156>>06750000
                              << the worse case.           >>  << 8156>>06755000
      SEMI              = 0,  << These are the delimiter   >>  << 8156>>06760000
      EQUALS            = 1,  << returned by MYCOMMAND.    >>  << 8156>>06765000
      DOT               = 2,                                   << 8156>>06770000
      CR                = 3;                                   << 8156>>06775000
                                                               << 8156>>06780000
   DOUBLE                                                      << 8156>>06785000
      DELIMS'D := DELIMDEF;                                    << 8156>>06790000
   BYTE ARRAY                                                  << 8156>>06795000
      DELIMS(*) = DELIMS'D;                                    << 8156>>06800000
                                                               << 8156>>06805000
   INTEGER                                                     << 8156>>06810000
      NUMPARMS;                                                << 8156>>06815000
                                                               << 8156>>06820000
   DOUBLE ARRAY                                                << 8156>>06825000
      PARMS(0:MAXSHOWPARMS-1);                                 << 8156>>06830000
   INTEGER ARRAY                                               << 8156>>06835000
      IPARMS(*) = PARMS;                                       << 8156>>06840000
                                                               << 8156>>06845000
   DEFINE                                                      << 8156>>06850000
      P1ADDR        = IPARMS #,                                << 8156>>06855000
      P1LEN         = IPARMS(1).(0:8) #,                       << 8156>>06860000
      P1DELIM       = IPARMS(1).(11:5) #,                      << 8156>>06865000
      P1SPECIALS    = ( IPARMS(1).(10:1) = 1 ) #,              << 8156>>06870000
      P2ADDR        = IPARMS(2) #,                             << 8156>>06875000
      P2LEN         = IPARMS(3).(0:8) #,                       << 8156>>06880000
      P2DELIM       = IPARMS(3).(11:5) #,                      << 8156>>06885000
      P2SPECIALS    = ( IPARMS(3).(10:1) = 1 ) #,              << 8156>>06890000
      P3ADDR        = IPARMS(4) #,                             << 8156>>06895000
      P3LEN         = IPARMS(5).(0:8) #,                       << 8156>>06900000
      P3DELIM       = IPARMS(5).(11:5) #,                      << 8156>>06905000
      P3SPECIALS    = ( IPARMS(5).(10:1) = 1 ) #,              << 8156>>06910000
      P4ADDR        = IPARMS(6) #,                             << 8156>>06915000
      P4LEN         = IPARMS(7).(0:8) #,                       << 8156>>06920000
      P4DELIM       = IPARMS(7).(11:5) #,                      << 8156>>06925000
      P4SPECIALS    = ( IPARMS(7).(10:1) = 1 ) #;              << 8156>>06930000
                                                               << 8156>>06935000
   BYTE ARRAY                                                  << 8156>>06940000
      UNAME(0:8),           << For user specified name.    >>  << 8156>>06945000
      ANAME(0:8),                                              << 8156>>06950000
      CALLERUSER(0:8),      << From WHO, for comparison.   >>  << 8156>>06955000
      CALLERACCT(0:8);                                         << 8156>>06960000
                                                               << 8156>>06965000
   INTRINSIC   WHO, MYCOMMAND;                                 << 8156>>06970000
                                                               << 8156>>06975000
   BYTE                                                        << 8156>>06980000
      SAVEBYTE;         << Temporary storage.              >>  << 8156>>06985000
                                                               << 8156>>06990000
   LOGICAL                                                     << 8156>>06995000
      WILDUSER := FALSE,   << Signals which parts of the   >>  << 8156>>07000000
      WILDACCT := FALSE;   << ;USER parameter were "@".    >>  << 8156>>07005000
                                                               << 8156>>07010000
   BYTE ARRAY                                                  << 8156>>07015000
      COMNAME(0:23);       << For opening COMMAND.PUB.SYS. >>  << 8156>>07020000
                                                               << 8156>>07025000
   INTEGER                                                     << 8156>>07030000
      COMF;                                                    << 8156>>07035000
                                                               << 8156>>07040000
   ARRAY QARRAY(*) = Q+0;  << These declarations are for   >>  << 8156>>07045000
   INTEGER PCBGLOBLOC;     << referencing the PXGLOBAL     >>  << 8156>>07050000
   POINTER UCAPPTR;        << area for the capability      >>  << 8156>>07055000
                           << checks.                      >>  << 8156>>07060000
                                                               << 8156>>07065000
                                                                        07070000
SUBROUTINE DEF'MOVEFROMDSEG;                                            07075000
                                                                        07080000
SUBROUTINE WARN(ERRN,SPTR);                                             07085000
   VALUE ERRN; INTEGER ERRN;                                            07090000
   BYTE ARRAY SPTR;                                                     07095000
BEGIN                                                                   07100000
   ERROR( -ERRN, IMAGERR, SPTR, PARMSP(-11) );                 <<01360>>07105000
END; << WARN >>                                                         07110000
                                                                        07115000
SUBROUTINE ERR(ERRN);                                                   07120000
   VALUE ERRN; INTEGER ERRN;                                            07125000
BEGIN                                                                   07130000
   ERROR(ERRN,UDCFERR,LISTFN,PARMPTR);                                  07135000
   GO OUTL;                                                             07140000
END; << ERR >>                                                          07145000
                                                                        07150000
                                                                        07155000
   << CXSHOWCATALOG MAIN BODY >>                                        07160000
                                                                        07165000
<< Initialize this procedure and parse the user specified  >>  << 8156>>07170000
<< parameters.                                             >>  << 8156>>07175000
   CALLERUSER := " ";                                          << 8156>>07180000
   MOVE CALLERUSER(1) := CALLERUSER, (8);                      << 8156>>07185000
   MOVE CALLERACCT := CALLERUSER, (9);                         << 8156>>07190000
   MOVE UNAME := CALLERUSER, (9);                              << 8156>>07195000
   MOVE ANAME := CALLERACCT, (9);                              << 8156>>07200000
   WHO( , , , CALLERUSER, , CALLERACCT );                      << 8156>>07205000
   LISTFN := 0;                                                << 8156>>07210000
   MYCOMMAND(PARMSP,DELIMS,MAXSHOWPARMS,NUMPARMS,PARMS);       << 8156>>07215000
                                                               << 8156>>07220000
<< First parameter, if there, is a list file.  Open it.    >>  << 8156>>07225000
   IF  (NUMPARMS=0)          << No parameters where there. >>  << 8156>>07230000
       LOR                                                     << 8156>>07235000
       (P1LEN = 0 )          << First parameter ommitted.  >>  << 8156>>07240000
      THEN                                                     << 9087>>07245000
      BEGIN                                                    << 9087>>07250000
      SETLIST := FALSE;      << no listfile specified >>       << 9087>>07255000
      LISTFN := FOPEN(,%14,1);  <<  $stdlist          >>       << 9087>>07260000
      IF <> THEN ERR (SHOWCATLISTOPENF);                       << 9087>>07265000
      END                                                      << 9087>>07270000
   ELSE                                                        << 9087>>07275000
      BEGIN                                                    << 9087>>07280000
      SETLIST := TRUE;      << listfile specified     >>       << 9087>>07285000
   @PARMPTR := P1ADDR;                                         << 8156>>07290000
   SAVEBYTE := PARMPTR( P1LEN );                               << 8156>>07295000
   PARMPTR( P1LEN ) := 0;    << Delimiter for FOPEN.       >>  << 8156>>07300000
   MOVE DEV := "LP ";                                          << 8156>>07305000
   LISTFN := FOPEN (PARMPTR,%4,                                << 9087>>07310000
                    1, , DEV                               );  << 8156>>07315000
   IF <> THEN ERR( SHOWCATLISTOPENF );                         << 8156>>07320000
   PARMPTR( P1LEN ) := SAVEBYTE;                               << 8156>>07325000
      END;                                                     << 9087>>07330000
                                                               << 8156>>07335000
<< Next handle the specification of the ;USER= keyword.    >>  << 8156>>07340000
<< Note that this is handled and the procedure returns if  >>  << 8156>>07345000
<< "USER" is found.  Otherwise, program control is         >>  << 8156>>07350000
<< resumed at the original CXSHOWCATALOG code that formats >>  << 8156>>07355000
<< the user's UDC DST.                                     >>  << 8156>>07360000
   IF NUMPARMS > 1 THEN    << Something was there.  Look.  >>  << 8156>>07365000
   BEGIN                                                       << 8156>>07370000
                                                               << 8156>>07375000
      @PARMPTR := P2ADDR;                                      << 8156>>07380000
      IF ( P1DELIM <> SEMI )      LOR                          << 8156>>07385000
         ( P2LEN <> 4 )           LOR                          << 8156>>07390000
         ( PARMPTR <> "USER" )    LOR                          << 8156>>07395000
         ( P2DELIM <> EQUALS )    LOR                          << 8156>>07400000
         ( NOT (3<=NUMPARMS<=4) ) THEN                         << 8156>>07405000
      BEGIN                                                    << 8156>>07410000
         CIERR( ERRNUM := BADSHOWSYN, PARMPTR );               << 8156>>07415000
         GOTO OUTL;                                            << 8156>>07420000
      END;                                                     << 8156>>07425000
                                                               << 8156>>07430000
      @PARMPTR := P3ADDR;                                      << 8156>>07435000
      IF NOT ( 1 <= P3LEN <= 8 )   THEN                        << 8156>>07440000
      BEGIN                                                    << 8156>>07445000
         CIERR( ERRNUM := BADSHOWUSERSPEC, PARMPTR );          << 8156>>07450000
         GOTO OUTL;                                            << 8156>>07455000
      END;                                                     << 8156>>07460000
                                                               << 8156>>07465000
      IF ( P3LEN = 1 ) LAND ( PARMPTR = "@" )                  << 8156>>07470000
         THEN  WILDUSER := TRUE                                << 8156>>07475000
      ELSE IF P3SPECIALS THEN                                  << 8156>>07480000
      BEGIN                                                    << 8156>>07485000
         CIERR( ERRNUM := BADSHOWUSERSPEC, PARMPTR );          << 8156>>07490000
         GOTO OUTL;                                            << 8156>>07495000
      END;                                                     << 8156>>07500000
      MOVE UNAME := PARMPTR, (P3LEN);                          << 8156>>07505000
                                                               << 8156>>07510000
      IF NUMPARMS = 3   << Acct not spec'd.  Use caller's. >>  << 8156>>07515000
         THEN MOVE ANAME := CALLERACCT, (9)                    << 8156>>07520000
      ELSE                                                     << 8156>>07525000
      BEGIN                                                    << 8156>>07530000
                                                               << 8156>>07535000
      << Another parameter is specified.  It should be the >>  << 8156>>07540000
      << account specification in the ;USER parameter.     >>  << 8156>>07545000
         @PARMPTR := P4ADDR;                                   << 8156>>07550000
         IF ( P3DELIM <> DOT )       LOR                       << 8156>>07555000
            ( NOT (1<=P4LEN<=8) )    THEN                      << 8156>>07560000
         BEGIN                                                 << 8156>>07565000
            CIERR( ERRNUM := BADSHOWUSERSPEC, PARMPTR );       << 8156>>07570000
            GOTO OUTL;                                         << 8156>>07575000
         END;                                                  << 8156>>07580000
                                                               << 8156>>07585000
         IF ( P4LEN = 1 ) LAND ( PARMPTR = "@" )               << 8156>>07590000
            THEN WILDACCT := TRUE                              << 8156>>07595000
         ELSE IF P4SPECIALS THEN                               << 8156>>07600000
         BEGIN                                                 << 8156>>07605000
            CIERR( ERRNUM := BADSHOWUSERSPEC, PARMPTR );       << 8156>>07610000
            GOTO OUTL;                                         << 8156>>07615000
         END;                                                  << 8156>>07620000
         MOVE ANAME := PARMPTR, (P4LEN);                       << 8156>>07625000
                                                               << 8156>>07630000
         IF WILDACCT LAND (NOT WILDUSER) THEN                  << 8156>>07635000
         BEGIN                                                 << 8156>>07640000
            CIERR( ERRNUM := SHOWUSERDOTAT, PARMPTR );         << 8156>>07645000
            GOTO OUTL;                                         << 8156>>07650000
         END;                                                  << 8156>>07655000
                                                               << 8156>>07660000
         IF NUMPARMS > 4                                       << 8156>>07665000
            THEN CIERR( ERRNUM := -TOOMANYSHOWPARMS,           << 8156>>07670000
                        PARMPTR );                             << 8156>>07675000
                                                               << 8156>>07680000
      END;  << Account specification >>                        << 8156>>07685000
                                                               << 8156>>07690000
   << The caller's capability needs to be checked if       >>  << 8156>>07695000
   << account or system UDCs were requested or if another  >>  << 8156>>07700000
   << user's UDCs were requested.  Note that a check for   >>  << 8156>>07705000
   << "<user>.@" has already been made.                    >>  << 8156>>07710000
      PXGLOBAL;                                                << 8156>>07715000
      @UCAPPTR := @PXG'USERATTRIBUTES;                         << 8156>>07720000
      IF CALLERACCT <> ANAME, (8)                              << 8156>>07725000
         THEN IF UCAPSM = 0 THEN                               << 8156>>07730000
         BEGIN                                                 << 8156>>07735000
            CIERR( ERRNUM := SHOWNEEDSSM );                    << 8156>>07740000
            GOTO OUTL;                                         << 8156>>07745000
         END;                                                  << 8156>>07750000
                                                               << 8156>>07755000
      IF CALLERUSER <> UNAME, (8)                              << 8156>>07760000
         THEN IF (UCAPAM=0) LAND (UCAPSM=0) THEN               << 8156>>07765000
         BEGIN                                                 << 8156>>07770000
            CIERR( ERRNUM := SHOWNEEDSAM );                    << 8156>>07775000
            GOTO OUTL;                                         << 8156>>07780000
         END;                                                  << 8156>>07785000
                                                               << 8156>>07790000
   << Having made it this far, no syntax errors have been  >>  << 8156>>07795000
   << found.  All that remains is to print out the         >>  << 8156>>07800000
   << requested information.                               >>  << 8156>>07805000
      MOVE COMNAME := "COMMAND.PUB.SYS  ";                     << 8156>>07810000
      COMF := FOPEN( COMNAME, 1, %346 );                       << 8156>>07815000
      IF <> THEN                                               << 8156>>07820000
      BEGIN                                                    << 8156>>07825000
         CIERR( ERRNUM := SHOWCOMOPENFAIL );                   << 8156>>07830000
         GOTO OUTL;                                            << 8156>>07835000
      END;                                                     << 8156>>07840000
                                                               << 8156>>07845000
      IF WILDUSER THEN                                         << 8156>>07850000
      BEGIN                                                    << 8156>>07855000
                                                               << 8156>>07860000
         IF WILDACCT THEN                                      << 8156>>07865000
         BEGIN                                                 << 8156>>07870000
            GENMSG( SETSEVEN, SHOWSYSUDCFS,,,,,,, -LISTFN );   << 8156>>07875000
            IF NOT SHOWCOMF( UNAME, ANAME, COMF, LISTFN )      << 8156>>07880000
               THEN GENMSG( SETSEVEN, NOSYSUDCFS,,,,,,,        << 8156>>07885000
                            -LISTFN );                         << 8156>>07890000
         END                                                   << 8156>>07895000
         ELSE                                                  << 8156>>07900000
         BEGIN                                                 << 8156>>07905000
            GENMSG( SETSEVEN, SHOWACCTUDCFS,,,,,,, -LISTFN );  << 8156>>07910000
            IF NOT SHOWCOMF( UNAME, ANAME, COMF, LISTFN )      << 8156>>07915000
               THEN GENMSG( SETSEVEN, NOACCTUDCFS,,,,,,,       << 8156>>07920000
                            -LISTFN );                         << 8156>>07925000
         END;                                                  << 8156>>07930000
                                                               << 8156>>07935000
      END       << "@" specified for user.                 >>  << 8156>>07940000
      ELSE                                                     << 8156>>07945000
      BEGIN                                                    << 8156>>07950000
                                                               << 8156>>07955000
         GENMSG( SETSEVEN, SHOWUSERUDCFS,,,,,,, -LISTFN );     << 8156>>07960000
         IF NOT SHOWCOMF( UNAME, ANAME, COMF, LISTFN )         << 8156>>07965000
            THEN GENMSG( SETSEVEN, NOUSERUDCFS,,,,,,,          << 8156>>07970000
                         -LISTFN );                            << 8156>>07975000
         IF REQUESTSERVICE THEN GOTO OUTL2;                    << 8156>>07980000
                                                               << 8156>>07985000
         MOVE UNAME := "@       ";                             << 8156>>07990000
         GENMSG( SETSEVEN, SHOWACCTUDCFS,,,,,,, -LISTFN );     << 8156>>07995000
         IF NOT SHOWCOMF( UNAME, ANAME, COMF, LISTFN )         << 8156>>08000000
            THEN GENMSG( SETSEVEN, NOACCTUDCFS,,,,,,,          << 8156>>08005000
                         -LISTFN );                            << 8156>>08010000
         IF REQUESTSERVICE THEN GOTO OUTL2;                    << 8156>>08015000
                                                               << 8156>>08020000
         MOVE ANAME := "@       ";                             << 8156>>08025000
         GENMSG( SETSEVEN, SHOWSYSUDCFS,,,,,,, -LISTFN );      << 8156>>08030000
         IF NOT SHOWCOMF( UNAME, ANAME, COMF, LISTFN )         << 8156>>08035000
            THEN GENMSG( SETSEVEN, NOSYSUDCFS,,,,,,,           << 8156>>08040000
                         -LISTFN );                            << 8156>>08045000
                                                               << 8156>>08050000
      END;       << Printing of the user's UDC files.      >>  << 8156>>08055000
                                                               << 8156>>08060000
<< Don't forget to close COMMAND.PUB.SYS.                  >>  << 8156>>08065000
OUTL2:                                                         << 8156>>08070000
   FCLOSE( COMF, 0, 0 );                                       << 8156>>08075000
                                                               << 8156>>08080000
   GOTO OUTL;                                                  << 8156>>08085000
                                                               << 8156>>08090000
   END;  << Handling of the case of more than one parm.    >>  << 8156>>08095000
                                                               << 8156>>08100000
                                                               << 8156>>08105000
<< :SHOWCATALOG code, case where ;USER not specified.      >>  << 8156>>08110000
                                                                        08115000
LASTFN := -1;                                                           08120000
OFFSET := 0;                                                            08125000
ENTRYLEN := DIRMAXENTRYSIZE;                                            08130000
                                                                        08135000
IF UDCDSTNO = 0 THEN GENMSG( CISET, NOCATALOGS )               <<04603>>08140000
ELSE << UDC'S & CATALOGS EXIST >>                                       08145000
BEGIN                                                                   08150000
   IF SETLIST THEN GENMSG( SETSEVEN, USEDLISTFILE )                     08155000
   ELSE PRINT(BUFF',0,0);                                               08160000
   DO BEGIN                                                             08165000
         << GET DIR 1 ENTRY AT A TIME >>                                08170000
      MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN +DIRHEAD);   <<04603>>08175000
      MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN +DIRHEAD);   <<04603>>08180000
      LEN := DIR(DIRENTRYSIZE);                                         08185000
      ENTRYLEN := DIR(LEN*2 +DIRENTRYSIZE);                             08190000
      OFFSET := OFFSET +LEN;                                            08195000
      IF LEN <> 0 THEN                                                  08200000
      BEGIN                                                             08205000
         IF LASTFN <> INTEGER(DIR(DIRFILENO)) THEN                      08210000
         BEGIN << PRINT FILE NAME >>                                    08215000
            LASTFN := DIR(DIRFILENO);                                   08220000
            BUFF := " ";                                                08225000
            FGETINFO(LASTFN,BUFF);                                      08230000
            SCAN BUFF UNTIL " ",1;                                      08235000
            BLEN := TOS -@BUFF;                                         08240000
            FWRITE(LISTFN,BUFF',-BLEN,0);                               08245000
            IF <> THEN ERR(SHOWCATLISTWRITEF);                          08250000
         END;                                                           08255000
         BUFF:=" "; <<BLANK FILL OUTPUT BUFFER>>               <<00416>>08260000
         MOVE BUFF(1):=BUFF,(29);                              <<00416>>08265000
         BLEN := DIR(DIRCMDLEN);                                        08270000
         MOVE BUFF(3) := DIR(DIRCMD),(BLEN);                            08275000
         BLEN:=DIR'.UDCTYPE';                                  <<04603>>08280000
         IF BLEN=UDCTYPE'USER THEN MOVE BUFF(22):=" USER   "   <<00416>>08285000
         ELSE                                                  <<00416>>08290000
         IF BLEN=UDCTYPE'SYSTEM THEN MOVE BUFF(22):=" SYSTEM " <<00416>>08295000
         ELSE MOVE BUFF(22):=" ACCOUNT";                       <<00416>>08300000
         FWRITE(LISTFN,BUFF',-30,0);                           <<00416>>08305000
         IF <> THEN ERR(SHOWCATLISTWRITEF);                             08310000
      END;                                                              08315000
      IF REQUESTSERVICE THEN LEN := 0; << BREAK HIT >>                  08320000
   END UNTIL LEN = 0;                                                   08325000
END;                                                                    08330000
                                                                        08335000
OUTL:                                                                   08340000
                                                                        08345000
   << RESTORE %15 AT END FOR REDO >>                                    08350000
FCLOSE(LISTFN,0,0);                                                     08355000
                                                                        08360000
END; << CXSHOWCATALOG >>                                                08365000
$TITLE "UDCDIRCWRITE"                                          <<00884>>08370000
PROCEDURE UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);           <<00884>>08375000
   BYTE ARRAY ANAME,UNAME;                                     <<00884>>08380000
   LOGICAL UDCSEXIST;                                          <<00884>>08385000
   INTEGER RECNO;                                              <<00884>>08390000
   OPTION UNCALLABLE;                                          <<00884>>08395000
COMMENT                                                        <<00884>>08400000
   Reads/writes Command file record numbers from/to system     <<00884>>08405000
   directory. Updates system level UDC flag in SYSGLOB if      <<00884>>08410000
   necessary. Command file record numbers for user level UDC's <<00884>>08415000
   are kept in the user entry of the system directory. Record  <<00884>>08420000
   numbers for account level UDC's are kept in the account     <<00884>>08425000
   entries. The record number for system level UDC's is kept in<<00884>>08430000
   the account entry of the SYS account. RECIPUDC is a procedur<<00884>>08435000
   which is passed to DIRECSCAN to do the actual read/write    <<00884>>08440000
   of the directory entry.  PARMARRAY is used by RECIPUDC to   <<00884>>08445000
   determine what is to be done to the entry and as storage    <<00884>>08450000
   for values read/written from/to the entry.                  <<00884>>08455000
   ;                                                           <<00884>>08460000
                                                               <<00884>>08465000
BEGIN                                                          <<00884>>08470000
ENTRY UDCDIRCREAD;                                             <<00884>>08475000
ARRAY                                                          <<00884>>08480000
   PARMARRAY(0:3) = Q,                                         <<00884>>08485000
   SYS(0:3);                                                   <<00884>>08490000
POINTER                                                        <<00884>>08495000
   UNAME',                                                     <<00884>>08500000
   ANAME';                                                     <<00884>>08505000
                                                               <<00884>>08510000
INTEGER SUBROUTINE WORDADDRESS(BYTEADDRESS);                   <<00884>>08515000
   VALUE BYTEADDRESS;  INTEGER BYTEADDRESS;                    <<00884>>08520000
   BEGIN                                                       <<00884>>08525000
   TOS := WORDADDRESS := BYTEADDRESS & LSR(1);                 <<00884>>08530000
   PUSH(Z);                                                    <<00884>>08535000
   IF <<WORDADDRESS>> TOS > TOS <<Z>> THEN                     <<00884>>08540000
      WORDADDRESS.(0:1) := 1;                                  <<00884>>08545000
   END;                                                        <<00884>>08550000
                                                               <<00884>>08555000
                                                               <<00884>>08560000
PARMARRAY := DIRCWRITE;                                        <<00884>>08565000
GO START;                                                      <<00884>>08570000
                                                               <<00884>>08575000
UDCDIRCREAD:                                                   <<00884>>08580000
PARMARRAY := DIRCREAD;                                         <<00884>>08585000
                                                               <<00884>>08590000
START:                                                         <<00884>>08595000
PARMARRAY(2) := RECNO;                                         <<00884>>08600000
PARMARRAY(3) := UDCSEXIST;                                     <<00884>>08605000
@UNAME' := WORDADDRESS(@UNAME);                                <<00884>>08610000
@ANAME' := WORDADDRESS(@ANAME);                                <<00884>>08615000
IF UNAME = "@" THEN                                            <<00884>>08620000
   IF ANAME = "@" THEN                                         <<00884>>08625000
      BEGIN                                                    <<00884>>08630000
      PARMARRAY(1) := UDCTYPE'SYSTEM;                          <<00884>>08635000
      MOVE SYS := "SYS     ";                                  <<00884>>08640000
      DIRECSCAN(GETACCTENTRY,0D,SYS,,,RECIPUDC,PARMARRAY);     <<00884>>08645000
      IF PARMARRAY = DIRCWRITE THEN                            <<00884>>08650000
         ABSOLUTE(SYSGLOBUDCFLAG) := UDCSEXIST;                <<00884>>08655000
      END                                                      <<00884>>08660000
   ELSE                                                        <<00884>>08665000
      BEGIN                                                    <<00884>>08670000
      PARMARRAY(1) := UDCTYPE'ACCOUNT;                         <<00884>>08675000
      DIRECSCAN(GETACCTENTRY,0D,ANAME',,,RECIPUDC,PARMARRAY);  <<00884>>08680000
      END                                                      <<00884>>08685000
ELSE                                                           <<00884>>08690000
   BEGIN                                                       <<00884>>08695000
   PARMARRAY(1) := UDCTYPE'USER;                               <<00884>>08700000
   DIRECSCAN(GETUSERENTRY,0D,ANAME',UNAME',,RECIPUDC,PARMARRAY)<<00884>>08705000
   ;                                                           <<00884>>08710000
   END;                                                        <<00884>>08715000
RECNO := PARMARRAY(2);                                         <<00884>>08720000
UDCSEXIST := PARMARRAY(3);                                     <<00884>>08725000
END;  << UDCDIRCWRITE >>                                       <<00884>>08730000
$TITLE "ERROR"                                                          08735000
PROCEDURE ERROR(ERRNO,TYPE,EPTR,BASEPTR);                               08740000
   VALUE ERRNO,TYPE,EPTR,BASEPTR;                                       08745000
   INTEGER ERRNO,TYPE;                                                  08750000
   BYTE POINTER EPTR,BASEPTR;                                           08755000
   OPTION UNCALLABLE,VARIABLE;                                          08760000
COMMENT   - UNIVERSAL ERROR HANDLER FOR UDC'S.                          08765000
                                                                        08770000
PARAMETERS:                                                             08775000
   ERRNO    - ERROR NUMBER. REQUIRED PARM.                              08780000
   TYPE     = ERROR TYPE.  REQUIRED PARM.                               08785000
       FERR     = 0 - FILE ERROR.  EPTR IS FILE NUMBER.                 08790000
                      FCHECK IS CALLED TO GET ERROR. GENMSG             08795000
                      IS CALLED TO PRINT FILE SYS ERROR.                08800000
                      CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>08805000
      UDCERR    = 1 - CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>08810000
                      (INTERNAL ERROR.)                                 08815000
      SYNERR    = 2 - STRING IS PRINTED, CARET IS PRINTED.              08820000
                      CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>08825000
      SYNERRNOL = 3 - CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>08830000
      UDCFERR   = 4 - BASEPTR CONTAINS FILE NAME. FGETINFO              08835000
                      CALLED TO GET FILE NO.  FCHECK CALLED             08840000
                      TO GET ERROR.  GENMSG IS CALLED TO PRINT          08845000
                      FILE SYS ERROR.                                   08850000
      IMAGERR   = 5 - STRING PRINTED ONLY IF UDC4.IMAGEADJUST.          08855000
                      CARET PRINTED.  CIERR CALLED TO PRINT    <<01360>>08860000
                      CI ERROR.                                <<01360>>08865000
   EPTR     - POINT IN STRING WHERE CARET SHOULD BE PRINTED.            08870000
              (UNLESS TYPE=FERR THEN EPTR IS FILE NO.)                  08875000
   BASEPTR  - BEGINNING OF ERROR STRING.  (UNLESS TYPE=UDCERR           08880000
              THEN IT IS FILE NAME.)                                    08885000
;                                                                       08890000
BEGIN                                                                   08895000
                                                                        08900000
                                                                        08905000
INTEGER                                                                 08910000
   COMLEN,                                                              08915000
   LEN;                                                                 08920000
                                                                        08925000
BYTE POINTER PTR;                                                       08930000
POINTER PTR';                                                           08935000
POINTER BASEPTR';                                                       08940000
                                                                        08945000
ARRAY BUFF'(0:UDCBUFFSIZE);                                    << 7960>>08950000
BYTE ARRAY BUFF(*) = BUFF';                                    << 7960>>08955000
                                                                        08960000
CIS'UDCNOPRINT := 1;  << CIERR SHOULD NOT PRINT LINE. >>       <<04603>>08965000
                                                               <<01360>>08970000
IF TYPE = SYNERR OR TYPE = IMAGERR THEN                                 08975000
BEGIN                                                                   08980000
   @BASEPTR' := @BASEPTR&LSR(1);                                        08985000
   @PTR' := @BASEPTR';                                                  08990000
   @PTR := @BASEPTR;                                                    08995000
   SCAN PTR UNTIL 0,1;                                                  09000000
   COMLEN := TOS -@PTR;                                                 09005000
   LEN := IF COMLEN > TERMSIZE THEN TERMSIZE ELSE COMLEN;               09010000
   DO BEGIN                                                             09015000
      IF TYPE <> IMAGERR OR CIS'UDCIMAGEADJUST OR COMLEN >     <<04603>>09020000
         TERMSIZE THEN PRINT(PTR',-LEN,0);                              09025000
      @PTR := @PTR +TERMSIZE;                                           09030000
      @PTR' := @PTR&LSR(1);                                             09035000
      LEN := COMLEN -(@PTR -@BASEPTR);                                  09040000
      IF LEN > TERMSIZE THEN LEN := TERMSIZE;                           09045000
   END UNTIL @PTR >= @EPTR;                                             09050000
   LEN := @EPTR -(@PTR -TERMSIZE);                                      09055000
   IF TYPE = IMAGERR AND NOT CIS'UDCIMAGEADJUST AND            <<04603>>09060000
      COMLEN <= TERMSIZE THEN LEN := LEN +1;                            09065000
   BUFF := " ";                                                         09070000
   MOVE BUFF(1) := BUFF,(LEN);                                          09075000
   BUFF(LEN) := "^";                                                    09080000
   PRINT(BUFF',-LEN -1,0);                                              09085000
END << SYNERR >>                                                        09090000
ELSE                                                                    09095000
IF TYPE = FERR THEN                                                     09100000
BEGIN                                                                   09105000
   FCHECK(EPTR(1),LEN); << FIL # PASSED AS BYTE PTR>>                   09110000
   GENMSG(FSYSSET,LEN);                                                 09115000
END                                                                     09120000
ELSE                                                                    09125000
IF TYPE = UDCFERR THEN                                                  09130000
BEGIN                                                                   09135000
   FCHECK(EPTR(1),LEN); << FILE # PASSED AS BYTE PTR>>                  09140000
   GENMSG(FSYSSET,LEN);                                                 09145000
   IF INTEGER(EPTR(1)) <> 0 THEN                                        09150000
   BEGIN << GET FILE NAME >>                                            09155000
      @BASEPTR := @BUFF;                                                09160000
      BUFF := 0;                                                        09165000
      MOVE BASEPTR(1) := BASEPTR,(28);                         <<01522>>09170000
      FGETINFO(EPTR(1),BASEPTR);                                        09175000
   END;                                                                 09180000
   CIERR( ERRNO, , %1, @BASEPTR );                             <<01360>>09185000
END;                                                                    09190000
                                                                        09195000
IF TYPE <> UDCFERR  THEN CIERR( ERRNO );                       <<01360>>09200000
                                                               <<01360>>09205000
CIS'UDCNOPRINT := 0;  << RESET >>                              <<04603>>09210000
                                                                        09215000
END; << ERROR >>                                                        09220000
$TITLE "FEEDCI"                                                         09225000
PROCEDURE FEEDCI(UDCFN,RECNO,COMIMAGE,NUMPARMS,                         09230000
      PARMSINFO,OFFSET,OPTIONS,ERRNO);                                  09235000
   VALUE UDCFN,RECNO,NUMPARMS,OPTIONS,OFFSET;                           09240000
   INTEGER UDCFN,RECNO,NUMPARMS,OFFSET,ERRNO;                           09245000
   BYTE ARRAY COMIMAGE;                                                 09250000
   LOGICAL OPTIONS;                                                     09255000
   ARRAY PARMSINFO;                                                     09260000
   OPTION UNCALLABLE;                                                   09265000
COMMENT                                                                 09270000
   READS UDC FILE, STUFFS PARMS & CALLS CI                              09275000
;                                                                       09280000
BEGIN                                                                   09285000
                                                                        09290000
INTEGER                                                                 09295000
   COUNT,                                                               09300000
   COMLEN,                                                              09305000
   PLEN,                                                                09310000
   UDCLEN,                                                              09315000
   SIGN'LEN,                                                   <<01018>>09320000
   ERRNO1;                                                              09325000
LOGICAL DONE;                                                           09330000
BYTE POINTER                                                            09335000
   UDCPTR,                                                              09340000
   PARMPTR;                                                             09345000
ARRAY UDCBUFF'(0:UDCBUFFSIZE);                                          09350000
BYTE ARRAY UDCBUFF(*) = UDCBUFF';                                       09355000
                                                                        09360000
SUBROUTINE FILERR(ERRN);                                                09365000
   VALUE ERRN; INTEGER ERRN;                                            09370000
      << FILE ERROR >>                                                  09375000
BEGIN                                                                   09380000
   ERRNO := ERRN;                                                       09385000
   ERROR(ERRNO,UDCFERR,UDCFN);                                          09390000
   GO OUTL;                                                             09395000
END; << ERR >>                                                          09400000
                                                                        09405000
SUBROUTINE BERR(ERRN,PTR);                                              09410000
   VALUE ERRN; INTEGER ERRN;                                            09415000
   BYTE ARRAY PTR;                                                      09420000
      << UDC BODY ERROR >>                                              09425000
BEGIN                                                                   09430000
   ERRNO := ERRN;                                                       09435000
   ERROR(ERRNO,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL         <<04603>>09440000
                                        ELSE SYNERR,           <<04603>>09445000
      PTR,UDCBUFF);                                                     09450000
   IF CIS'UDCFATALCIERR THEN GO OUTL                           <<04603>>09455000
   ELSE                                                        <<01360>>09460000
   BEGIN                                                       <<01360>>09465000
      ERRNO := -1;  << CONTINUE IF RETURNED OK.  >>            <<01360>>09470000
      GO SKIP'THIS'LINE;                                       <<01360>>09475000
   END;                                                        <<01360>>09480000
END; << BERR >>                                                         09485000
                                                                        09490000
SUBROUTINE ERRTOOLONG;                                                  09495000
      << COMIMAGE ERROR >>                                              09500000
BEGIN                                                                   09505000
   ERRNO := TOOLONG;                                           <<01288>>09510000
   ERROR(TOOLONG,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL       <<04603>>09515000
                                          ELSE SYNERR,         <<04603>>09520000
      COMIMAGE(CIS'MAXCOMLEN -1),COMIMAGE);                    <<04603>>09525000
   IF CIS'UDCFATALCIERR THEN GO OUTL                           <<04603>>09530000
   ELSE                                                        <<01360>>09535000
   BEGIN                                                       <<01360>>09540000
      ERRNO := -1;  << CONTINUE IF RETURNED OK.  >>            <<01360>>09545000
      GO SKIP'THIS'LINE;                                       <<01360>>09550000
   END;                                                        <<01360>>09555000
END; << SUBROUTINE ERRTOOLONG >>                                        09560000
                                                                        09565000
                                                                        09570000
SUBROUTINE STUFF;                                                       09575000
COMMENT                                                                 09580000
   MOVES FROM UDCPTR INTO COMIMAGE. CHECKS FOR OVERFLOW OF              09585000
   BUFFER. REQUIRES:                                                    09590000
      UDCLEN = COUNT TO PLACE IN COMIMAGE.                              09595000
      UDCPTR = POINTING TO STARTING PLACE IN UDC IMAGE.                 09600000
   UPDATES COMLEN                                                       09605000
;                                                                       09610000
BEGIN                                                                   09615000
   MOVE COMIMAGE(COMLEN) := UDCPTR,(UDCLEN);                   <<05021>>09620000
   IF COMLEN +UDCLEN > CIS'MAXCOMLEN THEN                      <<04603>>09625000
      ERRTOOLONG;                                                       09630000
   COMLEN := COMLEN +UDCLEN;                                            09635000
END; << STUFF >>                                                        09640000
                                                                        09645000
                                                                        09650000
          << *************************** >>                             09655000
          <<                             >>                             09660000
          <<    FEEDCI MAIN BODY         >>                             09665000
          <<                             >>                             09670000
          << *************************** >>                             09675000
                                                                        09680000
                                                                        09685000
COMIMAGE(CIS'MAXCOMLEN +1) := 0; << STOPPER FOR ERRTOOLONG >>  <<04603>>09690000
ERRNO := -1;                                                            09695000
DO BEGIN                                                                09700000
   COMLEN := 0;                                                         09705000
   READFILE(UDCFN,RECNO,UDCBUFF',ERRNO1);                               09710000
   IF ERRNO1 = EOFOUND THEN ERRNO := 0                                  09715000
   ELSE                                                                 09720000
   BEGIN                                                                09725000
      IF ERRNO1 <> 0 THEN FILERR(ERRNO1);                               09730000
      IF UDCBUFF = "*" THEN ERRNO := 0                                  09735000
      ELSE                                                              09740000
      BEGIN                                                             09745000
         @UDCPTR := @UDCBUFF;                                           09750000
         DONE := FALSE;                                                 09755000
                                                                        09760000
            << LOOP TO PARSE UDC BODY IMAGE >>                          09765000
                                                                        09770000
         DO BEGIN << WHIRL THRU PARMS >>                                09775000
            SCAN UDCPTR UNTIL "!",1;                                    09780000
            @PARMPTR := TOS;                                            09785000
            IF NOCARRY THEN                                             09790000
            BEGIN                                                       09795000
               UDCLEN := @PARMPTR -@UDCPTR;                             09800000
               STUFF; << PUT IN COMIMAGE>>                              09805000
               FINDPARM(PARMPTR(1),UDCPTR);                             09810000
                                                                        09815000
                  << CHECK OUT FORMAL NAME >>                           09820000
                    IF UDCPTR <> ALPHA AND UDCPTR <> "!" THEN  <<01018>>09825000
                        BERR(FMLNAMENOTALPHA,UDCPTR)           <<01018>>09830000
                    ELSE IF UDCPTR = "!" THEN                  <<01018>>09835000
                        BEGIN                                  <<01018>>09840000
                           SCAN UDCPTR WHILE "!",1;            <<01018>>09845000
                           SIGN'LEN := TOS - @UDCPTR + 1;      <<01018>>09850000
                           UDCLEN := SIGN'LEN/2;               <<01018>>09855000
                           STUFF;                              <<01018>>09860000
                           @UDCPTR := @UDCPTR(SIGN'LEN - 1);   <<01018>>09865000
                           IF SIGN'LEN MOD 2 = 0 THEN GO MATCH;<<01018>>09870000
                        END;                                   <<01018>>09875000
                  << UPSHIFT >>                                         09880000
               MOVE UDCPTR := UDCPTR WHILE ANS,1;                       09885000
               UDCLEN := TOS -@UDCPTR;                                  09890000
               COUNT := -1;                                             09895000
               WHILE (COUNT := COUNT +1) < NUMPARMS DO                  09900000
               BEGIN                                                    09905000
                                                                        09910000
                     << SEARCH FOR MATCHING NAME POINTED >>             09915000
                     << TO BY PARMSINFO                  >>             09920000
                  @PARMPTR := PARMSINFO(COUNT*3 +1);                    09925000
                  IF UDCLEN = INTEGER(PARMSINFO(COUNT*3)                09930000
                     .(0:8)) AND UDCPTR = PARMPTR,(UDCLEN)              09935000
                     THEN                                               09940000
                  BEGIN                                                 09945000
                                                                        09950000
                        << FOUND MATCH. STUFF IN COMIMAGE>>             09955000
                     @PARMPTR := PARMSINFO(COUNT*3 +2);                 09960000
                     PLEN := PARMSINFO(COUNT*3).(8:8);                  09965000
                     MOVE COMIMAGE(COMLEN) := PARMPTR,                  09970000
                                        (PLEN);                <<05021>>09975000
                     IF COMLEN +PLEN > CIS'MAXCOMLEN THEN      <<04603>>09980000
                        ERRTOOLONG;                                     09985000
                     @UDCPTR := @UDCPTR(UDCLEN +               <<00884>>09990000
                           (IF UDCPTR(-1) = """" AND           <<00884>>09995000
                              UDCPTR(UDCLEN) = """" THEN 1     <<00884>>10000000
                                                      ELSE 0));<<00884>>10005000
                     COMLEN := COMLEN +PLEN;                            10010000
                     GO MATCH;                                          10015000
                  END;                                                  10020000
               END;                                                     10025000
               BERR(UNKNOWNPARM,UDCPTR);                                10030000
MATCH:                                                                  10035000
            END                                                         10040000
            ELSE                                                        10045000
            BEGIN << NO PARM >>                                         10050000
               UDCLEN := @PARMPTR -@UDCPTR;                             10055000
               STUFF; << IN COMIMAGE >>                                 10060000
               DONE := TRUE;                                            10065000
            END;                                                        10070000
         END UNTIL DONE; << PARM LOOP >>                                10075000
                                                                        10080000
            << NOW PARSED COMPLETE BODY IMAGE >>                        10085000
         IF OPTIONS.CIS'OPTLIST THEN                           <<04603>>10090000
         BEGIN                                                          10095000
            TOS := @COMIMAGE&LSR(1); << WORD ADDRESS >>                 10100000
            PRINT(*,-COMLEN,0);                                         10105000
         END;                                                           10110000
         COMIMAGE(COMLEN) := CR; << STOPPER FOR CI>>                    10115000
                                                                        10120000
            << DEBLANK ON FRONT >>                                      10125000
         SCAN COMIMAGE WHILE %6440,1; << " " >>                         10130000
         @PARMPTR := TOS;                                               10135000
         IF NOCARRY THEN MOVE COMIMAGE:=PARMPTR,(COMLEN+1)     <<01126>>10140000
            ELSE COMLEN:=0; << ALL BLANK LINE >>               <<01126>>10145000
                                                                        10150000
         IF COMLEN > 0 THEN                                    <<01075>>10155000
            BEGIN                                              <<01075>>10160000
            UDCCI(OFFSET);                                     <<01075>>10165000
            IF CIS'UDCFATALCIERR OR                            <<04603>>10170000
               CIS'UDCBREAKDETECTED OR CIS'UDCFLUSH THEN       <<04603>>10175000
               ERRNO := UDC'FLUSHED;  << FLUSH UDC'S >>        <<01288>>10180000
            END;                                               <<01075>>10185000
         IF (CIS'UDCNESTLEVEL=0) OR CIS'UDCEXITBREAK THEN      <<04603>>10190000
               ERRNO := UDC'FLUSHED;  << ALSO, FLUSH UDC'S >>  <<01288>>10195000
      END;                                                              10200000
   END;                                                                 10205000
                                                               <<01360>>10210000
   SKIP'THIS'LINE:                                             <<01360>>10215000
                                                               <<01360>>10220000
END UNTIL ERRNO <> -1;                                                  10225000
                                                                        10230000
OUTL:                                                                   10235000
END; << FEEDCI >>                                                       10240000
$TITLE "FINDCOMUSER"                                                    10245000
PROCEDURE FINDCOMUSER(COMFN,UNAME,ANAME,UDCSEXIST,USERREC,     <<00884>>10250000
                                        FILEREC,ERRNO);        <<00884>>10255000
   VALUE COMFN;                                                <<00884>>10260000
   INTEGER COMFN,USERREC,FILEREC,ERRNO;                        <<00884>>10265000
   LOGICAL UDCSEXIST;                                          <<00884>>10270000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>10275000
   OPTION UNCALLABLE;                                          <<00884>>10280000
COMMENT                                                        <<00884>>10285000
   Locates user & account in Command file. Starts by using     <<00884>>10290000
   record number kept in directory.  If this record number     <<00884>>10295000
   is not valid (i.e., the Command file has changed since      <<00884>>10300000
   the record number was saved) then a linear search of the    <<00884>>10305000
   Command file is performed. The record number in the         <<00884>>10310000
   directory is updated to match the current Command file.     <<00884>>10315000
                                                               <<06034>>10320000
   Parameters:                                                 <<06034>>10325000
      COMFN:       INPUT -- COMMAND file number                <<06034>>10330000
      UNAME:       INPUT -- User name                          <<06034>>10335000
      ANAME:       INPUT -- Account name                       <<06034>>10340000
      UDCSEXIST:  OUTPUT -- True if UDC's exist                <<06034>>10345000
      USERREC:    OUTPUT -- Pointer to user in COMMAND file    <<06034>>10350000
      FILEREC:    OUTPUT -- Pointer to first user file entry   <<06034>>10355000
      ERRNO:      OUTPUT -- Returned error code                <<06034>>10360000
;                                                              <<00884>>10365000
BEGIN                                                          <<00884>>10370000
DOUBLE                                                         <<00884>>10375000
   RECNO;                                                      <<00884>>10380000
ARRAY                                                          <<00884>>10385000
   REC'(0:COMRECSIZEM1);                                       <<00884>>10390000
BYTE ARRAY                                                     <<00884>>10395000
   REC(*) = REC';                                              <<00884>>10400000
                                                               <<00884>>10405000
SUBROUTINE SEARCHFORUSER;                                      <<00884>>10410000
   BEGIN                                                       <<00884>>10415000
   USERREC := 1;  << Begin search at begining of file >>       <<00884>>10420000
   SEARCHCOMFILE(COMFN,UNAME,ANAME,USERREC,FILEREC,ERRNO);     <<00884>>10425000
   IF ERRNO = 0 THEN                                           <<00884>>10430000
         << Found user. Must update directory record number >> <<00884>>10435000
      UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,USERREC)              <<00884>>10440000
   ELSE                                                        <<00884>>10445000
      BEGIN                                                    <<00884>>10450000
      USERREC := FILEREC := 0;                                 <<00884>>10455000
      IF ERRNO = EOFOUND THEN ERRNO := NOSUCHCOMUSER;          <<00884>>10460000
      END;                                                     <<00884>>10465000
   END;  << SEARCHCOMFILE >>                                   <<00884>>10470000
                                                               <<00884>>10475000
ERRNO := 0;                                                    <<00884>>10480000
UDCDIRCREAD(UNAME,ANAME,UDCSEXIST,USERREC);                    <<00884>>10485000
IF UDCSEXIST THEN                                              <<00884>>10490000
   BEGIN << Verify that directory pointer is valid. >>         <<00884>>10495000
   FREADDIR(COMFN,REC',COMRECSIZE,DOUBLE(USERREC));            <<00884>>10500000
   IF < THEN ERRNO := COMREADFAIL                              <<00884>>10505000
   ELSE                                                        <<00884>>10510000
         << Bad pointer in Directory. Must search. >>          <<00884>>10515000
      IF > THEN SEARCHFORUSER                                  <<00884>>10520000
      ELSE                                                     <<00884>>10525000
         << Verify this is the correct entry >>                <<00884>>10530000
         IF REC'(COMENTRYTYPE) = COMUSERENTRY AND              <<00884>>10535000
            REC(COMUNAME) = UNAME,(8) AND                      <<00884>>10540000
            REC(COMANAME) = ANAME,(8) THEN                     <<00884>>10545000
               << found correct entry >>                       <<00884>>10550000
               FILEREC := REC'(COMLINK)                        <<00884>>10555000
         ELSE                                                  <<00884>>10560000
               << Bad pointer. Must search. >>                 <<00884>>10565000
            SEARCHFORUSER;                                     <<00884>>10570000
   END;                                                        <<00884>>10575000
                                                               <<00884>>10580000
END;  << FINDCOMUSER >>                                        <<00884>>10585000
$TITLE "GETCOMREC"                                                      10590000
INTEGER PROCEDURE GETCOMREC(COMFN,ERRNO);                               10595000
   VALUE COMFN;                                                         10600000
   INTEGER COMFN,ERRNO;                                                 10605000
   OPTION UNCALLABLE;                                                   10610000
COMMENT RETURNS RECORD NUMBER OF 1ST FREE RECORD IN                     10615000
   COMMAND.PUB.SYS FILE                                                 10620000
;                                                                       10625000
                                                               <<03734>>10630000
<< Assumptions:  This procedure assumes that COMMAND.PUB.SYS >><<03734>>10635000
<<    (file number = COMFN ) was locked by the calling       >><<03734>>10640000
<<    procedure.                                             >><<03734>>10645000
                                                               <<03734>>10650000
BEGIN                                                                   10655000
                                                                        10660000
ARRAY REC0(0:COMRECSIZEM1);                                             10665000
ARRAY REC(0:COMRECSIZEM1);                                              10670000
INTEGER RECNO;                                                          10675000
                                                                        10680000
SUBROUTINE READ(BUF,REC);                                               10685000
   VALUE REC;                                                           10690000
   ARRAY BUF;                                                           10695000
   INTEGER REC;                                                         10700000
BEGIN                                                                   10705000
   FREADDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                          10710000
   IF <> THEN                                                           10715000
   BEGIN                                                                10720000
      ERRNO := COMREADFAIL;                                             10725000
      GO OUTL;                                                          10730000
   END;                                                                 10735000
END; << READ >>                                                         10740000
                                                                        10745000
SUBROUTINE WRITE(BUF,REC);                                              10750000
   VALUE REC;                                                           10755000
   ARRAY BUF;                                                           10760000
   INTEGER REC;                                                         10765000
BEGIN                                                                   10770000
   FWRITEDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                         10775000
   IF < THEN                                                            10780000
   BEGIN                                                                10785000
      ERRNO := COMWRITEFAIL;                                            10790000
      GO OUTL;                                                          10795000
   END                                                                  10800000
   ELSE                                                                 10805000
   IF > THEN                                                            10810000
   BEGIN                                                                10815000
      ERRNO := EOFOUND;                                                 10820000
      GO OUTL;                                                          10825000
   END;                                                                 10830000
END; << WRITE >>                                                        10835000
                                                                        10840000
   ERRNO := 0;                                                 <<03734>>10845000
   FREADDIR(COMFN,REC0,COMRECSIZE,0D);                                  10850000
   IF < THEN ERRNO := COMREADFAIL                                       10855000
   ELSE                                                                 10860000
   BEGIN                                                                10865000
      IF > THEN << UNITITIALIZED FILE >>                                10870000
      BEGIN                                                             10875000
         REC0 := 0;                                                     10880000
         MOVE REC0(1) := REC0,(COMRECSIZEM1);                           10885000
         REC0(COMFREEHEAD) := 1;                                        10890000
         WRITE(REC0,0);                                                 10895000
      END;                                                              10900000
         << UPDATE HEAD RECORD >>                                       10905000
      REC0(COMUSE) := REC0(COMUSE) +1;                                  10910000
      IF REC0(COMUSE) > REC0(COMMAXUSE) THEN REC0                       10915000
         (COMMAXUSE) := REC0(COMMAXUSE) +1;                             10920000
      GETCOMREC:=RECNO:=REC0(COMFREEHEAD); << FREE REC NO. >>           10925000
      FREADDIR(COMFN,REC,COMRECSIZE,DOUBLE(REC0(COMFREEHEAD)));         10930000
      IF > THEN << EOF. EXPAND FILE >>                                  10935000
      BEGIN                                                             10940000
         REC(COMLINK):=0; << IN CASE OF ERROR IN SETCATALOG >>          10945000
         WRITE(REC,REC0(COMFREEHEAD));                                  10950000
         REC0(COMFREEHEAD) := REC0(COMFREEHEAD) +1;                     10955000
         WRITE(REC0,0);                                                 10960000
      END                                                               10965000
      ELSE                                                              10970000
      IF < THEN ERRNO := COMREADFAIL                                    10975000
      ELSE                                                              10980000
      BEGIN                                                             10985000
         << GET NEXT FREE REC & STUFF IN HEAD>>                         10990000
         REC0(COMFREEHEAD) := REC(COMLINK);                             10995000
         WRITE(REC0,0);                                                 11000000
         REC(COMLINK):=0; << IN CASE OF ERROR IN SETCATALOG >>          11005000
         WRITE(REC,RECNO);                                              11010000
      END;                                                              11015000
   END;                                                                 11020000
                                                                        11025000
OUTL:                                                                   11030000
END; << GETCOMREC >>                                                    11035000
$TITLE "INITUDC"                                                        11040000
PROCEDURE INITUDC( SHOW, SETCATCOMFN );                        <<03734>>11045000
   VALUE    SHOW, SETCATCOMFN;                                 <<03734>>11050000
   LOGICAL  SHOW;                                              <<03734>>11055000
   INTEGER  SETCATCOMFN;                                       <<03734>>11060000
   OPTION   UNCALLABLE, VARIABLE;                              <<03734>>11065000
COMMENT                                                                 11070000
   OPENS COMMAND FILE & EACH UDC FILE, THEN BUILDS DIRECTORY            11075000
   OF COMMAND NAMES & RECNOS IN DATA SEGMENT. DIRECTORY ENTRY           11080000
   IS AS FOLLOWS:                                                       11085000
   ******************************                                       11090000
   *L*O*H*B*      * ENTRYSIZE   *   L = LIST                            11095000
   ******************************   O = LOGON                           11100000
   *      RECNO                 *   H = NOHELP                          11105000
   ******************************   B = NOBREAK                         11110000
   *      BODYRECNO             *                                       11115000
   ******************************                                       11120000
   *  FILE NO.    * CMDLEN      *                                       11125000
   ******************************                                       11130000
   * COMMAND (MAX. 16 BYTES)    *                                       11135000
   /                            /                                       11140000
   ******************************                                       11145000
                                                                        11150000
   ENTRYSIZE = 0 INDICATES END OF DIRECTORY.                            11155000
                                                                        11160000
;                                                                       11165000
                                                               <<04651>>11170000
<<                                                         >>  <<04651>>11175000
<< Fix Information:                                        >>  <<04651>>11180000
<<                                                         >>  <<04651>>11185000
<< * This fix causes logon UDCs to execute on each level,  >>  <<04651>>11190000
<<   with the logon hierarchy of System-Account-User.  At  >>  <<04651>>11195000
<<   most one logon UDC will execute on each level, so the >>  <<04651>>11200000
<<   maximum number of executing logon UDCs is three.  The >>  <<04651>>11205000
<<   hierarchy was chosen to allow system manager to en-   >>  <<04651>>11210000
<<   force any site-specific security check at logon       >>  <<04651>>11215000
<<   before users have a chance to perform any operations. >>  <<04651>>11220000
<<   Normal UDCs will continue to have the User-Acct-Sys   >>  <<04651>>11225000
<<   hierarchy that was designed to let system managers    >>  <<04651>>11230000
<<   remove specific commands from the CI set.             >>  <<04651>>11235000
<<                                                         >>  <<04651>>11240000
<<                                                          >> <<04631>>11245000
<< Fix information:                                         >> <<04631>>11250000
<<                                                          >> <<04631>>11255000
<< * With this fix, UDC's with OPTION NOHELP will not be    >> <<04631>>11260000
<<   displayed with the execution of                        >> <<04631>>11265000
<<   :SETCATALOG [ufiles..];SHOW.  All OPTION's for a UDC   >> <<04631>>11270000
<<   will be displayed on one OPTION line when ;SHOW is     >> <<04631>>11275000
<<   specified.                                             >> <<04631>>11280000
<<   Lockwords for the UDC files are not displayed when     >> <<04631>>11285000
<<   ;SHOW is specifed                                      >> <<04631>>11290000
<<                                                          >> <<04631>>11295000
<< Fix Information                                             <<06034>>11300000
<<                                                          >> <<06034>>11305000
<< * Before this fix, if an error was found while building  >> <<06034>>11310000
<<   the UDC directory upon logon no UDCs would be put into >> <<06034>>11315000
<<   the directory.  This meant that if a user UDC contained>> <<06034>>11320000
<<   an error (for instance, an illegal UDC name) that user >> <<06034>>11325000
<<   would not get any system or account UDCs as well as no >> <<06034>>11330000
<<   user UDCs when he/she logged on.  This fix ignores the >> <<06034>>11335000
<<   level upon which the error occurred and tries to       >> <<06034>>11340000
<<   continue to build the directory starting at the next   >> <<06034>>11345000
<<   level (if one exists).                                 >> <<06034>>11350000
BEGIN                                                                   11355000
                                                                        11360000
   ENTRY INITUDCNO; << DON'T DO LOGON >>                                11365000
                                                                        11370000
                                                                        11375000
INTEGER                                                                 11380000
   I,                                                          <<00416>>11385000
   I2,  <<  loop variable  >>                                  <<06034>>11390000
   FNX := -1,                                                  <<01510>>11395000
   FNX'LEVEL,  <<  first file number index for a level  >>     <<06034>>11400000
   UDCDSTN,                                                             11405000
   COMFN  := 0,                                                <<03734>>11410000
   UDCFN,                                                               11415000
   FLEN,                                                       <<04846>>11420000
   FGLWDLEN,          << UDC file lockword length >>           <<04846>>11425000
   FGLWDERR,          << FGETLOCKWORD error.      >>           <<04846>>11430000
   LEN,                                                                 11435000
   DUMMY = LEN,                                                         11440000
   ENTRYLEN,                                                            11445000
   RECNO,         <<  pointer into UDC file  >>                <<06034>>11450000
   RECNONEXT,                                                           11455000
   COMRECNO,      <<  pointer into COMMAND file  >>            <<06034>>11460000
   ERRNO,                                                               11465000
   OFFSET:=0,     <<  pointer into directory as it is built  >><<06437>>11470000
   PASS:=1,                                                    <<04631>>11475000
   OLEN:=10,                                                   <<04631>>11480000
   TEMPLEN,                                                    <<04631>>11485000
   LEVEL'OFFSET,  <<  Start of a UDC level in directory  >>    <<06034>>11490000
   OLDOFFSET;                                                           11495000
                                                                        11500000
BYTE POINTER                                                            11505000
   PTR,                                                                 11510000
   SAVEPTR,                                                    <<01529>>11515000
   SPTR;                                                                11520000
                                                                        11525000
LOGICAL                                                                 11530000
   HAVEHELP:=FALSE,                                            <<04631>>11535000
   HAVEBREAK:=FALSE,                                           <<04631>>11540000
   HAVENOLOGON:=FALSE,                                         <<04631>>11545000
   HAVENOLIST:=FALSE,                                          <<04631>>11550000
   HAVEOPTIONS,                                                <<04631>>11555000
   HAVENOHELP:=FALSE,                                          <<04631>>11560000
   HAVENOBREAK:=FALSE,                                         <<04631>>11565000
   HAVELIST:=FALSE,                                            <<04631>>11570000
   HAVELOGON:=FALSE,                                           <<04631>>11575000
   INITIALIZED:=FALSE, <<  True if directory inited.  >>       <<06034>>11580000
   UDCSEXIST,                                                  <<00884>>11585000
   OLDCRIT,                                                    <<04810>>11590000
   FINDCMD,                                                             11595000
   FOUNDLOGON,                                                          11600000
   FOUNDANYLOGON := FALSE,    << Logon UDC at any level. >>    <<04651>>11605000
   OPTIONS,                                                             11610000
   FINDOPTION,                                                          11615000
   DOLOGON;                                                             11620000
DOUBLE NUM'RECS,                                               <<04846>>11625000
       FENTRY'RECNO;          << File entry record number >>   <<04846>>11630000
                                                               <<04651>>11635000
INTEGER ARRAY                                                  <<04651>>11640000
   LOGON'OFFSETS(0:UDCTYPE'NUMLEVELS-1);                       <<04651>>11645000
                                                                        11650000
LOGICAL ARRAY OPTLINEL(0:126);                                 <<04631>>11655000
BYTE ARRAY OPTLINE(*)=OPTLINEL;                                <<04631>>11660000
LOGICAL ARRAY TCMD(0:500);                                     <<04631>>11665000
BYTE ARRAY TEMPCMD(*)=TCMD;                                    <<04631>>11670000
BYTE ARRAY UDCLEVEL(0:7);                                      <<00884>>11675000
BYTE ARRAY LOGONCMD(0:UDCTYPE'NUMLEVELS*(1+DIRMAXCMDSIZE));    <<04651>>11680000
BYTE ARRAY USER(0:7),ACCOUNT(0:7),WILDCARD(0:7);               <<00416>>11685000
ARRAY DISPLAYBUFF'(0:UDCBUFFSIZE +2);                                   11690000
ARRAY BUFF'(*) = DISPLAYBUFF'(2);                                       11695000
BYTE ARRAY BUFF(*) = BUFF';                                             11700000
ARRAY TEMPBUFF'(0:UDCRECSIZE);                                 <<04846>>11705000
BYTE ARRAY TEMPBUFF(*) = TEMPBUFF';                            <<04846>>11710000
BYTE ARRAY DISPLAYBUFF(*) = DISPLAYBUFF';                               11715000
INTEGER ARRAY                                                  <<01510>>11720000
   FNUMS(0:MAXSCPARMSM1);                                      <<01510>>11725000
                                                                        11730000
POINTER DIR'; BYTE POINTER DIR;                                         11735000
                                                                        11740000
                                                                        11745000
SUBROUTINE DEF'MOVETODSEG;                                              11750000
                                                                        11755000
SUBROUTINE ERR(ERRNO,FN);                                               11760000
   VALUE ERRNO,FN;INTEGER ERRNO,FN;                                     11765000
BEGIN                                                                   11770000
   IF ERRNO > 0 THEN ERROR(ERRNO,FERR,FN);                              11775000
   GO OUTL;                                                             11780000
END;  << ERR >>                                                         11785000
                                                                        11790000
SUBROUTINE UERR(ERRNO,FN);                                              11795000
   VALUE ERRNO,FN;INTEGER ERRNO,FN;                                     11800000
BEGIN << ERROR ON UDC >>                                                11805000
   ERROR(ERRNO,UDCFERR,FN,BUFF(COMFNAME));                              11810000
      << FILE NAME WILL BE USED ONLY IF FN=0>>                          11815000
   GO OUTL;                                                             11820000
END;  << UERR >>                                                        11825000
                                                                        11830000
SUBROUTINE SEMERR(ERRNO);                                               11835000
   VALUE ERRNO; INTEGER ERRNO;                                          11840000
BEGIN << SEMANTIC ERROR >>                                              11845000
      << STACK OVERFLOW, BAD UDC FILE >>                                11850000
   ERROR(ERRNO,UDCERR);                                                 11855000
   GO OUTL;                                                             11860000
END; << SEMERR >>                                                       11865000
                                                               <<06034>>11870000
SUBROUTINE IGNORE'LEVEL;                                       <<06034>>11875000
COMMENT                                                        <<06034>>11880000
  This routine is called in the event that an error is         <<06034>>11885000
  discovered while building the UDC directory at LOGON (i.e.   <<06034>>11890000
  NOT if INITUDC is called from CXSETCATALOG).  The current    <<06034>>11895000
  level of UDCs in process of being built is ignored, which    <<06034>>11900000
  means resetting the current pointer into the directory       <<06034>>11905000
  back a bit and closing the files opened on that level.       <<06034>>11910000
  Note that the variable I contains a value from 0 to 2        <<06919>>11915000
  indicating which level (user, account, system, respectively) <<06919>>11920000
  we are currently at.                                         <<06919>>11925000
                                                               <<06034>>11930000
  The user is issued a warning that a whole level was ignored. <<06034>>11935000
;                                                              <<06034>>11940000
                                                               <<06034>>11945000
BEGIN                                                          <<06034>>11950000
  << OFFSET is the directory offset, reset it to the       >>  <<06919>>11955000
  << previous level                                        >>  <<06919>>11960000
   OFFSET := LEVEL'OFFSET;                                     <<06919>>11965000
                                                               <<06034>>11970000
   <<  Reset the logon offset, in case a logon UDC found >>    <<06919>>11975000
   LOGON'OFFSETS(I)  := -1;                                    <<06919>>11980000
                                                               <<06919>>11985000
   <<  Close all files opened on that level  >>                <<06034>>11990000
   FOR I2 := FNX'LEVEL UNTIL FNX <<  For each file opened  >>  <<06034>>11995000
       DO FCLOSE(FNUMS(I2), 0, 0);  <<  Say goodnight...  >>   <<06034>>12000000
                                                               <<06034>>12005000
<<  Issue warning that a whole level of UDC's is gone  >>      <<06034>>12010000
         CASE I OF        <<  I is the level  >>               <<06034>>12015000
            BEGIN                                              <<06034>>12020000
             ERRNO := IGN'USERLEVEL;                           <<06034>>12025000
             ERRNO := IGN'ACCTLEVEL;                           <<06034>>12030000
             ERRNO := IGN'SYSLEVEL;                            <<06034>>12035000
            END;                                               <<06034>>12040000
         CIERR(-ERRNO);                                        <<06034>>12045000
END;  <<  IGNORE'LEVEL  >>                                     <<06034>>12050000
                                                                        12055000
                                                                        12060000
INTEGER SUBROUTINE CHKOPTION;                                           12065000
<< Subroutine is called for each line of the UDC body until >> <<04631>>12070000
<< FINDOPTIONS goes FALSE inside this routine.  It creates  >> <<04631>>12075000
<< a line containing the UDC's user defined options.  The   >> <<04631>>12080000
<< line is printed in the calling routine after FINDOPTIONS >> <<04631>>12085000
<< is FALSE.  OPTION lines must (and are treated as) follow >> <<04631>>12090000
<< immediately and sequentially after the UDC command       >> <<04631>>12095000
<< definition.                                              >> <<04631>>12100000
<< Only one of NOHELP/HELP, NOBREAK/BREAK, NOLIST/LIST      >> <<04631>>12105000
<< or NOLOGON/LOGON is allowed.                             >> <<04631>>12110000
BEGIN << RETURNS BODYRECNO >>                                           12115000
   FINDPARM(BUFF,SPTR,PTR);                                             12120000
   IF SPTR = "OPTION" THEN                                              12125000
   BEGIN                                                                12130000
      @SAVEPTR := @SPTR;                                       <<01529>>12135000
      HAVEOPTIONS:=TRUE;                                       <<04631>>12140000
      CHKOPTION := RECNONEXT;                                           12145000
      NEXTPARM( PTR, SPTR, PTR );                              <<01529>>12150000
      WHILE SPTR <> 0 DO                                                12155000
      BEGIN                                                             12160000
                                                               <<01529>>12165000
         CASE OPTIONO(SPTR) OF                                          12170000
         BEGIN                                                          12175000
            <<0>> ERROR(-UNKNOWNOPTION,SYNERR,SPTR,SAVEPTR);   <<04631>>12180000
            <<1>> IF HAVELIST=FALSE THEN                       <<04631>>12185000
                     IF HAVENOLIST THEN CIERR(-LISTWARN)       <<04631>>12190000
                        ELSE                                   <<04631>>12195000
                        BEGIN                                  <<04631>>12200000
                        OPTIONS.CIS'OPTLIST:=TRUE;             <<04631>>12205000
                        MOVE OPTLINE(OLEN):=" LIST,";          <<04631>>12210000
                        OLEN:=OLEN+6;                          <<04631>>12215000
                        HAVELIST:=TRUE;                        <<04631>>12220000
                        END;                                   <<04631>>12225000
            <<2>> IF HAVELOGON=FALSE THEN                      <<04631>>12230000
                     IF HAVENOLOGON THEN CIERR(-LOGONWARN)     <<04631>>12235000
                        ELSE                                   <<04631>>12240000
                        BEGIN                                  <<04631>>12245000
                        MOVE OPTLINE(OLEN):=" LOGON,";         <<04631>>12250000
                        IF NOT FOUNDLOGON<<1st logon UDC,this>><<04631>>12255000
                           THEN LOGON'OFFSETS(I)  << level >>  <<04631>>12260000
                                :=OLDOFFSET;                   <<04631>>12265000
                        FOUNDANYLOGON:=FOUNDLOGON:=TRUE;       <<04631>>12270000
                        OPTIONS.CIS'OPTLOGON:=TRUE;            <<04631>>12275000
                        OLEN:=OLEN+7;                          <<04631>>12280000
                        HAVELOGON:=TRUE;                       <<04631>>12285000
                        END;                                   <<04631>>12290000
            <<3>> IF HAVENOHELP=FALSE THEN                     <<04631>>12295000
                     IF HAVEHELP THEN CIERR(-NOHELPWARN)       <<04631>>12300000
                        ELSE                                   <<04631>>12305000
                        BEGIN                                  <<04631>>12310000
                        OPTIONS.CIS'OPTNOHELP:=TRUE;           <<04631>>12315000
                        MOVE OPTLINE(OLEN):=" NOHELP,";        <<04631>>12320000
                        OLEN:=OLEN+8;                          <<04631>>12325000
                        HAVENOHELP:=TRUE;                      <<04631>>12330000
                        END;                                   <<04631>>12335000
            <<4>> IF HAVENOBREAK=FALSE THEN                    <<04631>>12340000
                     IF HAVEBREAK THEN CIERR(-NOBREAKWARN)     <<04631>>12345000
                        ELSE                                   <<04631>>12350000
                        BEGIN                                  <<04631>>12355000
                        HAVENOBREAK:=TRUE;                     <<04631>>12360000
                        OPTIONS.CIS'OPTNOBREAK:=TRUE;          <<04631>>12365000
                        MOVE OPTLINE(OLEN):=" NOBREAK,";       <<04631>>12370000
                        OLEN:=OLEN+9;                          <<04631>>12375000
                        END;                                   <<04631>>12380000
            <<5>> IF HAVENOLIST=FALSE THEN                     <<04631>>12385000
                     IF HAVELIST THEN CIERR(-NOLISTWARN)       <<04631>>12390000
                        ELSE                                   <<04631>>12395000
                        BEGIN                                  <<04631>>12400000
                        MOVE OPTLINE(OLEN):=" NOLIST,";        <<04631>>12405000
                        OLEN:=OLEN+8;                          <<04631>>12410000
                        HAVENOLIST:=TRUE;                      <<04631>>12415000
                        END;                                   <<04631>>12420000
            <<6>> IF HAVENOLOGON=FALSE THEN                    <<04631>>12425000
                     IF HAVELOGON THEN CIERR(-NOLOGONWARN)     <<04631>>12430000
                        ELSE                                   <<04631>>12435000
                        BEGIN                                  <<04631>>12440000
                        MOVE OPTLINE(OLEN):=" NOLOGON,";       <<04631>>12445000
                        OLEN:=OLEN+9;                          <<04631>>12450000
                        HAVENOLOGON:=TRUE;                     <<04631>>12455000
                        END;                                   <<04631>>12460000
            <<7>> IF HAVEHELP=FALSE THEN                       <<04631>>12465000
                     IF HAVENOHELP THEN CIERR(-HELPWARN)       <<04631>>12470000
                        ELSE                                   <<04631>>12475000
                        BEGIN                                  <<04631>>12480000
                        MOVE OPTLINE(OLEN):=" HELP,";          <<04631>>12485000
                        OLEN:=OLEN+6;                          <<04631>>12490000
                        HAVEHELP:=TRUE;                        <<04631>>12495000
                        END;                                   <<04631>>12500000
            <<8>> IF HAVEBREAK = FALSE THEN                    <<04631>>12505000
                     IF HAVENOBREAK THEN CIERR(-BREAKWARN)     <<04631>>12510000
                        ELSE                                   <<04631>>12515000
                        BEGIN                                  <<04631>>12520000
                        MOVE OPTLINE(OLEN):=" BREAK,";         <<04631>>12525000
                        OLEN:=OLEN+7;                          <<04631>>12530000
                        HAVEBREAK:=TRUE;                       <<04631>>12535000
                        END;                                   <<04631>>12540000
              END; << CASE >>                                  <<04631>>12545000
         NEXTPARM( PTR, SPTR, PTR );                           <<01529>>12550000
                                                               <<01529>>12555000
      END;                                                              12560000
   END                                                                  12565000
   ELSE                                                                 12570000
   BEGIN << NO "OPTION">>                                               12575000
      FINDOPTION := FALSE;                                              12580000
      CHKOPTION := RECNO;                                               12585000
   END;                                                                 12590000
END; << CHKOPTION >>                                                    12595000
                                                                        12600000
                                                                        12605000
   << INITUDC MAIN BODY >>                                              12610000
                                                                        12615000
DOLOGON := TRUE;   << CALLED FROM COMMANDINTERP >>                      12620000
GO MAIN;                                                                12625000
                                                                        12630000
                                                                        12635000
INITUDCNO:  << DON'T DO LOGON COMMAND WHILE LOGGED ON>>                 12640000
            << CALLED FROM :SETCATALOG               >>                 12645000
MOVE OPTLINE(0):="    OPTION";                                 <<04631>>12650000
                                                                        12655000
DOLOGON := FALSE;                                                       12660000
COMFN := SETCATCOMFN;  << CXSETCATALOG has already opened and>><<03734>>12665000
                       << locked COMMAND.PUB.SYS.            >><<03734>>12670000
                                                               <<03734>>12675000
                                                                        12680000
MAIN:                                                                   12685000
FGLWDERR := 0;         << Initialize FGETLOCKWORD error >>     <<04846>>12690000
LOGONCMD := CR;     << Blank out logon UDC command image. >>   <<04651>>12695000
MOVE LOGONCMD(1)                                               <<04651>>12700000
   := LOGONCMD, (UDCTYPE'NUMLEVELS*(1+DIRMAXCMDSIZE) );        <<04651>>12705000
                                                               <<04651>>12710000
LOGON'OFFSETS(UDCTYPE'USER) := -1;     << This will hold the >><<04651>>12715000
LOGON'OFFSETS(UDCTYPE'ACCOUNT) := -1;  << directory offsets  >><<04651>>12720000
LOGON'OFFSETS(UDCTYPE'SYSTEM) := -1;   << for logon UDCs.    >><<04651>>12725000
                                                                        12730000
MOVE WILDCARD:="@       ";                                     <<00416>>12735000
ZSIZE(UDCINITSTACKSIZE);                                                12740000
MOVE DISPLAYBUFF' := "    ";                                            12745000
IF DOLOGON THEN        << Not called by CXSETCATALOG.        >><<03734>>12750000
BEGIN                                                          <<03734>>12755000
   MOVE BUFF := "COMMAND.PUB.SYS ";                            <<03734>>12760000
   COMFN := FOPEN( BUFF, 1, %346 );  << Old; SHR,LOCK,EXEC.  >><<03734>>12765000
   IF <> THEN ERR( COMOPENFAIL, COMFN );                       <<03734>>12770000
   OLDCRIT := SETCRITICAL;                                     <<04810>>12775000
   FLOCK( COMFN, TRUE );                                       <<03734>>12780000
   IF <> THEN ERR( COMLOCKFAIL, COMFN );                       <<03734>>12785000
END;                                                           <<03734>>12790000
WHO(,,,USER,,ACCOUNT); <<GET USER'S NAME & ACCOUNT>>           <<00416>>12795000
I:=UDCTYPE'USER-1;<<INIT LOOP CTR FOR SCAN THRU UDC LEVELS>>   <<00416>>12800000
                                                               <<00884>>12805000
<<*************************************>>                      <<00884>>12810000
<<    Start of loop thru UDC levels    >>                      <<00884>>12815000
<<*************************************>>                      <<00884>>12820000
                                                               <<00884>>12825000
WHILE (I:=I+1)<=UDCTYPE'SYSTEM DO                              <<00416>>12830000
BEGIN                                                          <<00416>>12835000
                                                               <<04651>>12840000
   FOUNDLOGON := FALSE;  << Marks logon UDC, this level. >>    <<04651>>12845000
   CASE I OF                                                   <<00416>>12850000
   BEGIN                                                       <<00416>>12855000
      FINDCOMUSER(COMFN,USER,ACCOUNT,UDCSEXIST,RECNO,          <<00884>>12860000
                                          COMRECNO,ERRNO);     <<00884>>12865000
      FINDCOMUSER(COMFN,WILDCARD,ACCOUNT,UDCSEXIST,RECNO,      <<00884>>12870000
                                          COMRECNO,ERRNO);     <<00884>>12875000
      FINDCOMUSER(COMFN,WILDCARD,WILDCARD,UDCSEXIST,RECNO,     <<00884>>12880000
                                        COMRECNO,ERRNO);       <<00884>>12885000
   END;                                                        <<00416>>12890000
   IF ERRNO <> 0 THEN                                          <<00884>>12895000
      IF ERRNO = NOSUCHCOMUSER THEN                            <<00884>>12900000
         BEGIN                                                 <<00884>>12905000
         CASE I OF                                             <<00884>>12910000
            BEGIN                                              <<00884>>12915000
            MOVE UDCLEVEL := ("USER",0);                       <<00884>>12920000
            MOVE UDCLEVEL := ("ACCOUNT",0);                    <<00884>>12925000
            MOVE UDCLEVEL := ("SYSTEM",0);                     <<00884>>12930000
            END;                                               <<00884>>12935000
         CIERR(-NOSUCHCOMUSER,,0,@UDCLEVEL);                   <<00884>>12940000
         GO TO OUTLOOP;                                        <<00884>>12945000
         END                                                   <<00884>>12950000
      ELSE ERR(ERRNO,COMFN);                                   <<00884>>12955000
                                                               <<00884>>12960000
IF NOT UDCSEXIST THEN GO TO OUTLOOP;                           <<00884>>12965000
                                                                        12970000
IF INITIALIZED THEN GO TO GOTINIT;                             <<06034>>12975000
INITIALIZED:=TRUE;                                             <<06034>>12980000
   << CHECK SPACE FOR DIR, GET SPACE >>                                 12985000
ASSEMBLE(ZERO; LRA S-0);                                                12990000
@DIR' := TOS;                                                           12995000
ZSIZE(@DIR' +DIRSIZEM1);                                                13000000
IF > THEN SEMERR(STACKOVERFLOW);                                        13005000
TOS := DIRSIZEM1;                                                       13010000
ASSEMBLE(ADDS 0);                                                       13015000
@DIR := @DIR'&LSL(1);                                                   13020000
                                                                        13025000
   << ZERO DIRECTORY >>                                                 13030000
DIR' := 0;                                                              13035000
MOVE DIR'(1) := DIR',(DIRSIZEM1);                                       13040000
                                                                        13045000
<< SET UP FOR BIG LOOP >>                                               13050000
OLDOFFSET := OFFSET := 0;                                               13055000
GOTINIT:                                                       <<00416>>13060000
   <<**************************************************>>      <<00884>>13065000
   <<    Start of loop thru UDC files at this level    >>      <<00884>>13070000
   <<**************************************************>>      <<00884>>13075000
                                                               <<00884>>13080000
LEVEL'OFFSET := OFFSET; << Remember where the level starts  >> <<06034>>13085000
FNX'LEVEL    := FNX + 1;<< Index to first FNUM for level  >>   <<06034>>13090000
DO BEGIN                                                                13095000
   FREADDIR(COMFN,BUFF',COMRECSIZE,DOUBLE(COMRECNO));                   13100000
   IF <> THEN ERR(COMREADFAIL,COMFN);                                   13105000
   FENTRY'RECNO := DOUBLE(COMRECNO);                           <<04846>>13110000
   COMRECNO := BUFF'(COMLINK);                                          13115000
   UDCFN := PVOPEN(BUFF(COMFNAME),1,%200);<<OLD,EAR>>                   13120000
   IF <> THEN                                                           13125000
   BEGIN                                                                13130000
      SCAN BUFF(COMFNAME) UNTIL "/",1;                                  13135000
      @PTR := TOS;                                                      13140000
      IF NOCARRY THEN << GET RID OF PASSWORD IN FILE NAME >>            13145000
      BEGIN                                                             13150000
         MOVE PTR(1) := PTR(1) WHILE AN,1;                              13155000
         @SPTR := TOS;                                                  13160000
         MOVE PTR := SPTR, (19); << OVERLAY PASSWORD >>                 13165000
      END;                                                              13170000
      ERROR(UDCOPENFAIL,UDCFERR,UDCFN,BUFF(COMFNAME));                  13175000
      IF NOT DOLOGON  << If we were called from setcatalog >>  <<06034>>13180000
      THEN GOTO OUTL << then return, all UDC's are ignored >>  <<06034>>13185000
      ELSE BEGIN   << a logon: ignore UDC's on this level  >>  <<06034>>13190000
        IGNORE'LEVEL;  <<  reset directory and warn user  >>   <<06034>>13195000
        GOTO OUTLOOP;  << go try the next (if any) level >>    <<06034>>13200000
      END;                                                     <<06034>>13205000
   END                                                                  13210000
   ELSE                                                                 13215000
   BEGIN                                                                13220000
      FNUMS( FNX := FNX + 1 ) := UDCFN;  << Save file num >>   <<01510>>13225000
                                                               <<04846>>13230000
   << If UDCs are being initialized through CXSETCATALOG,  >>  <<04846>>13235000
   << then we must ensure that UDC file lockwords appear   >>  <<04846>>13240000
   << in the file entries in COMMAND.PUB.SYS.  This can    >>  <<04846>>13245000
   << only be done after the file is opened, so these      >>  <<04846>>13250000
   << actions are performed here as opposed to within the  >>  <<04846>>13255000
   << CXSETCATALOG executor.  Special handling needs to    >>  <<04846>>13260000
   << happen if the call to FGETLOCKWORD fails--in INITUDC >>  <<04846>>13265000
   << this is signaled by a non-zero FGLWDERR; in          >>  <<04846>>13270000
   << CXSETCATALOG, this is signaled by a negative UDCDSTN.>>  <<04846>>13275000
      IF NOT DOLOGON THEN         << CXSETCATALOG call.        <<04846>>13280000
      BEGIN                                                    <<04846>>13285000
                                                               <<04846>>13290000
         SCAN BUFF(COMFNAME) UNTIL "/.", 1;                    <<04846>>13295000
         IF CARRY                                              <<04846>>13300000
            THEN DEL     << Lockword already in entry.     >>  <<04846>>13305000
         ELSE                                                  <<04846>>13310000
         BEGIN                                                 <<04846>>13315000
                                                               <<04846>>13320000
         << Add lockword to COMMAND.PUB.SYS entry.         >>  <<04846>>13325000
            FLEN := TOS - @BUFF(COMFNAME);                     <<04846>>13330000
            TEMPBUFF := " ";                                   <<04846>>13335000
            MOVE TEMPBUFF(1) := TEMPBUFF, (35);                <<04846>>13340000
            FGLWDLEN := 0;                                     <<04846>>13345000
            MOVE TEMPBUFF(COMFNAME) := BUFF(COMFNAME), (FLEN); <<04846>>13350000
            TEMPBUFF( COMFNAME+FLEN ) := "/";                  <<04846>>13355000
            FGLWDERR := FGETLOCKWORD( UDCFN,                   <<04846>>13360000
                           TEMPBUFF(COMFNAME+FLEN+1),          <<04846>>13365000
                           FGLWDLEN                    );      <<04846>>13370000
            IF FGLWDERR <> 0 THEN GO OUTL;                     <<04846>>13375000
                                                               <<04846>>13380000
            IF FGLWDLEN <> 0 THEN                              <<04846>>13385000
            BEGIN                                              <<04846>>13390000
                                                               <<04846>>13395000
            << If the lockword length is zero, then the    >>  <<04846>>13400000
            << file has no lockword.                       >>  <<04846>>13405000
               TEMPBUFF'(COMLINK) := BUFF'(COMLINK);           <<04846>>13410000
               TEMPBUFF'(COMENTRYTYPE) := BUFF'(COMENTRYTYPE); <<04846>>13415000
               MOVE TEMPBUFF(COMFNAME+FLEN+FGLWDLEN+1)         <<04846>>13420000
                    := BUFF(COMFNAME+FLEN),                    <<04846>>13425000
                 (36-(COMFNAME+FLEN));                         <<04846>>13430000
               FWRITEDIR( COMFN, TEMPBUFF',                    <<04846>>13435000
                          COMRECSIZE, FENTRY'RECNO );          <<04846>>13440000
               IF <> THEN ERR( COMWRITEFAIL, COMFN );          <<04846>>13445000
                                                               <<04846>>13450000
            END;                                               <<04846>>13455000
                                                               <<04846>>13460000
         END;                                                  <<04846>>13465000
                                                               <<04846>>13470000
      END;  << Adding lockwords for SETCATALOGed files. >>     <<04846>>13475000
                                                               <<04846>>13480000
                                                               <<04631>>13485000
      IF SHOW THEN BEGIN                                       <<04631>>13490000
              SCAN BUFF(COMFNAME) UNTIL "/",1;                 <<04631>>13495000
              @PTR:=TOS;                                       <<04631>>13500000
              IF NOCARRY THEN BEGIN << GET RID OF PASSWORD >>  <<04631>>13505000
                              MOVE PTR(1):=PTR(1) WHILE AN,1;  <<04631>>13510000
                              @SPTR:=TOS;                      <<04631>>13515000
                              MOVE PTR:=SPTR,(19);             <<04631>>13520000
                              END;                             <<04631>>13525000
              GENMSG(-1,@BUFF(COMFNAME));                      <<04631>>13530000
              END;                                             <<04631>>13535000
         << DISPLAY FILE NAME >>                                        13540000
                                                                        13545000
      FGETINFO(UDCFN,,,,,,,,,,NUM'RECS);                       <<01306>>13550000
      IF NUM'RECS = 0D THEN SEMERR(UDCEMPTY);                  <<01306>>13555000
         << SET UP FOR LOOP >>                                          13560000
      RECNO := RECNONEXT := 0;                                          13565000
      FINDCMD := TRUE;                                                  13570000
      DO BEGIN << WHIRL THRU FILE & BUILD DIRECTORY >>                  13575000
         READFILE(UDCFN,RECNONEXT,BUFF',ERRNO);                         13580000
                                                               <<04631>>13585000
         IF ERRNO = 0 AND SHOW THEN                            <<01532>>13590000
         BEGIN                                                 <<01532>>13595000
            SCAN DISPLAYBUFF UNTIL 0, 1;                       <<01532>>13600000
            LEN := TOS - @DISPLAYBUFF;                         <<01532>>13605000
             IF FINDCMD THEN                                   <<04631>>13610000
                BEGIN                                          <<04631>>13615000
                HAVEOPTIONS:=FALSE;                            <<04631>>13620000
                MOVE TEMPCMD(0) :=DISPLAYBUFF,(LEN);           <<04631>>13625000
                PASS:=1;                                       <<04631>>13630000
                TEMPLEN:=LEN;                                  <<04631>>13635000
                END;                                           <<04631>>13640000
         END;                                                  <<01532>>13645000
         IF ERRNO <> 0 AND ERRNO <> EOFOUND THEN                        13650000
         BEGIN                                                          13655000
            IF ERRNO = AMPERSANDERR THEN SEMERR(AMPERSANDERR)           13660000
            ELSE UERR(ERRNO,UDCFN);                                     13665000
         END;                                                           13670000
         IF ERRNO = EOFOUND THEN BUFF := "*" ELSE ERRNO:=-1;            13675000
         UPSHIFT(BUFF);  << UPSHIFT EVERYTHING >>                       13680000
         IF FINDCMD THEN                                                13685000
         BEGIN                                                          13690000
            IF ERRNO <> EOFOUND THEN                                    13695000
            BEGIN                                                       13700000
               OPTIONS := FINDCMD := FALSE;                             13705000
               FINDOPTION := TRUE;                                      13710000
                     SCAN BUFF UNTIL " ",1;                    <<01023>>13715000
                     LEN := TOS - @BUFF;                       <<01023>>13720000
                     IF LEN > DIRMAXCMDSIZE THEN               <<01023>>13725000
                        BEGIN                                  <<01023>>13730000
                            << Command over 16 chars >>        <<06034>>13735000
                            ERROR(CMDTOOLONG,IF SHOW THEN      <<01023>>13740000
                            SYNERRNOL ELSE SYNERR,BUFF,BUFF);  <<01531>>13745000
                            IF NOT DOLOGON  << From setcatalog <<06034>>13750000
                            THEN GOTO OUTL  << return >>       <<06034>>13755000
                            ELSE BEGIN  <<   ignore level  >>  <<06034>>13760000
                               IGNORE'LEVEL;  << reset dir. >> <<06034>>13765000
                               GOTO OUTLOOP;  << next level >> <<06034>>13770000
                             END;                              <<06034>>13775000
                        END;                                   <<01023>>13780000
               IF BUFF <> ALPHA THEN                           <<01531>>13785000
               BEGIN                                           <<01531>>13790000
                  << Command not alpha  >>                     <<06034>>13795000
                  ERROR(CMDNOTALPHA,IF SHOW THEN SYNERRNOL     <<01531>>13800000
                        ELSE SYNERR, BUFF, BUFF            );  <<01531>>13805000
                  IF NOT DOLOGON  << From setcatalog >>        <<06034>>13810000
                  THEN GOTO OUTL  << return, we do nothing >>  <<06034>>13815000
                  ELSE BEGIN  <<  logging on: ignore level >>  <<06034>>13820000
                     IGNORE'LEVEL;  << reset directory >>      <<06034>>13825000
                     GOTO OUTLOOP;  << try next level >>       <<06034>>13830000
                  END;                                         <<06034>>13835000
               END;                                            <<01531>>13840000
               MOVE DIR(OFFSET + DIRCMD) := BUFF WHILE AN, 1;  <<01531>>13845000
               LEN := TOS - @DIR(OFFSET + DIRCMD);             <<01531>>13850000
               IF NOT FOUNDLOGON THEN                                   13855000
               BEGIN                                                    13860000
                  MOVE LOGONCMD( I*(1+DIRMAXCMDSIZE) )         <<04651>>13865000
                     := DIR( OFFSET + DIRCMD ), (LEN);         <<04651>>13870000
                  LOGONCMD( I*(1+DIRMAXCMDSIZE) + LEN )        <<04651>>13875000
                     := CR;  << Stopper for the CI >>          <<04651>>13880000
               END;                                                     13885000
               ENTRYLEN := DIRHEADSIZE +(LEN+1)&LSR(1);                 13890000
               DIR(OFFSET):=I;<<INIT LIST AREA WITH UDCTYPE>>  <<00416>>13895000
               DIR(OFFSET +DIRENTRYSIZE):=ENTRYLEN;<<WORDS>>            13900000
               DIR(OFFSET +DIRFILENO) := UDCFN;                         13905000
               DIR(OFFSET +DIRCMDLEN) := LEN;                           13910000
               DIR'(OFFSET&LSR(1) +DIRRECNO) := RECNO;                  13915000
               OLDOFFSET := OFFSET;                                     13920000
               OFFSET := OFFSET +ENTRYLEN*2;                            13925000
               IF OFFSET >= DIRSIZEB THEN ERR(                          13930000
                  TOOMANYCMDSFORDIR,-1);                                13935000
            END;                                                        13940000
         END                                                            13945000
         ELSE                                                           13950000
         BEGIN                                                          13955000
            IF FINDOPTION THEN DIR'(OLDOFFSET&LSR(1) +         <<01127>>13960000
               DIRBODYRECNO) := CHKOPTION;                     <<01127>>13965000
            IF FINDOPTION =FALSE                               <<04631>>13970000
            THEN IF((OPTIONS.CIS'OPTNOHELP=FALSE)LAND(SHOW))   <<04631>>13975000
             THEN BEGIN                                        <<04631>>13980000
                  IF PASS = 1 THEN                             <<04631>>13985000
                     BEGIN                                     <<04631>>13990000
                     PRINT(TCMD,-TEMPLEN,0);                   <<04631>>13995000
                     IF HAVEOPTIONS=TRUE THEN                  <<04631>>14000000
                     PRINT(OPTLINEL,-(OLEN-1),0);              <<04631>>14005000
                     PASS:=0;                                  <<04631>>14010000
                     END;                                      <<04631>>14015000
                  PRINT(DISPLAYBUFF',-LEN,0);                  <<04631>>14020000
                  END;                                         <<04631>>14025000
            IF BUFF = "*" THEN                                 <<01127>>14030000
            BEGIN                                              <<01127>>14035000
               FINDCMD := TRUE;                                <<01127>>14040000
               << NOW STUFF ALL OPTIONS >>                     <<01127>>14045000
               TOS := DIR'(OLDOFFSET&LSR(1));                  <<01127>>14050000
               DIR'(X) := TOS LOR OPTIONS;                     <<01127>>14055000
                     HAVEHELP:=FALSE;                          <<04631>>14060000
                     HAVEBREAK:=FALSE;                         <<04631>>14065000
                     HAVENOLOGON:=FALSE;                       <<04631>>14070000
                     HAVENOLIST:=FALSE;                        <<04631>>14075000
                     OLEN:=10;                                 <<04631>>14080000
                     HAVENOHELP:=FALSE;                        <<04631>>14085000
                     HAVENOBREAK:=FALSE;                       <<04631>>14090000
                     HAVELOGON:=FALSE;                         <<04631>>14095000
                     HAVELIST:=FALSE;                          <<04631>>14100000
            END;                                               <<01127>>14105000
         END;                                                           14110000
         RECNO := RECNONEXT;                                            14115000
      END UNTIL ERRNO <> -1;                                            14120000
   END;                                                                 14125000
END UNTIL COMRECNO = 0;                                                 14130000
                                                               <<00884>>14135000
   <<**************************************************>>      <<00884>>14140000
   <<    End of loop thru UDC files at this level      >>      <<00884>>14145000
   <<**************************************************>>      <<00884>>14150000
                                                               <<00884>>14155000
OUTLOOP:                                                       <<00416>>14160000
END;                                                           <<00416>>14165000
                                                               <<00884>>14170000
<<*************************************>>                      <<00884>>14175000
<<    End of loop thru UDC levels      >>                      <<00884>>14180000
<<*************************************>>                      <<00884>>14185000
                                                               <<00884>>14190000
IF OFFSET = 0 THEN   <<  0 Offset means no directory ...  >>   <<06034>>14195000
   GO TO OUTL;       <<  and thus no UDC's  >>                 <<06034>>14200000
<< create a zero filled "entry" at the end of the UDC >>       <<07366>>14205000
<< DST the max. size of an entry (12 words plus one for>>      <<07366>>14210000
<< a delimiter).  This is done so that if the UDC being>>      <<07366>>14215000
<< executed is the last UDC in the DST we do not look  >>      <<07366>>14220000
<< any further to try and match up the command names   >>      <<07366>>14225000
<< in the body of that UDC with any UDC names in that DST>>    <<07366>>14230000
MOVE DIR(OFFSET +DIRENTRYSIZE) := 26(0);<<DIR delimiter>>      <<07366>>14235000
OFFSET := OFFSET +26; << for extra 0's at end of dir. >>       <<07366>>14240000
OFFSET := OFFSET&LSR(1) +DIRHEAD; << in words >>               <<06920>>14245000
<< LEN is the # of sectors for the data segment >>             <<06920>>14250000
LEN := LOGICAL(OFFSET+127) LAND %177600;                                14255000
UDCDSTN := GETDATASEG(LEN,LEN);                                         14260000
IF UDCDSTN = 0 THEN ERR(GETDATASEGERR,-1);                              14265000
MOVETODSEG(UDCDSTN,0,@DIR',OFFSET);                                     14270000
                                                                        14275000
UDCDSTNO := UDCDSTN; << SET UDC ON GLOBALLY >>                 <<04603>>14280000
                                                                        14285000
   << GIVE BACK DIRECTORY STACK SPACE >>                                14290000
TOS := DIRSIZEM1;                                                       14295000
ASSEMBLE(SUBS 0); << NOW CAN DO UDC >>                                  14300000
                                                                        14305000
<< Close COMMAND.PUB.SYS only if it was opened in INITUDC.   >><<03767>>14310000
<< Do not close the file if INITUDCNO (from CXSETCATALOG) was>><<03767>>14315000
<< the invoking entry point.  FCLOSE will handle unlocking   >><<03767>>14320000
<< the file.                                                 >><<03767>>14325000
IF DOLOGON THEN                                                <<04810>>14330000
BEGIN                                                          <<04810>>14335000
   FCLOSE( COMFN, 0, 0 );                                      <<04810>>14340000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>14345000
END;                                                           <<04810>>14350000
                                                               <<03767>>14355000
IF DOLOGON AND FOUNDANYLOGON THEN                              <<04651>>14360000
BEGIN                                                                   14365000
   COMMENT:                                                    <<00863>>14370000
      A CHECK IS MADE AT THIS POINT TO MAKE SURE WE DON'T      <<00863>>14375000
      EXECUTE A UDC AT LOGON THAT HAPPENS TO HAVE THE SAME     <<00863>>14380000
      NAME AS A LOGON UDC AT A LOWER (I.E., ACCT OR SYS) UDC   <<00863>>14385000
      LEVEL;                                                   <<00863>>14390000
                                                               <<04651>>14395000
<< Logon UDCs are executed in the System, Account, User  >>    <<04651>>14400000
<< order, with only one UDC per level executed.          >>    <<04651>>14405000
I := UDCTYPE'SYSTEM;                                           <<04651>>14410000
DO                                                             <<04651>>14415000
BEGIN                                                          <<04651>>14420000
   OFFSET := LOGON'OFFSETS(I);                                 <<04651>>14425000
   IF OFFSET > -1 THEN                      << Found logon >>  <<04651>>14430000
   BEGIN                                                       <<04651>>14435000
                                                               <<04651>>14440000
    OFFSET := OFFSET / 2;  << SEARCHUDC expects offset to  >>  <<04651>>14445000
    OLDOFFSET := OFFSET;   << be a word index into DIR.    >>  <<04651>>14450000
    IF SEARCHUDC( LOGONCMD( I*(1+DIRMAXCMDSIZE) ), OFFSET,     <<04651>>14455000
                  UDCFN, RECNO, RECNO, OPTIONS )               <<04651>>14460000
      THEN                                                     <<00863>>14465000
   BEGIN                                                       <<00863>>14470000
      IF OPTIONS.CIS'OPTLOGON THEN                             <<04603>>14475000
      BEGIN                                                    <<00863>>14480000
         MOVE CIS'BCOMIMAGE                                    <<04651>>14485000
             := LOGONCMD( I * (1+DIRMAXCMDSIZE) ),             <<04651>>14490000
                (DIRMAXCMDSIZE+1);  << Include the CR. >>      <<04651>>14495000
         UDC( CIS'BCOMIMAGE, OLDOFFSET );                      <<04651>>14500000
      END;                                                     <<00863>>14505000
   END                                                         <<00863>>14510000
   ELSE                                                        <<00863>>14515000
      SUDDENDEATH(535); << COULDN'T FIND LOGON CMD IN DIR >>   <<00863>>14520000
                                                               <<04651>>14525000
   END;                                                        <<04651>>14530000
                                                               <<04651>>14535000
END UNTIL (I := I-1) < UDCTYPE'USER;                           <<04651>>14540000
                                                               <<04651>>14545000
END;                                                                    14550000
                                                               <<03767>>14555000
                                                               <<03767>>14560000
RETURN;                                                                 14565000
                                                                        14570000
   << NORMAL EXIT >>                                                    14575000
                                                                        14580000
OUTL:                                                                   14585000
                                                               <<03767>>14590000
<< Close COMMAND.PUB.SYS only if it was opened in INITUDC.   >><<03767>>14595000
<< Do not close the file if INITUDCNO (from CXSETCATALOG) was>><<03767>>14600000
<< the invoking entry point.  FCLOSE will handle unlocking   >><<03767>>14605000
<< the file.                                                 >><<03767>>14610000
IF DOLOGON THEN                                                <<04810>>14615000
BEGIN                                                          <<04810>>14620000
   FCLOSE( COMFN, 0, 0 );                                      <<04810>>14625000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>14630000
END;                                                           <<04810>>14635000
                                                               <<04846>>14640000
   << If FGETLOCKWORD failed, inform CXSETCATALOG.      >>     <<04846>>14645000
      IF FGLWDERR <> 0 THEN                                    <<04846>>14650000
      BEGIN                                                    <<04846>>14655000
         UDCDSTNO := -1;                                       <<04846>>14660000
         FERROR'( UDCFN, FGLWDERR );                           <<04846>>14665000
         << CXSETCATALOG prints CI error. >>                   <<04846>>14670000
      END;                                                     <<04846>>14675000
                                                               <<04846>>14680000
FOR I := FNX STEP -1 UNTIL 0  << CLOSE UDCFILE IF ERROR >>     <<01510>>14685000
   DO  FCLOSE( FNUMS(I), 0, 0 );                               <<01510>>14690000
                                                               <<04846>>14695000
END; << INITUDC >>                                                      14700000
$TITLE "OPTIONO"                                                        14705000
INTEGER PROCEDURE OPTIONO(STRING);                                      14710000
   VALUE STRING;                                                        14715000
   BYTE POINTER STRING;                                                 14720000
   OPTION INTERNAL;                                                     14725000
COMMENT                                                                 14730000
   RETURNS AN INDEX (OPTION NO.) INTO THE ARRAY OF                      14735000
   VALID NAMES FOLLOWING "OPTION"                                       14740000
;                                                                       14745000
BEGIN                                                                   14750000
                                                                        14755000
INTEGER LEN;                                                            14760000
                                                                        14765000
BYTE ARRAY DICT(*) = PB :=                                              14770000
   6,4,"LIST",    << 1 >>                                               14775000
   7,5,"LOGON",   << 2 >>                                               14780000
   8,6,"NOHELP",  << 3 >>                                               14785000
   9,7,"NOBREAK", << 4 >>                                               14790000
   8,6,"NOLIST",  << 5 >>   << DEFAULT OPTIONS >>              <<01529>>14795000
   9,7,"NOLOGON", << 6 >>                                      <<01529>>14800000
   6,4,"HELP",    << 7 >>                                      <<01529>>14805000
   7,5,"BREAK",   << 8 >>                                      <<01529>>14810000
   0;                                                                   14815000
                                                                        14820000
BYTE ARRAY ENDICT(*) = PB := 0; << END ADDRESS OF DICT >>               14825000
                                                                        14830000
BYTE POINTER DICTP;                                                     14835000
                                                                        14840000
TOS := 0;                                                               14845000
@DICTP := @S0 &LSL(1);      << BYTE ADDRESS        >>                   14850000
TOS := X := (@ENDICT -@DICT -1) &LSR(1);                                14855000
                            << WORD LENGTH OF DICT >>                   14860000
ASSEMBLE( ADDS 0);          << ALLOCTE SPACE       >>                   14865000
TOS := @DICTP &LSR(1);      << WORD ADR TARGET     >>                   14870000
TOS := @DICT &LSR(1);       << WORD ADR SOURCE     >>                   14875000
TOS := X;                   << COUNT               >>                   14880000
ASSEMBLE( MOVE PB );        << PUT DICT INTO STACK >>                   14885000
                                                                        14890000
MOVE STRING := STRING WHILE ANS,1;                                      14895000
LEN := TOS -@STRING;                                                    14900000
                                                                        14905000
OPTIONO := SEARCH(STRING,LEN,DICTP);                                    14910000
                                                                        14915000
END; << OPTIONO >>                                                      14920000
$TITLE "PARSECOM"                                                       14925000
PROCEDURE PARSECOM(COMPTR,NUMHEADPARMS,PARMSINFO,ERRNO);                14930000
   VALUE COMPTR,NUMHEADPARMS;                                           14935000
   BYTE POINTER COMPTR;                                                 14940000
   INTEGER NUMHEADPARMS,ERRNO;                                          14945000
   ARRAY PARMSINFO;                                                     14950000
   OPTION UNCALLABLE;                                                   14955000
COMMENT                                                                 14960000
   PARSES IMAGE TYPED AT TERMINAL & MATCHES PARMS WITH                  14965000
   THOSE FOUND IN UDCHEAD.                                              14970000
;                                                                       14975000
BEGIN                                                                   14980000
                                                                        14985000
INTEGER                                                                 14990000
   PARMCOUNT,                                                           14995000
   PLEN,                                                                15000000
   COUNT,                                                               15005000
   DLEN;                                                                15010000
BYTE POINTER                                                            15015000
   SAVEIMAGE,                                                           15020000
   PTR,                                                                 15025000
   FORMALNAMEPTR,                                                       15030000
   BADSPOTPTR := @FORMALNAMEPTR,                                        15035000
   HPTR;                                                                15040000
LOGICAL                                                                 15045000
   KEYWORD;                                                             15050000
                                                                        15055000
SUBROUTINE ERR(ERRN,PTR);                                               15060000
   VALUE ERRN; INTEGER ERRN;                                            15065000
   BYTE ARRAY PTR;                                                      15070000
BEGIN                                                                   15075000
   ERRNO := ERRN;                                                       15080000
   ERROR(ERRNO,IMAGERR,PTR,SAVEIMAGE);                                  15085000
   GO OUTL;                                                             15090000
END; << ERR >>                                                          15095000
                                                                        15100000
@SAVEIMAGE := @COMPTR;                                                  15105000
KEYWORD := FALSE;                                                       15110000
PARMCOUNT := ERRNO := 0;                                                15115000
                                                                        15120000
   << FIND 1ST NON-BLANK AFTER COMMAND >>                               15125000
SCAN COMPTR WHILE " ",1;                                                15130000
ASSEMBLE(DUP);                                                          15135000
MOVE * := * WHILE ANS,1;                                                15140000
SCAN * WHILE " ",1;                                                     15145000
@PTR := TOS;                                                            15150000
                                                                        15155000
IF PTR = "," OR PTR = ";" THEN PARMCOUNT := 1;                          15160000
   << AT DELIMITER ?                        >>                          15165000
   << POSITIONAL PARMS, 1ST PARM IS OMITTED >>                          15170000
WHILE PTR <> 0 DO                                                       15175000
BEGIN                                                                   15180000
   PARMCOUNT := PARMCOUNT +1;                                           15185000
   IF PARMCOUNT > UDCMAXPARMS THEN ERR(TOOMANYPARMS,PTR(1));   <<01125>>15190000
   IF PARMCOUNT > NUMHEADPARMS THEN ERR(EXCESSPARMS,PTR(1));   <<01125>>15195000
   PLEN := NEXTPARM(PTR,COMPTR,PTR);                                    15200000
   IF < THEN ERR(NOCLOSEQUOTE,COMPTR);                                  15205000
   IF = THEN                                                            15210000
   BEGIN                                                                15215000
      IF KEYWORD THEN ERR(EXPECTPARM,COMPTR);                           15220000
   END                                                                  15225000
   ELSE                                                                 15230000
   BEGIN                                                                15235000
         << LOOK FOR "=" TO IND. KEYWORD >>                             15240000
      IF PARMCOUNT = 1 AND PTR = "=" THEN KEYWORD := TRUE;              15245000
            << DO NOT ALLOW POSITIONAL AND KEYWORDED >>        <<01049>>15250000
            << AT THE SAME TIME.                     >>        <<01049>>15255000
        IF (KEYWORD LAND PTR <> "=") OR                        <<01049>>15260000
           (NOT KEYWORD LAND PTR = "=") THEN                   <<01049>>15265000
           ERR(NOTYPEMIX,COMPTR);                              <<01049>>15270000
      IF NOT KEYWORD THEN                                               15275000
      BEGIN << PLACE INTO 'DEFAULT' >>                                  15280000
         PARMSINFO((PARMCOUNT -1)*3 +2) := @COMPTR;                     15285000
         PARMSINFO((PARMCOUNT -1)*3).(8:8) := PLEN;                     15290000
      END                                                               15295000
      ELSE                                                              15300000
      BEGIN << KEYWORD >>                                               15305000
                                                                        15310000
            << CHECK OUT FORMAL NAME >>                                 15315000
         IF COMPTR <> ALPHA THEN ERR(FMLNAMENOTALPHA,COMPTR);           15320000
                                                                        15325000
            << UPSHIFT >>                                               15330000
         MOVE COMPTR := COMPTR WHILE ANS,1;                             15335000
         @BADSPOTPTR := TOS;                                            15340000
         IF @COMPTR +PLEN <> @BADSPOTPTR THEN ERR(                      15345000
            INVFORMALNAME,BADSPOTPTR);                                  15350000
                                                                        15355000
         @FORMALNAMEPTR := @COMPTR; <<FORMAL NAME>>                     15360000
            << NOW FIND 2ND PART OF PARM PAIR>>                         15365000
         DLEN := NEXTPARM(PTR,COMPTR,PTR);                              15370000
         IF < THEN ERR(NOCLOSEQUOTE,PTR);                               15375000
         IF = THEN ERR(EXPECTPARM,PTR);                                 15380000
            << NOW LOOK FOR MATCH >>                                    15385000
         COUNT := -1;                                                   15390000
         WHILE (COUNT := COUNT +1) < NUMHEADPARMS DO                    15395000
         BEGIN                                                          15400000
            @HPTR := PARMSINFO(COUNT*3 +1);                             15405000
            IF PLEN = INTEGER(PARMSINFO(COUNT*3).(0:8)) THEN            15410000
               IF FORMALNAMEPTR = HPTR,(PLEN) THEN                      15415000
            BEGIN << MATCH >>                                           15420000
               IF DLEN > 0 THEN                                         15425000
               BEGIN                                                    15430000
                  PARMSINFO(COUNT*3).(8:8) := DLEN;                     15435000
                  PARMSINFO(COUNT*3 +2) := @COMPTR;                     15440000
                  GO MATCH;                                             15445000
               END;                                                     15450000
            END;                                                        15455000
         END;                                                           15460000
            << NO MATCH >>                                              15465000
         ERR(UNKNOWNPARM,COMPTR);                                       15470000
MATCH:                                                                  15475000
      END; << KEYWORD USED >>                                           15480000
   END;                                                                 15485000
END; << LOOP >>                                                         15490000
OUTL:                                                                   15495000
                                                                        15500000
END; << PARSECOM >>                                                     15505000
$TITLE "PARSEUDCHEAD"                                                   15510000
PROCEDURE PARSEUDCHEAD(UDCPTR,NUMPARMS,PARMS,OPTIONS,ERRNO);            15515000
   VALUE UDCPTR,OPTIONS;                                                15520000
   BYTE POINTER UDCPTR;                                                 15525000
   INTEGER NUMPARMS,ERRNO;                                              15530000
   ARRAY PARMS;                                                         15535000
   LOGICAL OPTIONS;                                                     15540000
   OPTION UNCALLABLE;                                                   15545000
COMMENT  PARMS IS 3 WORD ENTRY:                                         15550000
   ******************************                                       15555000
   * PARM LEN   * DEFAULT LEN   *                                       15560000
   ******************************                                       15565000
   *     <FORMALNAME PTR>       *                                       15570000
   ******************************                                       15575000
   *      <DEFAULT PTR>         *                                       15580000
   ******************************                                       15585000
;                                                                       15590000
BEGIN                                                                   15595000
                                                                        15600000
INTEGER                                                                 15605000
   PLEN;                                                                15610000
BYTE POINTER                                                            15615000
   PTR,                                                                 15620000
   UDCBASE,                                                             15625000
   BADSPOTPTR;                                                          15630000
                                                                        15635000
SUBROUTINE ERR(ERRN,PTR);                                               15640000
   VALUE ERRN;                                                          15645000
   INTEGER ERRN; BYTE ARRAY PTR;                                        15650000
BEGIN                                                                   15655000
   ERROR(ERRN,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL          <<04603>>15660000
                                       ELSE SYNERR,            <<04603>>15665000
      PTR,UDCBASE);                                                     15670000
   ERRNO := ERRN;                                                       15675000
   GO OUTL;                                                             15680000
END;                                                                    15685000
                                                                        15690000
NUMPARMS := 0;                                                          15695000
@UDCBASE := @UDCPTR;                                                    15700000
FINDPARM(UDCPTR,UDCPTR,PTR); <<PTR AT 1ST DELIM>>                       15705000
WHILE PTR <> 0 DO                                                       15710000
BEGIN                                                                   15715000
   NUMPARMS := NUMPARMS +1;                                             15720000
   IF NUMPARMS > UDCMAXPARMS THEN ERR(TOOMANYPARMS,UDCPTR);             15725000
   PLEN := NEXTPARM(PTR,UDCPTR,PTR);                                    15730000
   IF < THEN ERR(NOCLOSEQUOTE,UDCPTR);                                  15735000
   IF = THEN ERR(EXPECTPARM,UDCPTR);                                    15740000
                                                                        15745000
      << CHECK OUT FORMAL NAME >>                                       15750000
   IF UDCPTR = "!" THEN                                                 15755000
   BEGIN << "!" PRECEDES FORMAL NAME >>                                 15760000
      @UDCPTR := @UDCPTR +1;                                            15765000
      PLEN := PLEN -1;                                                  15770000
   END;                                                                 15775000
                                                                        15780000
   IF UDCPTR <> ALPHA THEN ERR(FMLNAMENOTALPHA,UDCPTR);                 15785000
      << UPSHIFT >>                                                     15790000
   MOVE UDCPTR := UDCPTR WHILE ANS,1;                                   15795000
   @BADSPOTPTR := TOS;                                                  15800000
   IF @UDCPTR +PLEN <> @BADSPOTPTR THEN ERR(INVFORMALNAME,              15805000
      BADSPOTPTR);                                                      15810000
                                                                        15815000
      << STUFF PLEN & PTR INTO PARMS >>                                 15820000
   PARMS((NUMPARMS -1)*3) := 0;                                         15825000
   PARMS(X).(0:8) := PLEN;                                              15830000
   PARMS(X:=X+1) := @UDCPTR;                                            15835000
   IF PTR = "=" THEN                                                    15840000
   BEGIN << DEFAULT PROVIDED >>                                         15845000
      PLEN := NEXTPARM(PTR,UDCPTR,PTR);                                 15850000
      IF < THEN ERR(NOCLOSEQUOTE,UDCPTR);                               15855000
      IF = THEN ERR(EXPECTPARM,UDCPTR);                                 15860000
         << STUFF DEFAULT LEN & PTR INTO PARMS >>                       15865000
      PARMS((NUMPARMS -1)*3).(8:8) := PLEN;                             15870000
      PARMS(X:=X+2) := @UDCPTR;                                         15875000
   END;                                                                 15880000
END; << PARM LOOP >>                                                    15885000
                                                                        15890000
OUTL:                                                                   15895000
END; << PARSEUDCHEAD >>                                                 15900000
$TITLE "READFILE"                                                       15905000
PROCEDURE READFILE(FN,RECNO,BUFF',ERRNO);                               15910000
   VALUE FN;                                                            15915000
   INTEGER FN,RECNO,ERRNO;                                              15920000
   ARRAY BUFF';                                                         15925000
   OPTION UNCALLABLE;                                                   15930000
COMMENT                                                                 15935000
   USED TO READ UDC HEAD OR BODY RECORDS UNTIL NO CONTINUATION          15940000
   RECORD IS FOUND.                                                     15945000
   RETURNS NEXT RECORD # IN RECNO.                                      15950000
;                                                                       15955000
BEGIN                                                                   15960000
                                                                        15965000
POINTER PTR';                                                           15970000
BYTE POINTER PTR;                                                       15975000
INTEGER LEN;                                                            15980000
LOGICAL AMPERSAND;                                                      15985000
                                                                        15990000
AMPERSAND := FALSE;                                                     15995000
ERRNO := -1;                                                            16000000
@PTR' := @BUFF';                                                        16005000
@PTR := @BUFF' & LSL(1);                                                16010000
PTR := 0;                                                               16015000
DO BEGIN                                                                16020000
   FREADDIR(FN,PTR',UDCRECSIZE,DOUBLE(RECNO));                          16025000
   IF < THEN ERRNO := UDCREADFAIL                                       16030000
   ELSE                                                                 16035000
   IF > THEN ERRNO := IF AMPERSAND THEN AMPERSANDERR                    16040000
      ELSE EOFOUND                                                      16045000
   ELSE                                                                 16050000
   BEGIN                                                                16055000
      RECNO := RECNO +1;                                                16060000
      LEN := DEBLANK(PTR,UDCRECSIZEB -8);                               16065000
      PTR(LEN) := 0;                                                    16070000
      IF LEN > 0 AND PTR(LEN -1) = "&" THEN                             16075000
      BEGIN                                                             16080000
         AMPERSAND := TRUE;                                             16085000
         PTR(LEN -1) := " ";                                            16090000
         IF LOGICAL(LEN) THEN                                           16095000
         BEGIN                                                          16100000
            PTR(LEN) := " ";                                            16105000
            LEN := LEN +1;                                              16110000
         END;                                                           16115000
         @PTR := @PTR(LEN);                                             16120000
         @PTR' := @PTR&LSR(1);                                          16125000
         IF (@PTR' -@BUFF') +UDCRECSIZE >= UDCBUFFSIZE THEN             16130000
            ERRNO := TOOMANYREC                                         16135000
         ELSE                                                           16140000
      END                                                               16145000
      ELSE ERRNO := 0;                                                  16150000
   END;                                                                 16155000
END UNTIL ERRNO <> -1;                                                  16160000
                                                                        16165000
END; << READFILE >>                                                     16170000
$TITLE "RECIPUDC"                                                       16175000
INTEGER PROCEDURE RECIPUDC(NTRY,LEVEL,INX,SIRS);                        16180000
   VALUE LEVEL,INX,SIRS;                                                16185000
   INTEGER LEVEL,INX;                                                   16190000
   DOUBLE SIRS;                                                         16195000
   ARRAY NTRY;                                                          16200000
   OPTION UNCALLABLE;                                                   16205000
COMMENT                                                                 16210000
   Called by DIRECSCAN of UDCDIRCREAD/UDCDIRCWRITE to          <<00884>>16215000
   read/write command file record numbers from/to the system   <<00884>>16220000
   directory. NTRY is the user or account entry being visited. <<00884>>16225000
   OWNARRAY(INX) is the PARMARRAY of UDCDIRCREAD/UDCDIRCWRITE. <<00884>>16230000
                                                               <<00884>>16235000
      OWNARRAY(INX+0) = Read/Write indicator                   <<00884>>16240000
      OWNARRAY(INX+1) = UDC type (user,account,system)         <<00884>>16245000
      OWNARRAY(INX+2) = Command file record number             <<00884>>16250000
      OWNARRAY(INX+3) = UDC's exist flag                       <<00884>>16255000
;                                                                       16260000
BEGIN                                                                   16265000
                                                                        16270000
INTEGER DELTAQ = Q-0;                                                   16275000
ARRAY DDS(*) = DB +0;                                                   16280000
ARRAY OWNARRAY(*) = Q+0;                                                16285000
                                                                        16290000
EQUATE                                                                  16295000
   DADIRTY = %221;                                             <<00884>>16300000
DEFINE DIRTYF = (15:1) #;                                               16305000
                                                                        16310000
INX := INX -DELTAQ;                                                     16315000
CASE OWNARRAY(INX+1) OF                                        <<00416>>16320000
BEGIN                                                          <<00416>>16325000
<< User Level >>                                               <<00884>>16330000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>16335000
      BEGIN                                                    <<00884>>16340000
      NTRY(USERUDCPTR) := OWNARRAY(INX+2);                     <<00884>>16345000
      NTRY(USERUDCBIT) := OWNARRAY(INX+3);                     <<00884>>16350000
      END                                                      <<00884>>16355000
   ELSE                                                        <<00884>>16360000
      BEGIN                                                    <<00884>>16365000
      OWNARRAY(INX+2) := NTRY(USERUDCPTR);                     <<00884>>16370000
      OWNARRAY(INX+3) := NTRY(USERUDCBIT);                     <<00884>>16375000
      END;                                                     <<00884>>16380000
                                                               <<00884>>16385000
<< Account Level >>                                            <<00884>>16390000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>16395000
      BEGIN                                                    <<00884>>16400000
      NTRY(ACCTUDCPTR) := OWNARRAY(INX+2);                     <<00884>>16405000
      NTRY(ACCTUDCBIT) := OWNARRAY(INX+3);                     <<00884>>16410000
      END                                                      <<00884>>16415000
   ELSE                                                        <<00884>>16420000
      BEGIN                                                    <<00884>>16425000
      OWNARRAY(INX+2) := NTRY(ACCTUDCPTR);                     <<00884>>16430000
      OWNARRAY(INX+3) := NTRY(ACCTUDCBIT);                     <<00884>>16435000
      END;                                                     <<00884>>16440000
                                                               <<00884>>16445000
<< System Level >>                                             <<00884>>16450000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>16455000
      BEGIN                                                    <<00884>>16460000
      NTRY(SYSUDCPTR) := OWNARRAY(INX+2);                      <<00884>>16465000
      NTRY(SYSUDCBIT) := OWNARRAY(INX+3);                      <<00884>>16470000
      END                                                      <<00884>>16475000
   ELSE                                                        <<00884>>16480000
      BEGIN                                                    <<00884>>16485000
      OWNARRAY(INX+2) := NTRY(SYSUDCPTR);                      <<00884>>16490000
      OWNARRAY(INX+3) := NTRY(SYSUDCBIT);                      <<00884>>16495000
      END;                                                     <<00884>>16500000
END;                                                           <<00884>>16505000
IF OWNARRAY(INX) = DIRCWRITE THEN                              <<00884>>16510000
   DDS(DADIRTY).DIRTYF  := 1;                                  <<00884>>16515000
RECIPUDC := 5; <<SIRS NOT RELEASED. STOP SCAN >>                        16520000
                                                                        16525000
END; << RECIPUDC >>                                                     16530000
$TITLE "RELCOMREC"                                                      16535000
PROCEDURE RELCOMREC(COMFN,RECNO,ERRNO);                                 16540000
   VALUE COMFN,RECNO;                                                   16545000
   INTEGER COMFN,RECNO,ERRNO;                                           16550000
   OPTION UNCALLABLE;                                                   16555000
COMMENT - RETURNS RECORD FROM COMMAND.PUB.SYS TO FREE LIST              16560000
;                                                                       16565000
<< Assumptions:  This procedure assumes that COMMAND.PUB.SYS >><<03734>>16570000
<<    (file number = COMFN) has been locked by the calling   >><<03734>>16575000
<<    procedure.                                             >><<03734>>16580000
                                                               <<03734>>16585000
BEGIN                                                                   16590000
                                                                        16595000
ARRAY REC0(0:COMRECSIZEM1);                                             16600000
ARRAY REC(0:COMRECSIZEM1);                                              16605000
                                                                        16610000
SUBROUTINE READ(BUF,REC);                                               16615000
   VALUE REC;                                                           16620000
   ARRAY BUF;                                                           16625000
   INTEGER REC;                                                         16630000
BEGIN                                                                   16635000
   FREADDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                          16640000
   IF <> THEN                                                           16645000
   BEGIN                                                                16650000
      ERRNO := COMREADFAIL;                                             16655000
      GO OUTL;                                                          16660000
   END;                                                                 16665000
END; << READ >>                                                         16670000
                                                                        16675000
SUBROUTINE WRITE(BUF,REC);                                              16680000
   VALUE REC;                                                           16685000
   ARRAY BUF;                                                           16690000
   INTEGER REC;                                                         16695000
BEGIN                                                                   16700000
   FWRITEDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                         16705000
   IF <> THEN                                                           16710000
   BEGIN                                                                16715000
      ERRNO := COMWRITEFAIL;                                            16720000
      GO OUTL;                                                          16725000
   END;                                                                 16730000
END; << WRITE >>                                                        16735000
                                                                        16740000
   ERRNO := 0;                                                 <<03734>>16745000
   READ(REC0,0);                                                        16750000
      << READ RETURNED RECORD & MARK AS NEW FREE HEAD>>                 16755000
   READ(REC,RECNO);                                                     16760000
   REC(COMLINK) := REC0(COMFREEHEAD);                                   16765000
   REC(COMENTRYTYPE) := COMFREEENTRY;                                   16770000
   WRITE(REC,RECNO);                                                    16775000
      << UPDATE HEAD RECORD >>                                          16780000
   REC0(COMFREEHEAD) := RECNO;                                          16785000
   REC0(COMUSE) := REC0(COMUSE) -1;                                     16790000
   WRITE(REC0,0);                                                       16795000
                                                                        16800000
OUTL:                                                                   16805000
END; << RELCOMREC >>                                                    16810000
$TITLE "SEARCHUDC"                                                      16815000
LOGICAL PROCEDURE SEARCHUDC(STRING,OFFSET,UDCFN,                        16820000
      RECNO,BODYRECNO,OPTIONS);                                         16825000
   INTEGER UDCFN,OFFSET,RECNO,BODYRECNO;                                16830000
   BYTE ARRAY STRING;                                                   16835000
   LOGICAL OPTIONS;                                                     16840000
   OPTION UNCALLABLE;                                                   16845000
BEGIN                                                                   16850000
                                                                        16855000
INTEGER                                                                 16860000
   ENTRYLEN,                                                            16865000
   LEN,                                                                 16870000
   CMDLEN;                                                              16875000
                                                                        16880000
                                                                        16885000
BYTE POINTER PTR;                                                       16890000
                                                                        16895000
ARRAY DIR'(0:DIRMAXENTRYSIZE); BYTE ARRAY DIR(*) = DIR';                16900000
                                                                        16905000
SUBROUTINE DEF'MOVEFROMDSEG;                                            16910000
                                                                        16915000
SCAN STRING WHILE " ",1;                                                16920000
@PTR := TOS;                                                            16925000
MOVE PTR := PTR WHILE ANS,1;                                            16930000
CMDLEN := TOS -@PTR;                                                    16935000
ENTRYLEN := DIRMAXENTRYSIZE; << LARGEST >>                              16940000
DO BEGIN                                                                16945000
   <<GET DIRECTORY ONE ENTRY AT A TIME>>                                16950000
   <<GET ENTRY + LENGTH OF NEXT ENTRY (2 MORE BYTES>>          <<06920>>16955000
   MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN+DIRHEAD);       <<04603>>16960000
   LEN := DIR(DIRENTRYSIZE); << size of this entry >>          <<06920>>16965000
   ENTRYLEN := DIR(LEN*2 +DIRENTRYSIZE); <<next entry len>>    <<06920>>16970000
   OFFSET := OFFSET +LEN;                                               16975000
   IF LEN <> 0 THEN                                                     16980000
   BEGIN     << is not last entry >>                           <<06920>>16985000
      IF CMDLEN = INTEGER(DIR(DIRCMDLEN)) AND PTR = DIR                 16990000
         (DIRCMD),(CMDLEN) THEN                                         16995000
      BEGIN                                                             17000000
         SEARCHUDC := TRUE;                                             17005000
         OPTIONS := DIR';<<LIST,LOGON,NOHELP,NOBREAK>>                  17010000
         RECNO := DIR'(DIRRECNO);                                       17015000
         BODYRECNO := DIR'(DIRBODYRECNO);                               17020000
         UDCFN := DIR(DIRFILENO);                                       17025000
         ENTRYLEN := 0;    << SO LOOP WILL END >>                       17030000
      END;                                                              17035000
   END;                                                                 17040000
END UNTIL ENTRYLEN = 0;                                        <<07178>>17045000
                                                                        17050000
END; << SEARCHUDC >>                                                    17055000
$TITLE "UDC"                                                            17060000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                                 17065000
   VALUE OFFSET;                                                        17070000
   INTEGER OFFSET;                                                      17075000
   BYTE ARRAY COMIMAGE;                                                 17080000
   OPTION UNCALLABLE;                                                   17085000
COMMENT                                                                 17090000
   THIS PROCEDURE DOES IT ALL FOR USER DEFINED COMMANDS.                17095000
   COMIMAGE IS COMMAND IMAGE                                            17100000
   ENDING IN %15, OFFSET IS INDEX IN DIRECTORY TO ALLOW                 17105000
   NESTING BUT STOP RECURSION.                                          17110000
   RETURNS TRUE IF COMIMAGE WAS A UDC.                                  17115000
;                                                                       17120000
BEGIN                                                                   17125000
                                                                        17130000
INTEGER                                                                 17135000
   SAVE'CIS'IFNESTING,                                         <<04603>>17140000
   COMLEN,                                                              17145000
   ERRNO,                                                               17150000
   FCONTROLDUMMY = ERRNO,                                               17155000
   NUMPARMS,                                                            17160000
   UDCFN,                                                               17165000
   RECNO,                                                               17170000
   BODYRECNO;                                                           17175000
                                                                        17180000
LOGICAL                                                                 17185000
   SAVE'CIS'IFSKIP,                                            <<04603>>17190000
   SAVE'CIS'ELSESEEN,                                          <<04603>>17195000
   OPTIONS,                                                    <<00538>>17200000
   OLDUDC2,                                                    <<01510>>17205000
   OLDSTATE;                                                   <<00538>>17210000
                                                                        17215000
BYTE POINTER PTR;                                                       17220000
                                                                        17225000
ARRAY HEADBUFF'(0:UDCBUFFSIZE);                                         17230000
BYTE ARRAY HEADBUFF(*) = HEADBUFF';                                     17235000
ARRAY PARMSINFO(0:PINFOSIZE);                                           17240000
BYTE ARRAY UDCIMAGE(0:CIS'MAXCOMLEN);                          <<04603>>17245000
                                                                        17250000
UDC := TRUE;                                                            17255000
SCAN COMIMAGE UNTIL CR,1;                                               17260000
COMLEN := TOS -@COMIMAGE;                                               17265000
MOVE UDCIMAGE := COMIMAGE,(COMLEN);                                     17270000
UDCIMAGE(COMLEN) := 0;                                                  17275000
                                                                        17280000
   << UPSHIFT COMMAND NAME >>                                           17285000
SCAN UDCIMAGE WHILE " ",1;                                              17290000
ASSEMBLE(DUP);                                                          17295000
MOVE * := * WHILE ANS;                                                  17300000
                                                                        17305000
   IF SEARCHUDC(UDCIMAGE,OFFSET,UDCFN,RECNO,BODYRECNO,OPTIONS)          17310000
      THEN                                                     <<U.RAO>>17315000
   BEGIN                                                                17320000
                                                               <<00835>>17325000
      << IF IN THE FALSE PORTION OF AN IF STATEMENT THEN >>    <<00835>>17330000
      << DON'T EXPAND THE UDC.                           >>    <<00835>>17335000
      IF CIS'IFSKIP THEN RETURN;                               <<04603>>17340000
                                                               <<00835>>17345000
      IF CIS'UDCNESTLEVEL=0 <<1 LEVEL UDC, SAVE COPY FOR REDO>><<04603>>17350000
         THEN MOVE CIS'BLASTCOMIMAGE := COMIMAGE,(COMLEN +1);  <<04603>>17355000
      CIS'UDCNESTLEVEL := CIS'UDCNESTLEVEL +1;<<NOW IN UDC>>   <<04603>>17360000
      CIS'CONTINUSTATESTK := CIS'CONTINUSTATESTK & DLSL(2);    <<04603>>17365000
         <<ADJUST CONTINUE FLAGS FOR NEW UDC NEST LEVEL>>      <<01.RO>>17370000
      READFILE(UDCFN,RECNO,HEADBUFF',ERRNO);                            17375000
      IF ERRNO <> 0 THEN ERROR(ERRNO,UDCFERR,UDCFN)                     17380000
      ELSE                                                              17385000
      BEGIN                                                             17390000
         PARSEUDCHEAD(HEADBUFF,NUMPARMS,PARMSINFO,OPTIONS,ERRNO);       17395000
         IF ERRNO = 0 THEN                                              17400000
         BEGIN                                                          17405000
            PARSECOM(UDCIMAGE,NUMPARMS,PARMSINFO,ERRNO);                17410000
            IF ERRNO = 0 THEN                                           17415000
            BEGIN                                                       17420000
                  << CHECK FOR REQUIRED PARMS >>                        17425000
               X := -3;                                                 17430000
               WHILE (X := X+3) < NUMPARMS*3 DO IF PARMSINFO            17435000
                  (X).(8:8) = 0 THEN                                    17440000
                  BEGIN                                                 17445000
                     @PTR := PARMSINFO(X:=X+1);                         17450000
                     ERRNO := MISSINGPARM;                              17455000
                     ERROR(ERRNO,IF OPTIONS.CIS'OPTNOHELP THEN <<04603>>17460000
                        SYNERRNOL ELSE SYNERR,PTR,                      17465000
                        HEADBUFF);                                      17470000
                     X := NUMPARMS*3; << STOP LOOPING >>                17475000
                  END;                                                  17480000
               IF ERRNO = 0 THEN                                        17485000
               BEGIN                                                    17490000
                  << SAVE PREVIOUS UDC OPTIONS >>              <<00619>>17495000
                  OLDUDC2 := CIS'UDC2;                         <<04603>>17500000
                  OLDSTATE := CIS'UDC3;                        <<04603>>17505000
                  COMMENT:                                     <<00538>>17510000
                     SET NEW BREAK STATE.  BREAK ACTS          <<00538>>17515000
                     LIKE A BLANKET.;                          <<00538>>17520000
                  CIS'UDC3 := OPTIONS;                         <<04603>>17525000
                  CIS'UDCNOBREAKOPT :=                         <<04603>>17530000
                                    IF OLDSTATE.CIS'OPTNOBREAK <<04603>>17535000
                                                 OR            <<04603>>17540000
                                       OPTIONS.CIS'OPTNOBREAK  <<04603>>17545000
                                      THEN TRUE ELSE FALSE;    <<04603>>17550000
                  IF OPTIONS.CIS'OPTNOBREAK THEN FCONTROL(1,   <<04603>>17555000
                     DISABLEBREAK,FCONTROLDUMMY);                       17560000
                                                               <<00835>>17565000
                  << SAVE CURRENT IF NESTING INFO >>           <<00835>>17570000
                  SAVE'CIS'IFNESTING := CIS'IFNESTING;         <<04603>>17575000
                  SAVE'CIS'IFSKIP := CIS'IFSKIP;               <<04603>>17580000
                  SAVE'CIS'ELSESEEN := CIS'ELSESEEN;           <<04603>>17585000
                                                               <<00835>>17590000
                  FEEDCI(UDCFN,BODYRECNO,COMIMAGE,NUMPARMS,             17595000
                     PARMSINFO,OFFSET,OPTIONS,ERRNO);                   17600000
                                                               <<00835>>17605000
                  << CHECK IF EXITING UDC AT SAME IF LEVEL >>  <<00835>>17610000
                  << UNLESS UDC EXITTING ABNORMALLY.       >>  <<01288>>17615000
                  IF (ERRNO = 0) AND                           <<01288>>17620000
                     (CIS'IFNESTING <> SAVE'CIS'IFNESTING) THEN<<04603>>17625000
                    ERROR(-UDCIFS'NEQ'ENDIFS,UDCERR);          <<01288>>17630000
                                                               <<00835>>17635000
                  << RESTORE IF NESTING GLOBALS >>             <<00835>>17640000
                  CIS'IFNESTING := SAVE'CIS'IFNESTING;         <<04603>>17645000
                  CIS'IFSKIP := SAVE'CIS'IFSKIP;               <<04603>>17650000
                  CIS'ELSESEEN := SAVE'CIS'ELSESEEN;           <<04603>>17655000
                                                               <<00835>>17660000
                                                               <<00835>>17665000
                  IF CIS'UDCEXITBREAK THEN                     <<04603>>17670000
                  BEGIN << UNWIND. PUT COMIMAGE BACK >>                 17675000
                     MOVE COMIMAGE := UDCIMAGE,(COMLEN);                17680000
                     COMIMAGE(COMLEN) := CR;                            17685000
                     IF CIS'PENDINGCOMLEN <> 0                 <<04603>>17690000
                       THEN CIS'PENDINGCOMLEN                  <<04603>>17695000
                        := COMLEN;<<ADJUST COMLEN FOR CI >>    <<13.EB>>17700000
                  END;                                                  17705000
                  IF OPTIONS.CIS'OPTNOBREAK                    <<04603>>17710000
                             AND NOT OLDSTATE.CIS'OPTNOBREAK   <<04603>>17715000
                     THEN FCONTROL(1,ENABLEBREAK,              <<00538>>17720000
                                   FCONTROLDUMMY);             <<00538>>17725000
                  << RESTORE PREVIOUS UDC OPTIONS >>           <<00619>>17730000
                  CIS'UDC3 := OLDSTATE;                        <<04603>>17735000
                  CIS'UDC2 := CIS'UDC2 LOR OLDUDC2;            <<04603>>17740000
               END;                                                     17745000
            END;                                                        17750000
         END;                                                           17755000
      END;                                                              17760000
      CIS'CONTINUSTATESTK := CIS'CONTINUSTATESTK & DLSR(2);    <<04603>>17765000
         <<ADJUST CONTINUE FLAGS TO PREVIOUS UDC NEST LEVEL>>  <<01.RO>>17770000
      IF CIS'UDCFATALCIERR AND CIS'CONTSTATE >= 1 THEN         <<04603>>17775000
         CIS'UDCFATALCIERR := FALSE; <<CLEAR UDC CI ABORT FLAG <<04603>>17780000
      IF CIS'UDCNESTLEVEL <> 0 THEN CIS'UDCNESTLEVEL :=        <<04603>>17785000
         CIS'UDCNESTLEVEL -1; << DECREMENT LEVEL >>            <<04603>>17790000
   END                                                                  17795000
   ELSE                                                                 17800000
   IF UDCIMAGE = "HELP " AND UDCHELP(UDCIMAGE(5)) THEN         <<01307>>17805000
      BEGIN                                                    <<01307>>17810000
      IF CIS'UDCNESTLEVEL = 0 THEN                             <<04603>>17815000
         MOVE CIS'BLASTCOMIMAGE := COMIMAGE,(COMLEN + 1);      <<04603>>17820000
      END                                                      <<01307>>17825000
   ELSE                                                        <<01307>>17830000
      UDC := FALSE;                                            <<01307>>17835000
                                                                        17840000
END; << UDC >>                                                          17845000
$TITLE "UDCHELP"                                                        17850000
LOGICAL PROCEDURE UDCHELP(COMIMAGE);                                    17855000
   VALUE COMIMAGE;                                                      17860000
   BYTE POINTER COMIMAGE;                                               17865000
   OPTION UNCALLABLE;                                                   17870000
BEGIN                                                                   17875000
                                                                        17880000
INTEGER                                                                 17885000
   LEN,                                                        <<01532>>17890000
   ERRNO,                                                               17895000
   ERRNO1,                                                              17900000
   UDCFN,                                                               17905000
   OFFSET,                                                              17910000
   RECNO,                                                               17915000
   DUMMY;                                                               17920000
LOGICAL OPTIONS;                                                        17925000
                                                                        17930000
BYTE POINTER PTR;                                                       17935000
                                                                        17940000
ARRAY UDCBUFF'(0:UDCBUFFSIZE);                                          17945000
BYTE ARRAY UDCBUFF(*) = UDCBUFF';                                       17950000
                                                                        17955000
OFFSET := 0;                                                            17960000
IF SEARCHUDC(COMIMAGE,OFFSET,UDCFN,RECNO,DUMMY,OPTIONS)                 17965000
   THEN                                                                 17970000
BEGIN                                                                   17975000
   IF NOT OPTIONS.CIS'OPTNOHELP THEN                           <<04603>>17980000
   BEGIN                                                                17985000
      UDCHELP := TRUE;                                         <<00835>>17990000
                                                               <<00835>>17995000
      << IF IN THE FALSE PART OF AN IF STATEMENT THEN >>       <<00835>>18000000
      << DON'T EXECUTE THE COMMAND.                   >>       <<00835>>18005000
      IF CIS'IFSKIP THEN RETURN;                               <<04603>>18010000
                                                               <<00835>>18015000
      SCAN COMIMAGE WHILE " ",1;<<DEBLANK>>                             18020000
      ASSEMBLE(DUP);                                                    18025000
      MOVE * := * WHILE ANS,1;<<SKIP COMMAND NAME>>                     18030000
      SCAN * WHILE " ",1;                                               18035000
      @PTR := TOS;                                                      18040000
      IF NOCARRY THEN << EXTRA PARMS >>                                 18045000
         ERROR( -IGNORED, IMAGERR, PTR, COMIMAGE(-4) );        <<01360>>18050000
      GENMSG(CISET,UDCHELPHEAD); << HEADER >>                           18055000
      PRINT(ERRNO,0,0); <<CRLF>>                                        18060000
                                                                        18065000
      ERRNO := -1;                                                      18070000
      DO BEGIN                                                          18075000
         READFILE(UDCFN,RECNO,UDCBUFF',ERRNO1);                         18080000
         IF ERRNO1 = EOFOUND THEN ERRNO := 0                            18085000
         ELSE                                                           18090000
         BEGIN                                                          18095000
            IF ERRNO1 <> 0 THEN ERRNO := ERRNO1                         18100000
            ELSE                                                        18105000
            BEGIN                                                       18110000
               IF UDCBUFF = "*" THEN ERRNO := 0                         18115000
               ELSE                                            <<01532>>18120000
               BEGIN                                           <<01532>>18125000
                  SCAN UDCBUFF UNTIL 0, 1;                     <<01532>>18130000
                  LEN := TOS - @UDCBUFF;                       <<01532>>18135000
                  PRINT( UDCBUFF', -LEN, 0 );                  <<01532>>18140000
               END;                                            <<01532>>18145000
            END;                                                        18150000
         END;                                                           18155000
      END UNTIL ERRNO <> -1;                                            18160000
   END;                                                                 18165000
END;                                                                    18170000
                                                                        18175000
END; << UDCHELP >>                                                      18180000
$TITLE "UPSHIFT"                                                        18185000
PROCEDURE UPSHIFT(PTR);                                                 18190000
   VALUE PTR; BYTE POINTER PTR;                                         18195000
   OPTION UNCALLABLE;                                                   18200000
COMMENT UPSHIFTS UNTIL 0 IF FOUND.                                      18205000
;                                                                       18210000
BEGIN                                                                   18215000
   TOS := @PTR;                                                         18220000
   DO BEGIN                                                             18225000
      ASSEMBLE(DUP);                                                    18230000
      MOVE * := * WHILE ANS,1;                                          18235000
      TOS := TOS +1;                                                    18240000
   END UNTIL BPS0(-1) = 0;                                              18245000
END; << UPSHIFT >>                                                      18250000
$TITLE "SEARCHCOMFILE"                                         <<00884>>18255000
PROCEDURE                                                      <<00884>>18260000
     SEARCHCOMFILE(COMFN,UNAME,ANAME,USERREC,FILEREC,ERRNO);   <<00884>>18265000
   VALUE COMFN;                                                <<00884>>18270000
   INTEGER COMFN,USERREC,FILEREC,ERRNO;                        <<00884>>18275000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>18280000
   OPTION UNCALLABLE,VARIABLE;                                 <<00884>>18285000
BEGIN                                                          <<00884>>18290000
COMMENT                                                        <<00884>>18295000
   Performs a linear search of the UDC Command file for a given<<00884>>18300000
   user & account, or any user in an account if only the accoun<<00884>>18305000
   is specified.  Searching begins at the record number passed <<00884>>18310000
   in 'USERREC'.  If a match is found before the end of the    <<00884>>18315000
   file, the record number of the user entry is returned in    <<00884>>18320000
   'USERREC' and the record number of the first file entry is  <<00884>>18325000
   returned in 'FILEREC'.                                      <<00884>>18330000
   ;                                                           <<00884>>18335000
DEFINE                                                         <<00884>>18340000
   UNAMEPARM = VARMASK.(11:1) #,                               <<00884>>18345000
   USERRECPARM = VARMASK.(13:1) #,                             <<00884>>18350000
   FILERECPARM = VARMASK.(14:1) #;                             <<00884>>18355000
LOGICAL                                                        <<00884>>18360000
   VARMASK = Q-4;                                              <<00884>>18365000
DOUBLE                                                         <<00884>>18370000
   RECNO;                                                      <<00884>>18375000
ARRAY                                                          <<00884>>18380000
   REC'(0:COMRECSIZEM1);                                       <<00884>>18385000
BYTE ARRAY                                                     <<00884>>18390000
   REC(*) = REC';                                              <<00884>>18395000
                                                               <<00884>>18400000
SUBROUTINE SET'RETURN'PARMS;                                   <<00884>>18405000
   BEGIN                                                       <<00884>>18410000
   IF USERRECPARM THEN USERREC := INTEGER(RECNO);              <<00884>>18415000
   IF FILERECPARM THEN FILEREC := REC'(COMLINK);               <<00884>>18420000
   ERRNO := 0;                                                 <<00884>>18425000
   END;                                                        <<00884>>18430000
                                                               <<00884>>18435000
                                                               <<00884>>18440000
ERRNO := -1;                                                   <<00884>>18445000
RECNO := DOUBLE(USERREC);                                      <<00884>>18450000
DO BEGIN                                                       <<00884>>18455000
   FREADDIR(COMFN,REC',COMRECSIZE,RECNO);                      <<00884>>18460000
   IF < THEN ERRNO := COMREADFAIL                              <<00884>>18465000
   ELSE                                                        <<00884>>18470000
      IF > THEN ERRNO := EOFOUND                               <<00884>>18475000
      ELSE                                                     <<00884>>18480000
         IF REC'(COMENTRYTYPE) = COMUSERENTRY THEN             <<00884>>18485000
            IF UNAMEPARM THEN                                  <<00884>>18490000
               BEGIN                                           <<00884>>18495000
               IF REC(COMUNAME) = UNAME,(8) AND                <<00884>>18500000
                  REC(COMANAME) = ANAME,(8) THEN               <<00884>>18505000
                     SET'RETURN'PARMS;                         <<00884>>18510000
               END                                             <<00884>>18515000
            ELSE                                               <<00884>>18520000
               BEGIN << Look for any user in this account >>   <<00884>>18525000
               IF REC(COMANAME) = ANAME,(8) THEN               <<00884>>18530000
                     SET'RETURN'PARMS;                         <<00884>>18535000
               END;                                            <<00884>>18540000
   RECNO := RECNO + 1D;                                        <<00884>>18545000
   END                                                         <<00884>>18550000
UNTIL ERRNO <> -1;                                             <<00884>>18555000
                                                               <<00884>>18560000
END; << SEARCHCOMFILE >>                                       <<00884>>18565000
$CONTROL SEGMENT = MAIN                                        <<00884>>18570000
END. << MODULE UDC >>                                          <<00884>>18575000
