$CONTROL USLINIT,CODE,MAP,SOURCE                                        00010000
<< UDC -- MODULE 82 >>                                                  00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL SEGMENT=UDC,MAIN=USER'DEF'CMDS                                 00028000
BEGIN                                                                   00030000
EQUATE                                                                  00032000
   CCG           = 0,                                                   00034000
   CCL           = 1,                                                   00036000
   CCE           = 2;                                                   00038000
                                                                        00040000
INTEGER                                                                 00042000
   STATUS = Q-1,                                                        00044000
   S0 =S-0,                                                             00046000
   X = X;                                                               00048000
                                                                        00050000
BYTE POINTER BPS0 = S-0;                                                00052000
POINTER PS0 = S-0;                                                      00054000
DOUBLE POINTER DPS0 = S-0;                                              00056000
ARRAY DB2(*)=DB+2;                                             <<00416>>00058000
                                                                        00060000
DEFINE                                                                  00062000
   SETXPXGLOB=PUSH(DL);X:=TOS-PS0(-1)#,                        <<00416>>00064000
   SMCAP=LOGICAL(DB2(X).(0:1))#,                               <<00416>>00066000
   AMCAP=LOGICAL(DB2(X).(1:1))#,                               <<00416>>00068000
   EXECUTORHEAD =                                              <<00884>>00070000
      (PARMSP,ERRNUM,PARMNUM);                                 <<00884>>00072000
      BYTE ARRAY PARMSP;                                       <<00884>>00074000
      INTEGER ERRNUM,PARMNUM #,                                <<00884>>00076000
   NOERRORS =  (ERRNUM <= 0) #,                                <<00884>>00078000
   CONDCODE      = STATUS.(6:2)#,                                       00080000
   CCGRETN       = BEGIN                                                00082000
                      CONDCODE := CCG;                                  00084000
                      GO OUTL;                                          00086000
                   END#,                                                00088000
   CCLRETN            = BEGIN                                           00090000
                      CONDCODE := CCL;                                  00092000
                      GO OUTL;                                          00094000
                   END#,                                                00096000
   DEF'MOVEFROMDSEG   =                                                 00098000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                           00100000
         VALUE TARGET,DSTN,OFFSET,COUNT;                                00102000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                              00104000
      BEGIN                                                             00106000
         X :          = TOS; << SAVE RETURN ADDRESS >>                  00108000
         ASSEMBLE(MFDS 0);                                              00110000
         TOS :        = X; << RESTORE RETURN ADDRESS >>                 00112000
      END #,                                                            00114000
                                                                        00116000
   DEF'MOVETODSEG     =                                                 00118000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                             00120000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                                00122000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                              00124000
      BEGIN                                                             00126000
         X :          = TOS;                                            00128000
         ASSEMBLE(MTDS 0);                                              00130000
         TOS :        = X;                                              00132000
      END #;                                                            00134000
                                                                        00136000
$INCLUDE INCLCIS                                               <<04603>>00138000
LOGICAL UDCDSTNO = CIS'UDC0;                                   <<04603>>00142000
DEFINE                                                         <<04603>>00144000
   UDCTYPE'               = (6:2)#;                            <<04603>>00146000
EQUATE                                                         <<00416>>00148000
   DIRCREAD = 1,                                               <<00884>>00150000
   DIRCWRITE = 2,                                              <<00884>>00152000
   UDCTYPE'USER=0,                                             <<00416>>00154000
   UDCTYPE'ACCOUNT=1,                                          <<00416>>00156000
   UDCTYPE'SYSTEM=2,                                           <<00416>>00158000
   UDCTYPE'NUMLEVELS     = 3,  << User, Account, & System >>   <<04651>>00160000
   GETUSERENTRY=%630,        <<DIRECSCAN FOR USER ENTRY>>      <<00416>>00162000
   GETACCTENTRY=%420,        <<DIRECSCAN FOR ACCT ENTRY>>      <<00416>>00164000
   SYSGLOBUDCFLAG=%1376,     <<SYSTEM UDC'S EXIST FLAG>>       <<00416>>00166000
   USERUDCPTR  = 18,                                           <<00884>>00168000
   ACCTUDCPTR  = 28,                                           <<00884>>00170000
   SYSUDCPTR   = 29,                                           <<00884>>00172000
   UMAXJOB=17,               <<UDC EXIST BIT IN USER ENTRY>>   <<00416>>00174000
   AMAXJOB=27;               <<UDC EXIST BITS IN ACCT ENTRY>>  <<00416>>00176000
                                                               <<00416>>00178000
DEFINE                                                         <<00416>>00180000
   USERUDCBIT=UMAXJOB).(1:1#,<<USER UDC BIT>>                  <<00416>>00182000
   ACCTUDCBIT=AMAXJOB).(1:1#,<<ACCT UDC BIT>>                  <<00416>>00184000
   SYSUDCBIT=AMAXJOB).(0:1#; <<SYSTEM UDC BIT>>                <<00416>>00186000
                                                                        00188000
                                                                        00190000
EQUATE                                                                  00192000
   CR                    = %15,                                         00194000
   DISABLEBREAK          = 14,                                          00196000
   ENABLEBREAK           = 15,                                          00198000
   PXFUDC                = 22, << WORD 22 IN PCBX >>                    00200000
   NOUDCGLOBALSM1        = 4,  << THERE ARE 5 GLOBAL CELLS>>            00202000
                                                                        00204000
                                                                        00206000
   FSYSSET               = 8,                                           00208000
   CISET                 = 2,                                           00210000
   UDCMAXPARMS           = 16,                                          00212000
   MAXSCPARMS            = 50,                                 <<01510>>00214000
   MAXSCPARMSM1          = MAXSCPARMS - 1,                     <<01510>>00216000
   PINFOSIZE             = UDCMAXPARMS*3 -1,                            00218000
                                                                        00222000
   BUFFSIZE              = 72,                                          00224000
   BUFFSIZEW             = 36,                                          00226000
   DIRSIZEM1             = 2047,                               <<01314>>00228000
   DIRSIZEB              = 4096,                               <<01314>>00230000
   DIRHEAD               = 1,                                           00232000
   DIRHEADSIZE           = 4,                                           00234000
   DIRHEADSIZEB          = DIRHEADSIZE*2,                               00236000
   DIRMAXCMDSIZE         = 16,                                          00238000
   DIRMAXENTRYSIZE       = DIRMAXCMDSIZE/2 +DIRHEADSIZE,                00240000
   DIRENTRYSIZE          = 1,                                           00242000
   DIRRECNO              = 1,                                           00244000
   DIRBODYRECNO          = 2,                                           00246000
   DIRFILENO             = 6,                                           00248000
   DIRCMDLEN             = 7,                                           00250000
   DIRCMD                = 8,                                           00252000
                                                                        00254000
   UDCBUFFSIZE           = 40*4,                                        00256000
   UDCRECSIZE            = 40,                                          00258000
   UDCRECSIZEB           = UDCRECSIZE*2,                                00260000
   TERMSIZE              = 72,                                          00262000
   TERMSIZEWM1           = TERMSIZE/2 -1,                               00264000
   UDCINITSTACKSIZE      = %5000, << GUESS AT STACK SIZE >>             00266000
                                                                        00268000
   << COMMAND.PUB.SYS >>                                                00270000
                                                                        00272000
   COMFREEHEAD           = 0,                                           00274000
   COMMAXUSE             = 2,                                           00276000
   COMUSE                = 3,                                           00278000
   COMLINK               = 0,                                           00280000
   COMENTRYTYPE          = 1,                                           00282000
   COMUNAME              = 4,                                           00284000
   COMANAME              = 12,                                          00286000
   COMFNAME              = 4,                                           00288000
   COMFREEENTRY          = 0,                                           00290000
   COMUSERENTRY          = 1,                                           00292000
   COMFILEENTRY          = 2,                                           00294000
   COMRECSIZE            = 20,                                          00296000
   COMRECSIZEM1          = COMRECSIZE -1,                               00298000
                                                                        00300000
      << ERRORS >>                                                      00302000
                                                                        00304000
      << 1901-1909 INITUDC ERRORS                     >>                00306000
      << 1910-1929 FILE ERRORS                      >>                  00308000
      << 1930-1939 SETCATALOG,SHOWCATALOG,HELP      >>                  00310000
      << 1940-1959 ERRORS IN UDC HEAD, BODY & IMAGE >>                  00312000
      << 1970-1977 INITUDC WARNINGS              >>            <<04631>>00314000
                                                                        00316000
      << ERROR TYPES FOR ERROR PROCEDURE >>                             00318000
                                                                        00320000
   FERR                  = 0,                                           00322000
   UDCERR                = 1,                                           00324000
   SYNERR                = 2,                                           00326000
   SYNERRNOL             = 3,                                           00328000
   UDCFERR               = 4,                                           00330000
   IMAGERR               = 5,                                           00332000
                                                                        00334000
      << EOF INDICATOR >>                                               00336000
                                                                        00338000
   EOFOUND               = 5,                                  <<00884>>00340000
   NOSUCHCOMUSER         = 1904, << User not in Command file >><<00884>>00342000
                                                                        00344000
      << ERRORS IN INITUDC (:SETCATALOG OR LOGON) >>                    00346000
                                                                        00348000
   AMPERSANDERR          = 1905, << CONT. AT END OF FILE >>             00350000
   CMDNOTALPHA           = 1906,                                        00352000
   STACKOVERFLOW         = 1907,                                        00354000
   GETDATASEGERR         = 1908,                                        00356000
   TOOMANYCMDSFORDIR     = 1909,                                        00358000
                                                                        00360000
      << ERRORS IN  COMMAND.PUB.SYS >>                                  00362000
                                                                        00364000
   COMOPENFAIL           = 1910,                                        00366000
   COMEOF                = 1911,                                        00368000
   COMLOCKFAIL           = 1912,                                        00370000
   COMUNLOCKFAIL         = 1913,                                        00372000
   COMREADFAIL           = 1914,                                        00374000
   COMWRITEFAIL          = 1915,                                        00376000
                                                               <<04846>>00378000
   << Errors in handling UDC files in SETCATALOG. >>           <<04846>>00380000
 LOCKWORDERR           = 1916, << Couldn't find lockword. >>   <<04846>>00382000
                                                               <<04846>>00384000
                                                                        00386000
      << ERRORS IN 'SHOWCATALOG' >>                                     00388000
                                                                        00390000
   SHOWCATLISTOPENF      = 1921,                                        00392000
   SHOWCATLISTWRITEF     = 1922,                                        00394000
                                                                        00396000
      << ERRORS IN UDC FILE >>                                          00398000
   UDCOPENFAIL           = 1923,                                        00400000
   UDCREADFAIL           = 1924,                                        00402000
   UDCIFS'NEQ'ENDIFS     = 1925,                               <<00835>>00404000
   UDCEMPTY              = 1926,                               <<01306>>00406000
                                                                        00408000
      << INFO MESSGES & HEADERS >>                                      00410000
                                                                        00412000
   UDCHELPHEAD           = 1930,                                        00414000
   NOCATALOGS            = 1931, <<:SHOWCATALOG>>                       00416000
   USEDLISTFILE          = 1932, <<:SHOWCATALOG>>                       00418000
                                                                        00420000
      << CI ERROR NUMBERS (SETCATALOG & SHOWCATALOG) >>                 00422000
                                                                        00424000
   EXPECTLISTFILE        = 1933, <<:SHOWCATALOG>>              <<00884>>00426000
   NOBACKORSYS           = 1934, <<:SETCATALOG>>               <<00884>>00428000
   UKNKEYWORD            = 1935, <<:SETCATALOG>>               <<00884>>00430000
   SETCAT2MPARMS         = 1936, <<:SETCATALOG>>               <<00884>>00432000
   NEEDSMCAP             = 1937, <<:SETCATALOG>>               <<00884>>00434000
   NEEDAMCAP             = 1938, <<:SETCATALOG>>               <<00884>>00436000
   NOBOTHSYSACC          = 1939, <<:SETCATALOG>>               <<00884>>00438000
                                                                        00440000
      << ERRORS IN PARSING UDC HEAD & UDC IMAGE >>                      00442000
                                                                        00444000
   TOOMANYREC            = 1940,                                        00446000
   PARMNOTALPHA          = 1941,                                        00448000
   TOOMANYPARMS          = 1942,                                        00450000
   MISSINGDEFAULT        = 1943,                                        00452000
   NOCLOSEQUOTE          = 1944,                                        00454000
   INVDELIM              = 1945,                                        00456000
   EXCESSPARMS           = 1946,                                        00458000
   UNKNOWNPARM           = 1947,                                        00460000
   MISSINGPARM           = 1948,                                        00462000
   TOOLONG               = 1949,                                        00464000
   EXPECTPARM            = 1950,                                        00466000
   IGNORED               = 1952,                                        00468000
   FMLNAMENOTALPHA       = 1953, << 1ST CHAR. NOT ALPHA >>              00470000
   INVFORMALNAME         = 1954, << SPECIAL CHAR. IN NAME >>            00472000
    CMDTOOLONG            = 1951, << UDC NAME TOO LONG >>      <<01023>>00474000
   NOTYPEMIX             = 1955, << NO KEYWORD AND POSITIO-  >><<01049>>00476000
                                  <<NAL IN SAME UDC COMMAND  >><<01049>>00478000
   UNKNOWNOPTION         = 1956, << UNKNOWN OPTION KEYWORD >>  <<01529>>00480000
                                                                        00482000
                                                                        00484000
   INITUDCFAILED         = 1960, <<USED IN SETCATALOG. NO MSG>><<00884>>00486000
   UDC'FLUSHED           = 1961, << USED IN FEEDCI.  NO MSG. >><<01288>>00488000
                                                               <<04631>>00490000
      << INITUDC WARNINGS >>                                   <<04631>>00492000
                                                               <<04631>>00494000
   LISTWARN              =1970,                                <<04631>>00496000
   LOGONWARN             =1971,                                <<04631>>00498000
   NOHELPWARN            =1972,                                <<04631>>00500000
   NOBREAKWARN           =1973,                                <<04631>>00502000
   NOLISTWARN            =1974,                                <<04631>>00504000
   NOLOGONWARN           =1975,                                <<04631>>00506000
   HELPWARN              =1976,                                <<04631>>00508000
   BREAKWARN             =1977,                                <<04631>>00510000
   ENDOFEQUATES          = 0;                                  <<00884>>00512000
                                                                        00514000
INTRINSIC FOPEN,FCHECK,FREAD,FREADDIR,FPOINT,READ,PRINT,DEBUG,          00516000
   FCONTROL,SEARCH,ZSIZE,FWRITE,                                        00518000
   FGETINFO,FCLOSE,FUNLOCK,FLOCK,FWRITEDIR,FSPACE,WHO;                  00520000
                                                                        00522000
PROCEDURE CIERR(ERRNUM,ERRADR,PARMASK,PARM);                            00524000
   VALUE ERRNUM,PARMASK,PARM;                                           00526000
   INTEGER ERRNUM,PARMASK,PARM;                                         00528000
   BYTE ARRAY ERRADR;                                                   00530000
   OPTION VARIABLE,EXTERNAL;                                            00532000
                                                                        00534000
INTEGER PROCEDURE DEBLANK(BUFF,WIDTH);                                  00536000
   VALUE WIDTH; INTEGER WIDTH;                                          00538000
   BYTE ARRAY BUFF; OPTION EXTERNAL;                                    00540000
                                                                        00542000
DOUBLE PROCEDURE DIRECSCAN(TYPE,LINKAGE,ANAME,GUNAME,                   00544000
      FNAME,RECIP,PARMS,MVTABX);                                        00546000
   VALUE TYPE,LINKAGE,MVTABX;                                           00548000
   INTEGER TYPE,MVTABX;                                                 00550000
   DOUBLE LINKAGE;                                                      00552000
   ARRAY ANAME,GUNAME,FNAME,PARMS;                                      00554000
   INTEGER PROCEDURE RECIP;                                             00556000
   OPTION EXTERNAL,VARIABLE;                                            00558000
                                                                        00560000
PROCEDURE FERROR'(FNUM,PARMNUM);                               <<00884>>00562000
   VALUE FNUM;  INTEGER FNUM,PARMNUM;                          <<00884>>00564000
   OPTION EXTERNAL;                                            <<00884>>00566000
                                                               <<00884>>00568000
INTEGER PROCEDURE FINDPARM(STRING,PARMPTR,DELPTR);                      00570000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      00572000
   OPTION VARIABLE,EXTERNAL;                                            00574000
                                                                        00576000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);                00578000
   VALUE TYPE;BYTE ARRAY TARGET,BA1,BA2,BA3,BA4;                        00580000
   INTEGER TYPE;OPTION EXTERNAL;                                        00582000
                                                                        00584000
INTEGER PROCEDURE GENMSG(A,B,C,D,E,F,G,H,I,J,K,L,M);                    00586000
   VALUE A,B,C,D,E,F,G,H,I,J,K,L,M;                                     00588000
   LOGICAL A,B,C,D,E,F,G,H,I,J,K,L,M;                                   00590000
   OPTION VARIABLE,EXTERNAL;                                            00592000
                                                                        00594000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                           00596000
   VALUE MEMSIZE,VDSIZE;INTEGER MEMSIZE,VDSIZE;                         00598000
   OPTION EXTERNAL;                                                     00600000
                                                                        00602000
INTEGER PROCEDURE MYCOMMAND                                    <<00884>>00604000
   (COMIMAGE,DELIMS,MAXPARMS,NUMPARMS,PARMS,DICT,DEFN);        <<00884>>00606000
   VALUE MAXPARMS;                                             <<00884>>00608000
   BYTE ARRAY COMIMAGE,DELIMS,DICT;                            <<00884>>00610000
   INTEGER MAXPARMS,NUMPARMS;                                  <<00884>>00612000
   DOUBLE ARRAY PARMS;                                         <<00884>>00614000
   BYTE POINTER DEFN;                                          <<00884>>00616000
   OPTION VARIABLE,EXTERNAL;                                   <<00884>>00618000
                                                               <<00884>>00620000
INTEGER PROCEDURE NEXTPARM(STRING,PARMPTR,DELPTR);                      00622000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      00624000
   OPTION VARIABLE,EXTERNAL;                                            00626000
                                                                        00628000
                                                                        00630000
   << FOPEN ENTRY POINT >>                                              00632000
INTEGER PROCEDURE PVOPEN(FD,FO,AO,R,D,FM,U,B,N,FS,NE,I,FC);             00634000
   VALUE FO,AO,R,U,B,N,FS,NE,I,FC;                                      00636000
   BYTE ARRAY FD,D,FM;                                                  00638000
   LOGICAL FO,AO;                                                       00640000
   INTEGER R,U,B,N,NE,I,FC;                                             00642000
   DOUBLE FS;                                                           00644000
   OPTION VARIABLE,EXTERNAL;                                            00646000
                                                                        00648000
PROCEDURE QUALIFYFILENAME(OLDFNAME,NEWFNAME);                           00650000
   BYTE ARRAY OLDFNAME,NEWFNAME;                                        00652000
   OPTION EXTERNAL;                                                     00654000
                                                                        00656000
PROCEDURE RELDATASEG(EN);VALUE EN;INTEGER EN;                           00658000
   OPTION EXTERNAL;                                                     00660000
                                                                        00662000
                                                               <<04810>>00664000
LOGICAL PROCEDURE SETCRITICAL;                                 <<04810>>00666000
OPTION EXTERNAL;                                               <<04810>>00668000
                                                               <<04810>>00670000
PROCEDURE RESETCRITICAL( PARM );                               <<04810>>00672000
   VALUE PARM;  LOGICAL PARM;                                  <<04810>>00674000
OPTION EXTERNAL;                                               <<04810>>00676000
                                                               <<04810>>00678000
LOGICAL PROCEDURE REQUESTSERVICE; OPTION EXTERNAL;                      00680000
                                                                        00682000
PROCEDURE SETSERVICE(DISP); VALUE DISP;LOGICAL DISP;                    00684000
   OPTION EXTERNAL;                                                     00686000
PROCEDURE SUDDENDEATH(NUMBER);                                 <<00863>>00688000
   VALUE NUMBER; INTEGER NUMBER;                               <<00863>>00690000
   OPTION EXTERNAL;                                            <<00863>>00692000
                                                               <<04846>>00694000
INTEGER PROCEDURE FGETLOCKWORD( FNUM, LOCKWORD, LEN );         <<04846>>00696000
   VALUE FNUM;                                                 <<04846>>00698000
   INTEGER FNUM, LEN;                                          <<04846>>00700000
   BYTE ARRAY LOCKWORD;                                        <<04846>>00702000
OPTION EXTERNAL;                                               <<04846>>00704000
                                                                        00706000
   << COMMANDINTERP ENTRY POINT >>                                      00708000
PROCEDURE UDCCI(COMLEN);                                                00710000
   VALUE COMLEN;                                                        00712000
   INTEGER COMLEN;                                                      00714000
   OPTION EXTERNAL;                                                     00716000
                                                                        00718000
   << OPTION FORWARDS >>                                                00720000
INTEGER PROCEDURE CHECKFILENAME'(A,B,C,D);                     <<00226>>00722000
VALUE A;                                                       <<00226>>00724000
DOUBLE A;                                                      <<00226>>00726000
LOGICAL B,C,D;                                                 <<00226>>00728000
OPTION EXTERNAL;                                               <<00226>>00730000
                                                                        00732000
                                                                        00734000
                                                                        00736000
PROCEDURE ERROR(ERRNO,TYPE,EPTR,BASEPTR);                               00738000
   VALUE ERRNO,TYPE,EPTR,BASEPTR; INTEGER ERRNO,TYPE;                   00740000
   BYTE POINTER EPTR,BASEPTR; OPTION VARIABLE,FORWARD;                  00742000
                                                                        00744000
INTEGER PROCEDURE GETCOMREC(COMFN,ERRNO);                               00746000
   VALUE COMFN; INTEGER COMFN,ERRNO;                                    00748000
   OPTION FORWARD;                                                      00750000
                                                                        00752000
PROCEDURE FINDCOMUSER(COMFN,UNAME,ANAME,UDCS,UREC,FREC,ERRNO); <<00884>>00754000
   VALUE COMFN;  BYTE ARRAY UNAME,ANAME; LOGICAL UDCS;         <<00884>>00756000
   INTEGER COMFN,UREC,FREC,ERRNO; OPTION FORWARD;              <<00884>>00758000
                                                                        00760000
PROCEDURE INITUDCNO( SHOW, SETCATCOMFN );                      <<03734>>00762000
   VALUE   SHOW, SETCATCOMFN;                                  <<03734>>00764000
   LOGICAL SHOW;                                               <<03734>>00766000
   INTEGER SETCATCOMFN;                                        <<03734>>00768000
   OPTION VARIABLE, FORWARD;                                   <<03734>>00770000
                                                                        00772000
INTEGER PROCEDURE OPTIONO(STRING); VALUE STRING;                        00774000
   BYTE POINTER STRING; OPTION FORWARD;                                 00776000
                                                                        00778000
INTEGER PROCEDURE RECIPUDC(NTRY,LEVEL,INX,SIRS);                        00780000
   VALUE LEVEL,INX,SIRS;                                                00782000
   INTEGER LEVEL,INX;                                                   00784000
   DOUBLE SIRS;ARRAY NTRY; OPTION FORWARD;                              00786000
                                                                        00788000
PROCEDURE READFILE(FN,RECNO,BUFF',ERRNO);                               00790000
   VALUE FN;INTEGER FN,RECNO,ERRNO;ARRAY BUFF';                         00792000
   OPTION FORWARD;                                                      00794000
                                                                        00796000
PROCEDURE RELCOMREC(COMFN,RECNO,ERRNO);                                 00798000
   VALUE COMFN,RECNO; INTEGER COMFN,RECNO,ERRNO;                        00800000
   OPTION FORWARD;                                                      00802000
                                                                        00804000
PROCEDURE SEARCHCOMFILE(COMFN,UNAME,ANAME,UREC,FREC,ERRNO);    <<00884>>00806000
   VALUE COMFN;  BYTE ARRAY UNAME,ANAME;                       <<00884>>00808000
   INTEGER COMFN,UREC,FREC,ERRNO;                              <<00884>>00810000
   OPTION VARIABLE,FORWARD;                                    <<00884>>00812000
                                                               <<00884>>00814000
LOGICAL PROCEDURE SEARCHUDC(STRING,OFFSET,UDCFN,                        00816000
      RECNO,BODYRECNO,OPTIONS);                                         00818000
   INTEGER OFFSET,UDCFN,RECNO,BODYRECNO;                                00820000
   LOGICAL OPTIONS;                                                     00822000
   BYTE ARRAY STRING; OPTION FORWARD;                                   00824000
                                                                        00826000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                                 00828000
   VALUE OFFSET; INTEGER OFFSET;                                        00830000
   BYTE ARRAY COMIMAGE; OPTION FORWARD;                                 00832000
                                                                        00834000
PROCEDURE UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);           <<00884>>00836000
   LOGICAL UDCSEXIST;                                          <<00884>>00838000
   INTEGER RECNO;                                              <<00884>>00840000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>00842000
   OPTION FORWARD;                                             <<00884>>00844000
                                                               <<00884>>00846000
PROCEDURE UDCDIRCREAD(UNAME,ANAME,UDCSEXIST,RECNO);            <<00884>>00848000
   LOGICAL UDCSEXIST;                                          <<00884>>00850000
   INTEGER RECNO;                                              <<00884>>00852000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>00854000
   OPTION FORWARD;                                             <<00884>>00856000
                                                               <<00884>>00858000
LOGICAL PROCEDURE UDCHELP(COMIMAGE);                                    00860000
   VALUE COMIMAGE;                                                      00862000
   BYTE POINTER COMIMAGE;                                               00864000
   OPTION FORWARD;                                                      00866000
                                                                        00868000
PROCEDURE UPSHIFT(PTR); VALUE PTR; BYTE POINTER PTR;                    00870000
   OPTION FORWARD;                                                      00872000
                                                                        00874000
                                                                        00876000
$TITLE "CLOSEUDC"                                                       00878000
PROCEDURE CLOSEUDC(DSTNO);                                     <<00884>>00880000
   VALUE DSTNO;  INTEGER DSTNO;                                <<00884>>00882000
   OPTION UNCALLABLE;                                                   00884000
BEGIN                                                                   00886000
                                                                        00888000
INTEGER                                                                 00890000
   OFFSET,                                                              00892000
   FILENO,                                                              00894000
   PREVFILENO,                                                 <<00884>>00896000
   LENGTH;                                                              00898000
ARRAY DIR'(0:DIRHEADSIZE); BYTE ARRAY DIR(*) = DIR';                    00900000
                                                                        00902000
SUBROUTINE DEF'MOVEFROMDSEG;                                            00904000
                                                                        00906000
OFFSET := PREVFILENO := 0;                                     <<00884>>00908000
DO BEGIN                                                                00910000
   MOVEFROMDSEG(@DIR',DSTNO,OFFSET,DIRHEADSIZE);               <<00884>>00912000
   FILENO := DIR(DIRFILENO);                                            00914000
   LENGTH := DIR(DIRENTRYSIZE);                                         00916000
   IF FILENO <> PREVFILENO THEN                                <<00884>>00918000
      BEGIN                                                    <<00884>>00920000
      FCLOSE(FILENO,0,0);                                      <<00884>>00922000
      PREVFILENO := FILENO;                                    <<00884>>00924000
      END;                                                     <<00884>>00926000
   OFFSET := OFFSET + LENGTH;                                  <<00884>>00928000
END UNTIL LENGTH = 0;                                                   00930000
                                                                        00932000
END; << CLOSEUDC >>                                                     00934000
$TITLE "CXSETCATALOG"                                          <<00884>>00936000
PROCEDURE CXSETCATALOG EXECUTORHEAD;                           <<00884>>00938000
   OPTION UNCALLABLE;                                          <<00884>>00940000
COMMENT                                                        <<00884>>00942000
   Command executor for the SETCATALOG command.                <<00884>>00944000
   Syntax:                                                     <<00884>>00946000
;                                                              <<00884>>00948000
<< SETCATALOG [udcfile,...[,udcfile]][;SHOW][;ACCOUNT][;SYSTEM]<<00884>>00950000
                                                               <<00884>>00952000
COMMENT                                                        <<00884>>00954000
   This command activates the user defined commands (UDC's) in <<00884>>00956000
   the specified UDC files. The UDC's can be made to apply to t<<00884>>00958000
   user, ACCOUNT, or SYSTEM depending on the optional paramters<<00884>>00960000
   chosen. The SHOW parameter causes the UDC file names and    <<00884>>00962000
   user defined commands to be listed as they are initialized. <<00884>>00964000
   If no UDC files are specified then any existing UDC's are   <<00884>>00966000
   deactivated at the specified level (user, ACCOUNT, or       <<00884>>00968000
   SYSTEM).                                                    <<00884>>00970000
                                                               <<00884>>00972000
   Execution strategy:                                         <<00884>>00974000
      1) Check syntax.                                         <<00884>>00976000
            Any file names are passed through CHECKFILENAME'.  <<00884>>00978000
            Backreferenced and system defined files (except    <<00884>>00980000
            $NULL) are rejected. Extra parameters are parsed   <<00884>>00982000
            and capability checks are made for the use of the  <<00884>>00984000
            ACCOUNT and SYSTEM parameters.                     <<00884>>00986000
      2) Save current UDC information.                         <<00884>>00988000
            The UDC DST number is saved. The UDC directory     <<00884>>00990000
            COMMAND.PUB.SYS is searched to locate UDC files    <<00884>>00992000
            for this UDC level.                                <<00884>>00994000
      3) Enter new UDC file names into UDC directory.          <<00884>>00996000
            File names are added as a linked list. A user and  <<00884>>00998000
            account entry is added pointing to the file names. <<00884>>01000000
      4) Initialize new UDC's.                                 <<00884>>01002000
            The location of the file names is written into the <<00884>>01004000
            system directory. INITUDC is called to activate    <<00884>>01006000
            the new UDC's.                                     <<00884>>01008000
      5) Deactivate old UDC's.                                 <<00884>>01010000
            Old UDC files are closed. Old UDC extra data segmen<<00884>>01012000
            is released. Old file names in COMMAND.PUB.SYS are <<00884>>01014000
            released.                                          <<00884>>01016000
                                                               <<03734>>01018000
                                                               <<03734>>01020000
   Fix Information:                                            <<03734>>01022000
                                                               <<03734>>01024000
      * It was discovered that the FLOCKing and FUNLOCKing of  <<03734>>01026000
        COMMAND.PUB.SYS was not sufficient to prevent windows  <<03734>>01028000
        in which simultaneous :SETCATALOGs or concurrent       <<03734>>01030000
        :SETCATALOGs and logons from causing corruption of the <<03734>>01032000
        COMMAND.PUB.SYS file.  This fix keeps COMMAND.PUB.SYS  <<03734>>01034000
        locked as long as it is opened by either CXSETCATALOG  <<03734>>01036000
        or INITUDC (for logon).  Note, however, that the       <<03734>>01038000
        procedures RELCOMREC and GETCOMREC now expect the      <<03734>>01040000
        COMFN file to be locked by the calling procedure:      <<03734>>01042000
        they no longer do any locking/unlocking.  These two    <<03734>>01044000
        procedures could be called from the CI when a          <<03734>>01046000
        :PURGE{USER/ACCT} is being executed.  Also note that   <<03734>>01048000
        the externals for INITUDC (specifically INITUDCNO)     <<03734>>01050000
        have been changed to allow CXSETCATALOG to pass the    <<03734>>01052000
        file number of the opened and locked COMMAND.PUB.SYS.  <<03734>>01054000
                                                               <<03734>>01056000
                                                               <<03767>>01058000
      * Fix number 3734 introduced another bug.  Before that   <<03767>>01060000
        fix, INITUDC would FCLOSE COMMAND.PUB.SYS after any    <<03767>>01062000
        logon UDC was executed.  Fix 3734 used that FCLOSE to  <<03767>>01064000
        also FUNLOCK COMMAND.PUB.SYS--the result of this was   <<03767>>01066000
        that COMMAND.PUB.SYS would stay locked while any job   <<03767>>01068000
        or session was executing a logon UDC.  This meant that <<03767>>01070000
        other jobs would not logon.  This was fixed by moving  <<03767>>01072000
        the FCLOSE to before the logon UDC execution.          <<03767>>01074000
                                                               <<03767>>01076000
      * When a UDC file has a lockword on it, a user could     <<04846>>01078000
        have rejected the use of that UDC file by supplying a  <<04846>>01080000
        bad lockword when prompted for it at logon--this may   <<04846>>01082000
        not be acceptable for account or system UDCs.  This    <<04846>>01084000
        fix will always append the lockword into the COMMAND   <<04846>>01086000
        entry.  Note that COMMAND.PUB.SYS is opened with       <<04846>>01088000
        EXECUTE access, thus users can be prevented from       <<04846>>01090000
        viewing the UDC lockwords in COMMAND.                  <<04846>>01092000
   ;                                                           <<00884>>01094000
                                                               <<00884>>01096000
BEGIN                                                          <<00884>>01098000
DEFINE                                                         <<00884>>01100000
   PARMADDR  = IPARMS(2*PARMNUM) #,                            <<00884>>01102000
   PARMLEN   = IPARMS(2*PARMNUM+1).(0:8) #,                    <<00884>>01104000
   NEXTDELIM = IPARMS(2*PARMNUM+1).(11:5) #,                   <<00884>>01106000
   COMMASEMICR = [8/",",8/";",8/%15,8/0]D #;                   <<00884>>01108000
                                                               <<00884>>01110000
EQUATE                                                         <<00884>>01112000
   MAXPARMS   = MAXSCPARMS,                                    <<01510>>01114000
   COMMA      = 0,                                             <<00884>>01116000
   SEMICOLON  = 1,                                             <<00884>>01118000
   CR         = 2;                                             <<00884>>01120000
                                                               <<00884>>01122000
LOGICAL                                                        <<00884>>01124000
   DMY,                                                        <<00884>>01126000
   SHOW,          << TRUE => 'SHOW' parm specified >>          <<00884>>01128000
   ACCOUNT,       << TRUE => 'ACCOUNT' parm specified >>       <<00884>>01130000
   SYSTEM,        << TRUE => 'SYSTEM' parm specified >>        <<00884>>01132000
   NEWUDCFILES,   << TRUE => new UDC file(s) specified >>      <<00884>>01134000
   UDCSEXIST,     << used for updating directory >>            <<00884>>01136000
   OLDUDCSEXIST,  << TRUE => UDC's currently exist(this level)><<00884>>01138000
   OLDCRIT,       << From SETCRITICAL.             >>          <<04810>>01140000
   UNLOCKOK,      << Able to UNLOCK COMMAND.PUB.SYS.  >>       <<04810>>01142000
   OLDDSTNO;      << current UDC extra DST no. >>              <<00884>>01144000
                                                               <<00884>>01146000
INTEGER                                                        <<00884>>01148000
   NIL := 0,      << used for updating directory >>            <<00884>>01150000
   NUMPARMS,      << number of parameters specified >>         <<00884>>01152000
   LASTFILEPARM,  << PARMS index of last UDC file >>           <<00884>>01154000
   ERRNO,         << error return value >>                     <<00884>>01156000
   RELEASE'ERR,   << error return value >>                     <<00884>>01158000
   RECNO,         << used for entering  file names >>          <<00884>>01160000
   OLDRECNO,      << location in comfile of current udc files ><<00884>>01162000
   COMFN;         << command file number >>                    <<00884>>01164000
                                                               <<00884>>01166000
BYTE POINTER                                                   <<00884>>01168000
   PARMPTR;                                                    <<00884>>01170000
                                                               <<00884>>01172000
DOUBLE                                                         <<00884>>01174000
   DELIMS := COMMASEMICR;                                      <<00884>>01176000
                                                               <<00884>>01178000
DOUBLE ARRAY                                                   <<00884>>01180000
   PARMS(0:MAXPARMS-1);                                        <<00884>>01182000
                                                               <<00884>>01184000
ARRAY                                                          <<00884>>01186000
   IPARMS(*) = PARMS,                                          <<00884>>01188000
   REC'(0:COMRECSIZEM1);                                       <<00884>>01190000
                                                               <<00884>>01192000
BYTE ARRAY                                                     <<00884>>01194000
   REC(*) = REC',                                              <<00884>>01196000
   LOCKWORD(0:7),        << Holds UDC file lockword, if any >> <<04846>>01198000
   UNAME(0:7),                                                 <<00884>>01200000
   ANAME(0:7);                                                 <<00884>>01202000
                                                               <<00884>>01204000
BYTE ARRAY             << add new parameters here >>           <<00884>>01206000
   PKEYLIST(0:1) = PB :=                                       <<00884>>01208000
      6,4,"SHOW",                                              <<00884>>01210000
      9,7,"ACCOUNT",                                           <<00884>>01212000
      8,6,"SYSTEM",                                            <<00884>>01214000
      0;                                                       <<00884>>01216000
EQUATE PKEYLISTLEN = 24;                                       <<00884>>01218000
BYTE ARRAY KEYLIST(0:PKEYLISTLEN-1);                           <<00884>>01220000
                                                               <<00884>>01222000
<<***********************************************************>><<00884>>01224000
<<  COMFILE'ERR                                              >><<00884>>01226000
<<    Gets file system error number.                         >><<00884>>01228000
<<    Closes Command file.                                   >><<00884>>01230000
<<    Calls CIERR setting ERRNUM.                            >><<00884>>01232000
<<***********************************************************>><<00884>>01234000
SUBROUTINE COMFILE'ERR(ERR);                                   <<00884>>01236000
VALUE ERR;  INTEGER ERR;                                       <<00884>>01238000
   BEGIN                                                       <<00884>>01240000
   IF NOERRORS THEN                                            <<00884>>01242000
      BEGIN                                                    <<00884>>01244000
      FERROR'(COMFN,PARMNUM); << Gets FS err #. Closes file. >><<00884>>01246000
      CIERR(ERRNUM := IF ERR = EOFOUND THEN COMEOF ELSE ERR);  <<00884>>01248000
      END;                                                     <<00884>>01250000
   END;                                                        <<00884>>01252000
<<***********************************************************>><<00884>>01254000
<<  RELEASERECS                                              >><<00884>>01256000
<<    Returns records in Command file to the free list.      >><<00884>>01258000
<<    RECNUM is the head of a linked list of records.        >><<00884>>01260000
<<***********************************************************>><<00884>>01262000
SUBROUTINE RELEASERECS(RECNUM);                                <<00884>>01264000
   VALUE RECNUM; INTEGER RECNUM;                               <<00884>>01266000
   BEGIN                                                       <<00884>>01268000
   WHILE (RECNUM <> 0) AND NOERRORS DO                         <<00884>>01270000
      BEGIN                                                    <<00884>>01272000
      FREADDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNUM));          <<00884>>01274000
      IF <> THEN COMFILE'ERR(COMREADFAIL)                      <<00884>>01276000
      ELSE                                                     <<00884>>01278000
         BEGIN                                                 <<00884>>01280000
         RELCOMREC(COMFN,RECNUM,RELEASE'ERR);                  <<00884>>01282000
         IF RELEASE'ERR <> 0 THEN COMFILE'ERR(RELEASE'ERR)     <<00884>>01284000
         ELSE RECNUM := REC'(COMLINK);                         <<00884>>01286000
         END;                                                  <<00884>>01288000
      END;                                                     <<00884>>01290000
   END; << RELEASERECS >>                                      <<00884>>01292000
<<***********************************************************>><<00884>>01294000
<<  GETREC                                                   >><<00884>>01296000
<<    Locates a free record in Command file.                 >><<00884>>01298000
<<***********************************************************>><<00884>>01300000
INTEGER SUBROUTINE GETREC;                                     <<00884>>01302000
   BEGIN                                                       <<00884>>01304000
   GETREC := GETCOMREC(COMFN,ERRNO);                           <<00884>>01306000
   IF ERRNO > 0 THEN                                           <<00884>>01308000
      BEGIN                                                    <<00884>>01310000
      RELEASERECS(RECNO);                                      <<00884>>01312000
      COMFILE'ERR(ERRNO);                                      <<00884>>01314000
      END;                                                     <<00884>>01316000
   END;  << GETREC >>                                          <<00884>>01318000
                                                               <<00884>>01320000
<<***********************************************************>><<00884>>01322000
<<  PARSEUDCFILENAMES                                        >><<00884>>01324000
<<     Validates file names (if any).                        >><<00884>>01326000
<<     Flags $NULL files as parms of zero length.            >><<00884>>01328000
<<***********************************************************>><<00884>>01330000
SUBROUTINE PARSEUDCFILENAMES;                                  <<00884>>01332000
   BEGIN                                                       <<00884>>01334000
   MYCOMMAND(PARMSP,DELIMS,MAXPARMS,NUMPARMS,PARMS);           <<00884>>01336000
   IF > THEN CIERR(ERRNUM := SETCAT2MPARMS,,%10000,MAXPARMS)   <<00884>>01338000
   ELSE                                                        <<00884>>01340000
      BEGIN                                                    <<00884>>01342000
      NEWUDCFILES := FALSE;                                    <<00884>>01344000
      PARMNUM := -1;                                           <<00884>>01346000
      IF NUMPARMS > 0 THEN                                     <<00884>>01348000
                                                               <<00884>>01350000
         DO BEGIN                                              <<00884>>01352000
            PARMNUM := PARMNUM + 1;                            <<00884>>01354000
            @PARMPTR := PARMADDR;                              <<00884>>01356000
            IF PARMLEN > 0 THEN                                <<00884>>01358000
               BEGIN                                           <<00884>>01360000
               ERRNO :=                                        <<00884>>01362000
                  CHECKFILENAME'(PARMS(PARMNUM)&LSR(8),DMY,DMY,<<00884>>01364000
                                 DMY);                         <<00884>>01366000
               IF <> THEN                                      <<00884>>01368000
                  IF > THEN                                    <<00884>>01370000
                       << Backreferenced or system defined file<<00884>>01372000
                     IF ERRNO = 6 <<$NULL>> THEN               <<00884>>01374000
                        PARMLEN := 0  <<Allow, but flag it >>  <<00884>>01376000
                     ELSE                                      <<00884>>01378000
                        CIERR(ERRNUM := NOBACKORSYS,PARMPTR)   <<00884>>01380000
                  ELSE                                         <<00884>>01382000
                       << Bad file syntax >>                   <<00884>>01384000
                     CIERR(ERRNUM := ERRNO,PARMPTR)            <<00884>>01386000
               ELSE                                            <<00884>>01388000
                  << Appears to be good file >>                <<00884>>01390000
                  NEWUDCFILES := TRUE;                         <<00884>>01392000
               END;                                            <<00884>>01394000
            END                                                <<00884>>01396000
         UNTIL (NEXTDELIM <> COMMA) OR (ERRNUM > 0);           <<00884>>01398000
                                                               <<00884>>01400000
      END;                                                     <<00884>>01402000
   LASTFILEPARM := PARMNUM;                                    <<00884>>01404000
   PARMNUM := PARMNUM + 1;                                     <<00884>>01406000
   END; << PARSEUDCFILENAMES >>                                <<00884>>01408000
                                                               <<00884>>01410000
<<***********************************************************>><<00884>>01412000
<<  PARSEXTRAPARMS                                           >><<00884>>01414000
<<     Sets flags indicating which extra parms were chosen.  >><<00884>>01416000
<<     Determines UDC level (user, ACCOUNT, SYSTEM). Verfies >><<00884>>01418000
<<     user has proper capabilities to use ACCOUNT or SYSTEM >><<00884>>01420000
<<     options.                                              >><<00884>>01422000
<<***********************************************************>><<00884>>01424000
SUBROUTINE PARSEXTRAPARMS;                                     <<00884>>01426000
   BEGIN                                                       <<00884>>01428000
   MOVE KEYLIST := PKEYLIST,(PKEYLISTLEN);                     <<00884>>01430000
   SHOW := ACCOUNT := SYSTEM := FALSE;                         <<00884>>01432000
   WHO(,,,UNAME,,ANAME);                                       <<00884>>01434000
                                                               <<00884>>01436000
   WHILE (PARMNUM < NUMPARMS) AND NOERRORS DO                  <<00884>>01438000
      BEGIN                                                    <<00884>>01440000
      @PARMPTR := PARMADDR;                                    <<00884>>01442000
      CASE SEARCH(PARMPTR,PARMLEN,KEYLIST) OF                  <<00884>>01444000
         BEGIN                                                 <<00884>>01446000
                                                               <<00884>>01448000
         << 0: Unknown keyword >>                              <<00884>>01450000
            CIERR(ERRNUM := UKNKEYWORD,PARMPTR);               <<00884>>01452000
                                                               <<00884>>01454000
         << 1: Show>>                                          <<00884>>01456000
            SHOW := TRUE;                                      <<00884>>01458000
                                                               <<00884>>01460000
         << 2: Account>>                                       <<00884>>01462000
            BEGIN                                              <<00884>>01464000
            SETXPXGLOB;  << Set X to check AM capability >>    <<00884>>01466000
            IF NOT AMCAP THEN                                  <<00884>>01468000
               CIERR(ERRNUM := NEEDAMCAP,PARMPTR);             <<00884>>01470000
            ACCOUNT := TRUE;                                   <<00884>>01472000
            MOVE UNAME := "@       ";<< @ indicates all users>><<00884>>01474000
            END;                                               <<00884>>01476000
                                                               <<00884>>01478000
         << 3: System>>                                        <<00884>>01480000
            BEGIN                                              <<00884>>01482000
            SETXPXGLOB;  << Set X to check SM capability >>    <<00884>>01484000
            IF NOT SMCAP THEN                                  <<00884>>01486000
               CIERR(ERRNUM := NEEDSMCAP,PARMPTR);             <<00884>>01488000
            SYSTEM := TRUE;                                    <<00884>>01490000
            MOVE UNAME := "@       ";<< @ indicates all users>><<00884>>01492000
            MOVE ANAME := "@       ";<< @ indicates all accts>><<00884>>01494000
            END;                                               <<00884>>01496000
         END; << CASE >>                                       <<00884>>01498000
      PARMNUM := PARMNUM + 1;                                  <<00884>>01500000
      END; << WHILE >>                                         <<00884>>01502000
                                                               <<00884>>01504000
   IF ACCOUNT AND SYSTEM THEN                                  <<00884>>01506000
      CIERR(ERRNUM := NOBOTHSYSACC);                           <<00884>>01508000
   END; << PARSEXTRAPARMS >>                                   <<00884>>01510000
                                                               <<00884>>01512000
<<***********************************************************>><<03734>>01514000
<<  OPENCOMFILE                                              >><<03734>>01516000
<<     Opens and locks COMMAND.PUB.SYS.                      >><<03734>>01518000
<<***********************************************************>><<03734>>01520000
SUBROUTINE OPENCOMFILE;                                        <<03734>>01522000
   BEGIN                                                       <<03734>>01524000
                                                               <<03734>>01526000
   MOVE REC := "COMMAND.PUB.SYS ";                             <<03734>>01528000
   COMFN := FOPEN( REC, 1, %346 );  << Old, Share, Lock, Xeq >><<03734>>01530000
   IF <> THEN COMFILE'ERR( COMOPENFAIL )                       <<03734>>01532000
   ELSE                                                        <<03734>>01534000
   BEGIN                                                       <<03734>>01536000
      OLDCRIT := SETCRITICAL;                                  <<04810>>01538000
      FLOCK( COMFN, TRUE );                                    <<03734>>01540000
      IF <> THEN COMFILE'ERR( COMLOCKFAIL );                   <<03734>>01542000
   END;                                                        <<03734>>01544000
                                                               <<03734>>01546000
END;  << OPENCOMFILE >>                                        <<03734>>01548000
                                                               <<03734>>01550000
                                                               <<03734>>01552000
                                                               <<03734>>01554000
<<***********************************************************>><<03734>>01556000
<<  CLOSECOMFILE                                             >><<03734>>01558000
<<     Unlocks and closes COMMAND.PUB.SYS.                   >><<03734>>01560000
<<***********************************************************>><<03734>>01562000
SUBROUTINE CLOSECOMFILE;                                       <<03734>>01564000
   BEGIN                                                       <<03734>>01566000
                                                               <<03734>>01568000
   FUNLOCK( COMFN );                                           <<03734>>01570000
   IF = THEN UNLOCKOK := TRUE                                  <<04810>>01572000
        ELSE UNLOCKOK := FALSE;                                <<04810>>01574000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>01576000
   IF NOT UNLOCKOK                                             <<04810>>01578000
      THEN COMFILE'ERR( COMUNLOCKFAIL )                        <<04810>>01580000
   ELSE  FCLOSE( COMFN, 0, 0 );                                <<03734>>01582000
                                                               <<03734>>01584000
END;  << CLOSECOMFILE >>                                       <<03734>>01586000
                                                               <<03734>>01588000
                                                               <<03734>>01590000
<<***********************************************************>><<00884>>01592000
<<  GETOLDUDCINFO                                            >><<00884>>01594000
<<    Opens and locks COMMAND.PUB.SYS.                       >><<03734>>01596000
<<    Saves UDC extra data segment number.                   >><<00884>>01600000
<<    Gets record number in Command file of current UDC's.   >><<00884>>01602000
<<***********************************************************>><<00884>>01604000
SUBROUTINE GETOLDUDCINFO;                                      <<00884>>01606000
   BEGIN                                                       <<00884>>01608000
      OLDDSTNO := UDCDSTNO;                                    <<04603>>01612000
      FINDCOMUSER(COMFN,UNAME,ANAME,OLDUDCSEXIST,OLDRECNO,DMY, <<00884>>01614000
                  ERRNO);                                      <<00884>>01616000
      IF ERRNO = NOSUCHCOMUSER THEN                            <<00884>>01618000
            << User not found in comfile, yet directory >>     <<00884>>01620000
            << indicates that UDC's exist.  Set exist    >>    <<00884>>01622000
            << flag so that directory will be updated.   >>    <<00884>>01624000
         OLDUDCSEXIST := FALSE                                 <<00884>>01626000
      ELSE                                                     <<00884>>01628000
         IF ERRNO <> 0 THEN  COMFILE'ERR(ERRNO)                <<00884>>01630000
         ELSE                                                  <<00884>>01632000
            BEGIN  << No errors >>                             <<00884>>01634000
            IF NOT OLDUDCSEXIST THEN                           <<00884>>01636000
               BEGIN                                           <<00884>>01638000
                  << Directory indicates no UDC's exist.    >> <<00884>>01640000
                  << Search comfile anyway since new comfile>> <<00884>>01642000
                  << may have been installed since last      >><<00884>>01644000
                  << directory update. >>                      <<00884>>01646000
               OLDRECNO := 1;  << Begin search at beginning >> <<00884>>01648000
               SEARCHCOMFILE(COMFN,UNAME,ANAME,OLDRECNO,,      <<00884>>01650000
                                                        ERRNO);<<00884>>01652000
               IF ERRNO <> 0 THEN                              <<00884>>01654000
                  IF ERRNO = EOFOUND THEN OLDRECNO := 0        <<00884>>01656000
                  ELSE COMFILE'ERR(ERRNO);                     <<00884>>01658000
               END;                                            <<00884>>01660000
            END;                                               <<00884>>01662000
                                                               <<03734>>01664000
   END;                                                        <<00884>>01666000
                                                               <<00884>>01668000
<<***********************************************************>><<00884>>01670000
<<  ENTERFILENAMES                                           >><<00884>>01672000
<<    Enters UDC file names into Command file.               >><<00884>>01674000
<<    Enters user and account names with pointer to file     >><<00884>>01676000
<<    names.                                                 >><<00884>>01678000
<<    Leaves 'RECNO' pointing to user and account names.     >><<00884>>01680000
<<***********************************************************>><<00884>>01682000
SUBROUTINE ENTERFILENAMES;                                     <<00884>>01684000
   BEGIN                                                       <<00884>>01686000
                                                               <<00884>>01688000
   RECNO := 0;                                                 <<00884>>01690000
   PARMNUM := LASTFILEPARM;                                    <<00884>>01692000
                                                               <<00884>>01694000
   DO BEGIN                                                    <<00884>>01696000
      IF PARMLEN > 0 THEN                                      <<00884>>01698000
         BEGIN                                                 <<00884>>01700000
         REC' := "  ";                                         <<00884>>01702000
         MOVE REC'(1) := REC',(COMRECSIZEM1);                  <<00884>>01704000
         @PARMPTR := PARMADDR;                                 <<00884>>01706000
         QUALIFYFILENAME(PARMPTR,REC(COMFNAME));               <<00884>>01708000
         REC'(COMENTRYTYPE) := COMFILEENTRY;                   <<00884>>01710000
         REC'(COMLINK) := RECNO;                               <<00884>>01712000
         RECNO := GETREC;                                      <<00884>>01714000
         IF NOERRORS THEN                                      <<00884>>01716000
            BEGIN                                              <<00884>>01718000
            FWRITEDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNO));    <<00884>>01720000
            IF <> THEN                                         <<00884>>01722000
               BEGIN                                           <<00884>>01724000
               RELEASERECS(RECNO);                             <<00884>>01726000
               COMFILE'ERR(COMWRITEFAIL);                      <<00884>>01728000
               END;                                            <<00884>>01730000
            END;                                               <<00884>>01732000
         END;                                                  <<00884>>01734000
      PARMNUM := PARMNUM - 1;                                  <<00884>>01736000
      END                                                      <<00884>>01738000
   UNTIL (PARMNUM = -1) OR (ERRNUM > 0);                       <<00884>>01740000
                                                               <<00884>>01742000
   IF NOERRORS THEN                                            <<00884>>01744000
      BEGIN << Add entry with user and acct pointing to files>><<00884>>01746000
      REC' := "  ";                                            <<00884>>01748000
      MOVE REC'(1) := REC',(COMRECSIZEM1);                     <<00884>>01750000
      REC'(COMENTRYTYPE) := COMUSERENTRY;                      <<00884>>01752000
      MOVE REC(COMUNAME) := UNAME,(8);                         <<00884>>01754000
      MOVE REC(COMANAME) := ANAME,(8);                         <<00884>>01756000
      REC'(COMLINK) := RECNO;                                  <<00884>>01758000
      RECNO := GETREC;                                         <<00884>>01760000
      IF NOERRORS THEN                                         <<00884>>01762000
         BEGIN                                                 <<00884>>01764000
         FWRITEDIR(COMFN,REC',COMRECSIZE,DOUBLE(RECNO));       <<00884>>01766000
         IF <> THEN                                            <<00884>>01768000
            BEGIN                                              <<00884>>01770000
            RELEASERECS(RECNO);                                <<00884>>01772000
            COMFILE'ERR(COMWRITEFAIL);                         <<00884>>01774000
            END;                                               <<00884>>01776000
         END;                                                  <<00884>>01778000
      END;                                                     <<00884>>01780000
                                                               <<00884>>01782000
   END; << ENTERFILENAMES >>                                   <<00884>>01784000
                                                               <<00884>>01786000
<<***********************************************************>><<00884>>01788000
<<  INITNEWUDCS                                              >><<00884>>01790000
<<    Updates directory to point to new UDC's.               >><<00884>>01792000
<<    Calls INITUDCNO to process and activate new UDC's.     >><<00884>>01794000
<<    Restores old UDC's if an error occurs.                 >><<00884>>01796000
<<***********************************************************>><<00884>>01798000
SUBROUTINE INITNEWUDCS;                                        <<00884>>01800000
   BEGIN                                                       <<00884>>01802000
   UDCSEXIST := TRUE;                                          <<00884>>01804000
   UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);                  <<00884>>01806000
   FCONTROL(COMFN,2,DMY);  << Write out buffers >>             <<00884>>01808000
   UDCDSTNO := 0;                                              <<04603>>01810000
   INITUDCNO( SHOW, COMFN );                                   <<03734>>01812000
   IF INTEGER(UDCDSTNO) <= 0 THEN                              <<04846>>01814000
      BEGIN  << Error occured. Restore old UDC's >>            <<00884>>01816000
                                                               <<04846>>01818000
   << Handle the case of problems with FGETLOCKWORD.    >>     <<04846>>01820000
      IF INTEGER(UDCDSTNO) < 0 THEN                            <<04846>>01822000
      BEGIN                                                    <<04846>>01824000
         CIERR( ERRNUM := LOCKWORDERR );                       <<04846>>01826000
      END;                                                     <<04846>>01828000
                                                               <<04846>>01830000
      UDCDSTNO := OLDDSTNO;                                    <<04603>>01832000
      UDCDIRCWRITE(UNAME,ANAME,OLDUDCSEXIST,OLDRECNO);         <<00884>>01834000
      RELEASERECS(RECNO);                                      <<00884>>01836000
      ERRNUM := INITUDCFAILED;                                 <<00884>>01840000
      END;                                                     <<00884>>01842000
   END;  << INITNEWUDCS >>                                     <<00884>>01844000
                                                               <<00884>>01846000
<<***********************************************************>><<00884>>01848000
<<  CLOSEOLDUDCS                                             >><<00884>>01850000
<<    Closes previous UDC files (if any).                    >><<00884>>01852000
<<    Releases UDC extra data segment.                       >><<00884>>01854000
<<    Updates directory Command file pointer.                >><<00884>>01856000
<<    Flags old UDC information as invalid. (In case in UDC) >><<00884>>01858000
<<    Removes previous file names from Command file.         >><<00884>>01860000
<<***********************************************************>><<00884>>01864000
SUBROUTINE CLOSEOLDUDCS;                                       <<00884>>01866000
   BEGIN                                                       <<00884>>01868000
   IF OLDDSTNO > 0 THEN                                        <<00884>>01870000
      BEGIN                                                    <<00884>>01872000
      CLOSEUDC(OLDDSTNO);                                      <<00884>>01874000
      RELDATASEG(OLDDSTNO);                                    <<00884>>01876000
      END;                                                     <<00884>>01878000
   IF NOT NEWUDCFILES THEN                                     <<00884>>01880000
      BEGIN  << No new UDC's to be activated. >>               <<00884>>01882000
      UDCDSTNO := 0;                                           <<04603>>01884000
      UDCSEXIST := FALSE;                                      <<00884>>01886000
      UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,NIL);                 <<00884>>01888000
         << Must reinit in case UDC's exist at other levels. >><<00884>>01890000
      INITUDCNO( FALSE, COMFN );                               <<03734>>01892000
      END;                                                     <<00884>>01894000
   CIS'UDCFLUSH := TRUE;  << FLAG OLD UDC INFO INVALID >>      <<04603>>01896000
   RELEASERECS(OLDRECNO);                                      <<00884>>01898000
                                                               <<03734>>01900000
   END; << CLOSEOLDUDCS >>                                     <<00884>>01902000
                                                               <<00884>>01904000
<<*************************>>                                  <<00884>>01906000
<<  Main Procedure Body    >>                                  <<00884>>01908000
<<*************************>>                                  <<00884>>01910000
                                                               <<00884>>01912000
PARSEUDCFILENAMES;                                             <<00884>>01914000
IF NOERRORS THEN                                               <<00884>>01916000
   BEGIN                                                       <<00884>>01918000
   PARSEXTRAPARMS;                                             <<00884>>01920000
   IF NOERRORS THEN                                            <<00884>>01922000
      BEGIN                                                    <<00884>>01924000
      OPENCOMFILE;                                             <<03734>>01926000
      GETOLDUDCINFO;                                           <<00884>>01928000
      IF NOERRORS THEN                                         <<00884>>01930000
         IF NEWUDCFILES THEN                                   <<00884>>01932000
            BEGIN                                              <<00884>>01934000
            ENTERFILENAMES;                                    <<00884>>01936000
            IF NOERRORS THEN                                   <<00884>>01938000
               BEGIN                                           <<00884>>01940000
               INITNEWUDCS;                                    <<00884>>01942000
               IF NOERRORS THEN                                <<00884>>01944000
                  CLOSEOLDUDCS;                                <<00884>>01946000
               END;                                            <<00884>>01948000
            END                                                <<00884>>01950000
         ELSE                                                  <<00884>>01952000
            CLOSEOLDUDCS;                                      <<00884>>01954000
      CLOSECOMFILE;                                            <<03734>>01956000
      END;                                                     <<00884>>01958000
   END;                                                        <<00884>>01960000
                                                               <<00884>>01962000
END; << CXSETCATALOG >>                                        <<00884>>01964000
$TITLE "CXSHOWCATALOG"                                                  01966000
PROCEDURE CXSHOWCATALOG(PARMSP,ERRNUM,PARMNUM);                         01968000
   BYTE ARRAY PARMSP;                                                   01970000
   INTEGER ERRNUM,PARMNUM;                                              01972000
   OPTION UNCALLABLE;                                                   01974000
COMMENT                                                                 01976000
   SYNTAX :SHOWCATALOG [LISTFILE]                                       01978000
   DEFAULT DEVICE CLASS FOR LISTFILE IS "LP".                           01980000
;                                                                       01982000
BEGIN                                                                   01984000
                                                                        01986000
INTEGER                                                                 01988000
   LEN,                                                                 01990000
   OFFSET,                                                              01992000
   ENTRYLEN,                                                            01994000
   LASTFN,                                                              01996000
   BLEN,                                                                01998000
   PLEN,                                                                02000000
   LISTFN;                                                              02002000
                                                                        02004000
BYTE POINTER                                                            02006000
   PARMPTR,                                                             02008000
   ENDIMAGE;                                                            02010000
                                                                        02012000
LOGICAL                                                                 02014000
   SETLIST;                                                             02016000
                                                                        02018000
BYTE ARRAY DEV(0:2);                                                    02020000
                                                                        02022000
ARRAY DIR'(0:DIRMAXENTRYSIZE); BYTE ARRAY DIR(*) = DIR';                02024000
ARRAY BUFF'(0:14);BYTE ARRAY BUFF(*)=BUFF';                    <<00416>>02026000
                                                                        02028000
SUBROUTINE DEF'MOVEFROMDSEG;                                            02030000
                                                                        02032000
SUBROUTINE WARN(ERRN,SPTR);                                             02034000
   VALUE ERRN; INTEGER ERRN;                                            02036000
   BYTE ARRAY SPTR;                                                     02038000
BEGIN                                                                   02040000
   ERROR( -ERRN, IMAGERR, SPTR, PARMSP(-11) );                 <<01360>>02042000
END; << WARN >>                                                         02044000
                                                                        02046000
SUBROUTINE ERR(ERRN);                                                   02048000
   VALUE ERRN; INTEGER ERRN;                                            02050000
BEGIN                                                                   02052000
   ERROR(ERRN,UDCFERR,LISTFN,PARMPTR);                                  02054000
   GO OUTL;                                                             02056000
END; << ERR >>                                                          02058000
                                                                        02060000
                                                                        02062000
   << CXSHOWCATALOG MAIN BODY >>                                        02064000
                                                                        02066000
SETLIST := FALSE;                                                       02068000
LISTFN := 0;                                                            02070000
   << CHANGE CR STOPPER INTO 0 >>                                       02072000
SCAN PARMSP UNTIL CR,1;                                                 02074000
@ENDIMAGE := TOS;                                                       02076000
ENDIMAGE := 0;                                                          02078000
                                                                        02080000
   << CHECK FOR LISTFILE >>                                             02082000
PLEN := FINDPARM(PARMSP,PARMPTR);                                       02084000
IF PARMPTR <> 0 THEN                                                    02086000
BEGIN << SOMETHING THERE >>                                             02088000
   IF PLEN = 0 THEN WARN(EXPECTLISTFILE,PARMPTR)                        02090000
   ELSE SETLIST := TRUE;                                                02092000
END;                                                                    02094000
                                                                        02096000
MOVE DEV := "LP ";                                                      02098000
LISTFN := FOPEN(PARMPTR, IF SETLIST THEN %4 ELSE %14,1,,DEV);           02100000
   << $STDLIST OR FILENAME >>                                           02102000
IF <> THEN ERR(SHOWCATLISTOPENF);                                       02104000
                                                                        02106000
LASTFN := -1;                                                           02108000
OFFSET := 0;                                                            02110000
ENTRYLEN := DIRMAXENTRYSIZE;                                            02112000
                                                                        02114000
IF UDCDSTNO = 0 THEN GENMSG( CISET, NOCATALOGS )               <<04603>>02116000
ELSE << UDC'S & CATALOGS EXIST >>                                       02118000
BEGIN                                                                   02120000
   IF SETLIST THEN GENMSG( CISET, USEDLISTFILE )               <<01360>>02122000
   ELSE PRINT(BUFF',0,0);                                               02124000
   DO BEGIN                                                             02126000
         << GET DIR 1 ENTRY AT A TIME >>                                02128000
      MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN +DIRHEAD);   <<04603>>02130000
      MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN +DIRHEAD);   <<04603>>02132000
      LEN := DIR(DIRENTRYSIZE);                                         02134000
      ENTRYLEN := DIR(LEN*2 +DIRENTRYSIZE);                             02136000
      OFFSET := OFFSET +LEN;                                            02138000
      IF LEN <> 0 THEN                                                  02140000
      BEGIN                                                             02142000
         IF LASTFN <> INTEGER(DIR(DIRFILENO)) THEN                      02144000
         BEGIN << PRINT FILE NAME >>                                    02146000
            LASTFN := DIR(DIRFILENO);                                   02148000
            BUFF := " ";                                                02150000
            FGETINFO(LASTFN,BUFF);                                      02152000
            SCAN BUFF UNTIL " ",1;                                      02154000
            BLEN := TOS -@BUFF;                                         02156000
            FWRITE(LISTFN,BUFF',-BLEN,0);                               02158000
            IF <> THEN ERR(SHOWCATLISTWRITEF);                          02160000
         END;                                                           02162000
         BUFF:=" "; <<BLANK FILL OUTPUT BUFFER>>               <<00416>>02164000
         MOVE BUFF(1):=BUFF,(29);                              <<00416>>02166000
         BLEN := DIR(DIRCMDLEN);                                        02168000
         MOVE BUFF(3) := DIR(DIRCMD),(BLEN);                            02170000
         BLEN:=DIR'.UDCTYPE';                                  <<04603>>02172000
         IF BLEN=UDCTYPE'USER THEN MOVE BUFF(22):=" USER   "   <<00416>>02174000
         ELSE                                                  <<00416>>02176000
         IF BLEN=UDCTYPE'SYSTEM THEN MOVE BUFF(22):=" SYSTEM " <<00416>>02178000
         ELSE MOVE BUFF(22):=" ACCOUNT";                       <<00416>>02180000
         FWRITE(LISTFN,BUFF',-30,0);                           <<00416>>02182000
         IF <> THEN ERR(SHOWCATLISTWRITEF);                             02184000
      END;                                                              02186000
      IF REQUESTSERVICE THEN LEN := 0; << BREAK HIT >>                  02188000
   END UNTIL LEN = 0;                                                   02190000
END;                                                                    02192000
                                                                        02194000
OUTL:                                                                   02196000
                                                                        02198000
   << RESTORE %15 AT END FOR REDO >>                                    02200000
ENDIMAGE := CR;                                                         02202000
FCLOSE(LISTFN,0,0);                                                     02204000
                                                                        02206000
END; << CXSHOWCATALOG >>                                                02208000
$TITLE "UDCDIRCWRITE"                                          <<00884>>02210000
PROCEDURE UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,RECNO);           <<00884>>02212000
   BYTE ARRAY ANAME,UNAME;                                     <<00884>>02214000
   LOGICAL UDCSEXIST;                                          <<00884>>02216000
   INTEGER RECNO;                                              <<00884>>02218000
   OPTION UNCALLABLE;                                          <<00884>>02220000
COMMENT                                                        <<00884>>02222000
   Reads/writes Command file record numbers from/to system     <<00884>>02224000
   directory. Updates system level UDC flag in SYSGLOB if      <<00884>>02226000
   necessary. Command file record numbers for user level UDC's <<00884>>02228000
   are kept in the user entry of the system directory. Record  <<00884>>02230000
   numbers for account level UDC's are kept in the account     <<00884>>02232000
   entries. The record number for system level UDC's is kept in<<00884>>02234000
   the account entry of the SYS account. RECIPUDC is a procedur<<00884>>02236000
   which is passed to DIRECSCAN to do the actual read/write    <<00884>>02238000
   of the directory entry.  PARMARRAY is used by RECIPUDC to   <<00884>>02240000
   determine what is to be done to the entry and as storage    <<00884>>02242000
   for values read/written from/to the entry.                  <<00884>>02244000
   ;                                                           <<00884>>02246000
                                                               <<00884>>02248000
BEGIN                                                          <<00884>>02250000
ENTRY UDCDIRCREAD;                                             <<00884>>02252000
ARRAY                                                          <<00884>>02254000
   PARMARRAY(0:3) = Q,                                         <<00884>>02256000
   SYS(0:3);                                                   <<00884>>02258000
POINTER                                                        <<00884>>02260000
   UNAME',                                                     <<00884>>02262000
   ANAME';                                                     <<00884>>02264000
                                                               <<00884>>02266000
INTEGER SUBROUTINE WORDADDRESS(BYTEADDRESS);                   <<00884>>02268000
   VALUE BYTEADDRESS;  INTEGER BYTEADDRESS;                    <<00884>>02270000
   BEGIN                                                       <<00884>>02272000
   TOS := WORDADDRESS := BYTEADDRESS & LSR(1);                 <<00884>>02274000
   PUSH(Z);                                                    <<00884>>02276000
   IF <<WORDADDRESS>> TOS > TOS <<Z>> THEN                     <<00884>>02278000
      WORDADDRESS.(0:1) := 1;                                  <<00884>>02280000
   END;                                                        <<00884>>02282000
                                                               <<00884>>02284000
                                                               <<00884>>02286000
PARMARRAY := DIRCWRITE;                                        <<00884>>02288000
GO START;                                                      <<00884>>02290000
                                                               <<00884>>02292000
UDCDIRCREAD:                                                   <<00884>>02294000
PARMARRAY := DIRCREAD;                                         <<00884>>02296000
                                                               <<00884>>02298000
START:                                                         <<00884>>02300000
PARMARRAY(2) := RECNO;                                         <<00884>>02302000
PARMARRAY(3) := UDCSEXIST;                                     <<00884>>02304000
@UNAME' := WORDADDRESS(@UNAME);                                <<00884>>02306000
@ANAME' := WORDADDRESS(@ANAME);                                <<00884>>02308000
IF UNAME = "@" THEN                                            <<00884>>02310000
   IF ANAME = "@" THEN                                         <<00884>>02312000
      BEGIN                                                    <<00884>>02314000
      PARMARRAY(1) := UDCTYPE'SYSTEM;                          <<00884>>02316000
      MOVE SYS := "SYS     ";                                  <<00884>>02318000
      DIRECSCAN(GETACCTENTRY,0D,SYS,,,RECIPUDC,PARMARRAY);     <<00884>>02320000
      IF PARMARRAY = DIRCWRITE THEN                            <<00884>>02322000
         ABSOLUTE(SYSGLOBUDCFLAG) := UDCSEXIST;                <<00884>>02324000
      END                                                      <<00884>>02326000
   ELSE                                                        <<00884>>02328000
      BEGIN                                                    <<00884>>02330000
      PARMARRAY(1) := UDCTYPE'ACCOUNT;                         <<00884>>02332000
      DIRECSCAN(GETACCTENTRY,0D,ANAME',,,RECIPUDC,PARMARRAY);  <<00884>>02334000
      END                                                      <<00884>>02336000
ELSE                                                           <<00884>>02338000
   BEGIN                                                       <<00884>>02340000
   PARMARRAY(1) := UDCTYPE'USER;                               <<00884>>02342000
   DIRECSCAN(GETUSERENTRY,0D,ANAME',UNAME',,RECIPUDC,PARMARRAY)<<00884>>02344000
   ;                                                           <<00884>>02346000
   END;                                                        <<00884>>02348000
RECNO := PARMARRAY(2);                                         <<00884>>02350000
UDCSEXIST := PARMARRAY(3);                                     <<00884>>02352000
END;  << UDCDIRCWRITE >>                                       <<00884>>02354000
$TITLE "ERROR"                                                          02356000
PROCEDURE ERROR(ERRNO,TYPE,EPTR,BASEPTR);                               02358000
   VALUE ERRNO,TYPE,EPTR,BASEPTR;                                       02360000
   INTEGER ERRNO,TYPE;                                                  02362000
   BYTE POINTER EPTR,BASEPTR;                                           02364000
   OPTION UNCALLABLE,VARIABLE;                                          02366000
COMMENT   - UNIVERSAL ERROR HANDLER FOR UDC'S.                          02368000
                                                                        02370000
PARAMETERS:                                                             02372000
   ERRNO    - ERROR NUMBER. REQUIRED PARM.                              02374000
   TYPE     = ERROR TYPE.  REQUIRED PARM.                               02376000
       FERR     = 0 - FILE ERROR.  EPTR IS FILE NUMBER.                 02378000
                      FCHECK IS CALLED TO GET ERROR. GENMSG             02380000
                      IS CALLED TO PRINT FILE SYS ERROR.                02382000
                      CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>02384000
      UDCERR    = 1 - CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>02386000
                      (INTERNAL ERROR.)                                 02388000
      SYNERR    = 2 - STRING IS PRINTED, CARET IS PRINTED.              02390000
                      CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>02392000
      SYNERRNOL = 3 - CIERR IS CALLED TO PRINT CI ERROR.       <<01360>>02394000
      UDCFERR   = 4 - BASEPTR CONTAINS FILE NAME. FGETINFO              02396000
                      CALLED TO GET FILE NO.  FCHECK CALLED             02398000
                      TO GET ERROR.  GENMSG IS CALLED TO PRINT          02400000
                      FILE SYS ERROR.                                   02402000
      IMAGERR   = 5 - STRING PRINTED ONLY IF UDC4.IMAGEADJUST.          02404000
                      CARET PRINTED.  CIERR CALLED TO PRINT    <<01360>>02406000
                      CI ERROR.                                <<01360>>02408000
   EPTR     - POINT IN STRING WHERE CARET SHOULD BE PRINTED.            02410000
              (UNLESS TYPE=FERR THEN EPTR IS FILE NO.)                  02412000
   BASEPTR  - BEGINNING OF ERROR STRING.  (UNLESS TYPE=UDCERR           02414000
              THEN IT IS FILE NAME.)                                    02416000
;                                                                       02418000
BEGIN                                                                   02420000
                                                                        02422000
                                                                        02424000
INTEGER                                                                 02426000
   COMLEN,                                                              02428000
   LEN;                                                                 02430000
                                                                        02432000
BYTE POINTER PTR;                                                       02434000
POINTER PTR';                                                           02436000
POINTER BASEPTR';                                                       02438000
                                                                        02440000
ARRAY BUFF'(0:TERMSIZEWM1); BYTE ARRAY BUFF(*) = BUFF';                 02442000
                                                                        02444000
CIS'UDCNOPRINT := 1;  << CIERR SHOULD NOT PRINT LINE. >>       <<04603>>02446000
                                                               <<01360>>02448000
IF TYPE = SYNERR OR TYPE = IMAGERR THEN                                 02450000
BEGIN                                                                   02452000
   @BASEPTR' := @BASEPTR&LSR(1);                                        02454000
   @PTR' := @BASEPTR';                                                  02456000
   @PTR := @BASEPTR;                                                    02458000
   SCAN PTR UNTIL 0,1;                                                  02460000
   COMLEN := TOS -@PTR;                                                 02462000
   LEN := IF COMLEN > TERMSIZE THEN TERMSIZE ELSE COMLEN;               02464000
   DO BEGIN                                                             02466000
      IF TYPE <> IMAGERR OR CIS'UDCIMAGEADJUST OR COMLEN >     <<04603>>02468000
         TERMSIZE THEN PRINT(PTR',-LEN,0);                              02470000
      @PTR := @PTR +TERMSIZE;                                           02472000
      @PTR' := @PTR&LSR(1);                                             02474000
      LEN := COMLEN -(@PTR -@BASEPTR);                                  02476000
      IF LEN > TERMSIZE THEN LEN := TERMSIZE;                           02478000
   END UNTIL @PTR >= @EPTR;                                             02480000
   LEN := @EPTR -(@PTR -TERMSIZE);                                      02482000
   IF TYPE = IMAGERR AND NOT CIS'UDCIMAGEADJUST AND            <<04603>>02484000
      COMLEN <= TERMSIZE THEN LEN := LEN +1;                            02486000
   BUFF := " ";                                                         02488000
   MOVE BUFF(1) := BUFF,(LEN);                                          02490000
   BUFF(LEN) := "^";                                                    02492000
   PRINT(BUFF',-LEN -1,0);                                              02494000
END << SYNERR >>                                                        02496000
ELSE                                                                    02498000
IF TYPE = FERR THEN                                                     02500000
BEGIN                                                                   02502000
   FCHECK(EPTR(1),LEN); << FIL # PASSED AS BYTE PTR>>                   02504000
   GENMSG(FSYSSET,LEN);                                                 02506000
END                                                                     02508000
ELSE                                                                    02510000
IF TYPE = UDCFERR THEN                                                  02512000
BEGIN                                                                   02514000
   FCHECK(EPTR(1),LEN); << FILE # PASSED AS BYTE PTR>>                  02516000
   GENMSG(FSYSSET,LEN);                                                 02518000
   IF INTEGER(EPTR(1)) <> 0 THEN                                        02520000
   BEGIN << GET FILE NAME >>                                            02522000
      @BASEPTR := @BUFF;                                                02524000
      BUFF := 0;                                                        02526000
      MOVE BASEPTR(1) := BASEPTR,(28);                         <<01522>>02528000
      FGETINFO(EPTR(1),BASEPTR);                                        02530000
   END;                                                                 02532000
   CIERR( ERRNO, , %1, @BASEPTR );                             <<01360>>02534000
END;                                                                    02536000
                                                                        02538000
IF TYPE <> UDCFERR  THEN CIERR( ERRNO );                       <<01360>>02540000
                                                               <<01360>>02542000
CIS'UDCNOPRINT := 0;  << RESET >>                              <<04603>>02544000
                                                                        02546000
END; << ERROR >>                                                        02548000
$TITLE "FEEDCI"                                                         02550000
PROCEDURE FEEDCI(UDCFN,RECNO,COMIMAGE,NUMPARMS,                         02552000
      PARMSINFO,OFFSET,OPTIONS,ERRNO);                                  02554000
   VALUE UDCFN,RECNO,NUMPARMS,OPTIONS,OFFSET;                           02556000
   INTEGER UDCFN,RECNO,NUMPARMS,OFFSET,ERRNO;                           02558000
   BYTE ARRAY COMIMAGE;                                                 02560000
   LOGICAL OPTIONS;                                                     02562000
   ARRAY PARMSINFO;                                                     02564000
   OPTION UNCALLABLE;                                                   02566000
COMMENT                                                                 02568000
   READS UDC FILE, STUFFS PARMS & CALLS CI                              02570000
;                                                                       02572000
BEGIN                                                                   02574000
                                                                        02576000
INTEGER                                                                 02578000
   COUNT,                                                               02580000
   COMLEN,                                                              02582000
   PLEN,                                                                02584000
   UDCLEN,                                                              02586000
   SIGN'LEN,                                                   <<01018>>02588000
   ERRNO1;                                                              02590000
LOGICAL DONE;                                                           02592000
BYTE POINTER                                                            02594000
   UDCPTR,                                                              02596000
   PARMPTR;                                                             02598000
ARRAY UDCBUFF'(0:UDCBUFFSIZE);                                          02600000
BYTE ARRAY UDCBUFF(*) = UDCBUFF';                                       02602000
                                                                        02604000
SUBROUTINE FILERR(ERRN);                                                02606000
   VALUE ERRN; INTEGER ERRN;                                            02608000
      << FILE ERROR >>                                                  02610000
BEGIN                                                                   02612000
   ERRNO := ERRN;                                                       02614000
   ERROR(ERRNO,UDCFERR,UDCFN);                                          02616000
   GO OUTL;                                                             02618000
END; << ERR >>                                                          02620000
                                                                        02622000
SUBROUTINE BERR(ERRN,PTR);                                              02624000
   VALUE ERRN; INTEGER ERRN;                                            02626000
   BYTE ARRAY PTR;                                                      02628000
      << UDC BODY ERROR >>                                              02630000
BEGIN                                                                   02632000
   ERRNO := ERRN;                                                       02634000
   ERROR(ERRNO,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL         <<04603>>02636000
                                        ELSE SYNERR,           <<04603>>02638000
      PTR,UDCBUFF);                                                     02640000
   IF CIS'UDCFATALCIERR THEN GO OUTL                           <<04603>>02642000
   ELSE                                                        <<01360>>02644000
   BEGIN                                                       <<01360>>02646000
      ERRNO := -1;  << CONTINUE IF RETURNED OK.  >>            <<01360>>02648000
      GO SKIP'THIS'LINE;                                       <<01360>>02650000
   END;                                                        <<01360>>02652000
END; << BERR >>                                                         02654000
                                                                        02656000
SUBROUTINE ERRTOOLONG;                                                  02658000
      << COMIMAGE ERROR >>                                              02660000
BEGIN                                                                   02662000
   ERRNO := TOOLONG;                                           <<01288>>02664000
   ERROR(TOOLONG,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL       <<04603>>02666000
                                          ELSE SYNERR,         <<04603>>02668000
      COMIMAGE(CIS'MAXCOMLEN -1),COMIMAGE);                    <<04603>>02670000
   IF CIS'UDCFATALCIERR THEN GO OUTL                           <<04603>>02672000
   ELSE                                                        <<01360>>02674000
   BEGIN                                                       <<01360>>02676000
      ERRNO := -1;  << CONTINUE IF RETURNED OK.  >>            <<01360>>02678000
      GO SKIP'THIS'LINE;                                       <<01360>>02680000
   END;                                                        <<01360>>02682000
END; << SUBROUTINE ERRTOOLONG >>                                        02684000
                                                                        02686000
                                                                        02688000
SUBROUTINE STUFF;                                                       02690000
COMMENT                                                                 02692000
   MOVES FROM UDCPTR INTO COMIMAGE. CHECKS FOR OVERFLOW OF              02694000
   BUFFER. REQUIRES:                                                    02696000
      UDCLEN = COUNT TO PLACE IN COMIMAGE.                              02698000
      UDCPTR = POINTING TO STARTING PLACE IN UDC IMAGE.                 02700000
   UPDATES COMLEN                                                       02702000
;                                                                       02704000
BEGIN                                                                   02706000
   MOVE COMIMAGE(COMLEN) := UDCPTR,(CIS'MAXCOMLEN -COMLEN);    <<04603>>02708000
   IF COMLEN +UDCLEN > CIS'MAXCOMLEN THEN                      <<04603>>02710000
      ERRTOOLONG;                                                       02712000
   COMLEN := COMLEN +UDCLEN;                                            02714000
END; << STUFF >>                                                        02716000
                                                                        02718000
                                                                        02720000
          << *************************** >>                             02722000
          <<                             >>                             02724000
          <<    FEEDCI MAIN BODY         >>                             02726000
          <<                             >>                             02728000
          << *************************** >>                             02730000
                                                                        02732000
                                                                        02734000
COMIMAGE(CIS'MAXCOMLEN +1) := 0; << STOPPER FOR ERRTOOLONG >>  <<04603>>02736000
ERRNO := -1;                                                            02738000
DO BEGIN                                                                02740000
   COMLEN := 0;                                                         02742000
   READFILE(UDCFN,RECNO,UDCBUFF',ERRNO1);                               02744000
   IF ERRNO1 = EOFOUND THEN ERRNO := 0                                  02746000
   ELSE                                                                 02748000
   BEGIN                                                                02750000
      IF ERRNO1 <> 0 THEN FILERR(ERRNO1);                               02752000
      IF UDCBUFF = "*" THEN ERRNO := 0                                  02754000
      ELSE                                                              02756000
      BEGIN                                                             02758000
         @UDCPTR := @UDCBUFF;                                           02760000
         DONE := FALSE;                                                 02762000
                                                                        02764000
            << LOOP TO PARSE UDC BODY IMAGE >>                          02766000
                                                                        02768000
         DO BEGIN << WHIRL THRU PARMS >>                                02770000
            SCAN UDCPTR UNTIL "!",1;                                    02772000
            @PARMPTR := TOS;                                            02774000
            IF NOCARRY THEN                                             02776000
            BEGIN                                                       02778000
               UDCLEN := @PARMPTR -@UDCPTR;                             02780000
               STUFF; << PUT IN COMIMAGE>>                              02782000
               FINDPARM(PARMPTR(1),UDCPTR);                             02784000
                                                                        02786000
                  << CHECK OUT FORMAL NAME >>                           02788000
                    IF UDCPTR <> ALPHA AND UDCPTR <> "!" THEN  <<01018>>02790000
                        BERR(FMLNAMENOTALPHA,UDCPTR)           <<01018>>02792000
                    ELSE IF UDCPTR = "!" THEN                  <<01018>>02794000
                        BEGIN                                  <<01018>>02796000
                           SCAN UDCPTR WHILE "!",1;            <<01018>>02798000
                           SIGN'LEN := TOS - @UDCPTR + 1;      <<01018>>02800000
                           UDCLEN := SIGN'LEN/2;               <<01018>>02802000
                           STUFF;                              <<01018>>02804000
                           @UDCPTR := @UDCPTR(SIGN'LEN - 1);   <<01018>>02806000
                           IF SIGN'LEN MOD 2 = 0 THEN GO MATCH;<<01018>>02808000
                        END;                                   <<01018>>02810000
                  << UPSHIFT >>                                         02812000
               MOVE UDCPTR := UDCPTR WHILE ANS,1;                       02814000
               UDCLEN := TOS -@UDCPTR;                                  02816000
               COUNT := -1;                                             02818000
               WHILE (COUNT := COUNT +1) < NUMPARMS DO                  02820000
               BEGIN                                                    02822000
                                                                        02824000
                     << SEARCH FOR MATCHING NAME POINTED >>             02826000
                     << TO BY PARMSINFO                  >>             02828000
                  @PARMPTR := PARMSINFO(COUNT*3 +1);                    02830000
                  IF UDCLEN = INTEGER(PARMSINFO(COUNT*3)                02832000
                     .(0:8)) AND UDCPTR = PARMPTR,(UDCLEN)              02834000
                     THEN                                               02836000
                  BEGIN                                                 02838000
                                                                        02840000
                        << FOUND MATCH. STUFF IN COMIMAGE>>             02842000
                     @PARMPTR := PARMSINFO(COUNT*3 +2);                 02844000
                     PLEN := PARMSINFO(COUNT*3).(8:8);                  02846000
                     MOVE COMIMAGE(COMLEN) := PARMPTR,                  02848000
                        (CIS'MAXCOMLEN -COMLEN);               <<04603>>02850000
                     IF COMLEN +PLEN > CIS'MAXCOMLEN THEN      <<04603>>02852000
                        ERRTOOLONG;                                     02854000
                     @UDCPTR := @UDCPTR(UDCLEN +               <<00884>>02856000
                           (IF UDCPTR(-1) = """" AND           <<00884>>02858000
                              UDCPTR(UDCLEN) = """" THEN 1     <<00884>>02860000
                                                      ELSE 0));<<00884>>02862000
                     COMLEN := COMLEN +PLEN;                            02864000
                     GO MATCH;                                          02866000
                  END;                                                  02868000
               END;                                                     02870000
               BERR(UNKNOWNPARM,UDCPTR);                                02872000
MATCH:                                                                  02874000
            END                                                         02876000
            ELSE                                                        02878000
            BEGIN << NO PARM >>                                         02880000
               UDCLEN := @PARMPTR -@UDCPTR;                             02882000
               STUFF; << IN COMIMAGE >>                                 02884000
               DONE := TRUE;                                            02886000
            END;                                                        02888000
         END UNTIL DONE; << PARM LOOP >>                                02890000
                                                                        02892000
            << NOW PARSED COMPLETE BODY IMAGE >>                        02894000
         IF OPTIONS.CIS'OPTLIST THEN                           <<04603>>02896000
         BEGIN                                                          02898000
            TOS := @COMIMAGE&LSR(1); << WORD ADDRESS >>                 02900000
            PRINT(*,-COMLEN,0);                                         02902000
         END;                                                           02904000
         COMIMAGE(COMLEN) := CR; << STOPPER FOR CI>>                    02906000
                                                                        02908000
            << DEBLANK ON FRONT >>                                      02910000
         SCAN COMIMAGE WHILE %6440,1; << " " >>                         02912000
         @PARMPTR := TOS;                                               02914000
         IF NOCARRY THEN MOVE COMIMAGE:=PARMPTR,(COMLEN+1)     <<01126>>02916000
            ELSE COMLEN:=0; << ALL BLANK LINE >>               <<01126>>02918000
                                                                        02920000
         IF COMLEN > 0 THEN                                    <<01075>>02922000
            BEGIN                                              <<01075>>02924000
            UDCCI(OFFSET);                                     <<01075>>02926000
            IF CIS'UDCFATALCIERR OR                            <<04603>>02928000
               CIS'UDCBREAKDETECTED OR CIS'UDCFLUSH THEN       <<04603>>02930000
               ERRNO := UDC'FLUSHED;  << FLUSH UDC'S >>        <<01288>>02932000
            END;                                               <<01075>>02934000
         IF (CIS'UDCNESTLEVEL=0) OR CIS'UDCEXITBREAK THEN      <<04603>>02936000
               ERRNO := UDC'FLUSHED;  << ALSO, FLUSH UDC'S >>  <<01288>>02938000
      END;                                                              02940000
   END;                                                                 02942000
                                                               <<01360>>02944000
   SKIP'THIS'LINE:                                             <<01360>>02946000
                                                               <<01360>>02948000
END UNTIL ERRNO <> -1;                                                  02950000
                                                                        02952000
OUTL:                                                                   02954000
END; << FEEDCI >>                                                       02956000
$TITLE "FINDCOMUSER"                                                    02958000
PROCEDURE FINDCOMUSER(COMFN,UNAME,ANAME,UDCSEXIST,USERREC,     <<00884>>02960000
                                        FILEREC,ERRNO);        <<00884>>02962000
   VALUE COMFN;                                                <<00884>>02964000
   INTEGER COMFN,USERREC,FILEREC,ERRNO;                        <<00884>>02966000
   LOGICAL UDCSEXIST;                                          <<00884>>02968000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>02970000
   OPTION UNCALLABLE;                                          <<00884>>02972000
COMMENT                                                        <<00884>>02974000
   Locates user & account in Command file. Starts by using     <<00884>>02976000
   record number kept in directory.  If this record number     <<00884>>02978000
   is not valid (i.e., the Command file has changed since      <<00884>>02980000
   the record number was saved) then a linear search of the    <<00884>>02982000
   Command file is performed. The record number in the         <<00884>>02984000
   directory is updated to match the current Command file.     <<00884>>02986000
;                                                              <<00884>>02988000
BEGIN                                                          <<00884>>02990000
DOUBLE                                                         <<00884>>02992000
   RECNO;                                                      <<00884>>02994000
ARRAY                                                          <<00884>>02996000
   REC'(0:COMRECSIZEM1);                                       <<00884>>02998000
BYTE ARRAY                                                     <<00884>>03000000
   REC(*) = REC';                                              <<00884>>03002000
                                                               <<00884>>03004000
SUBROUTINE SEARCHFORUSER;                                      <<00884>>03006000
   BEGIN                                                       <<00884>>03008000
   USERREC := 1;  << Begin search at begining of file >>       <<00884>>03010000
   SEARCHCOMFILE(COMFN,UNAME,ANAME,USERREC,FILEREC,ERRNO);     <<00884>>03012000
   IF ERRNO = 0 THEN                                           <<00884>>03014000
         << Found user. Must update directory record number >> <<00884>>03016000
      UDCDIRCWRITE(UNAME,ANAME,UDCSEXIST,USERREC)              <<00884>>03018000
   ELSE                                                        <<00884>>03020000
      BEGIN                                                    <<00884>>03022000
      USERREC := FILEREC := 0;                                 <<00884>>03024000
      IF ERRNO = EOFOUND THEN ERRNO := NOSUCHCOMUSER;          <<00884>>03026000
      END;                                                     <<00884>>03028000
   END;  << SEARCHCOMFILE >>                                   <<00884>>03030000
                                                               <<00884>>03032000
ERRNO := 0;                                                    <<00884>>03034000
UDCDIRCREAD(UNAME,ANAME,UDCSEXIST,USERREC);                    <<00884>>03036000
IF UDCSEXIST THEN                                              <<00884>>03038000
   BEGIN << Verify that directory pointer is valid. >>         <<00884>>03040000
   FREADDIR(COMFN,REC',COMRECSIZE,DOUBLE(USERREC));            <<00884>>03042000
   IF < THEN ERRNO := COMREADFAIL                              <<00884>>03044000
   ELSE                                                        <<00884>>03046000
         << Bad pointer in Directory. Must search. >>          <<00884>>03048000
      IF > THEN SEARCHFORUSER                                  <<00884>>03050000
      ELSE                                                     <<00884>>03052000
         << Verify this is the correct entry >>                <<00884>>03054000
         IF REC'(COMENTRYTYPE) = COMUSERENTRY AND              <<00884>>03056000
            REC(COMUNAME) = UNAME,(8) AND                      <<00884>>03058000
            REC(COMANAME) = ANAME,(8) THEN                     <<00884>>03060000
               << found correct entry >>                       <<00884>>03062000
               FILEREC := REC'(COMLINK)                        <<00884>>03064000
         ELSE                                                  <<00884>>03066000
               << Bad pointer. Must search. >>                 <<00884>>03068000
            SEARCHFORUSER;                                     <<00884>>03070000
   END;                                                        <<00884>>03072000
                                                               <<00884>>03074000
END;  << FINDCOMUSER >>                                        <<00884>>03076000
$TITLE "GETCOMREC"                                                      03078000
INTEGER PROCEDURE GETCOMREC(COMFN,ERRNO);                               03080000
   VALUE COMFN;                                                         03082000
   INTEGER COMFN,ERRNO;                                                 03084000
   OPTION UNCALLABLE;                                                   03086000
COMMENT RETURNS RECORD NUMBER OF 1ST FREE RECORD IN                     03088000
   COMMAND.PUB.SYS FILE                                                 03090000
;                                                                       03092000
                                                               <<03734>>03094000
<< Assumptions:  This procedure assumes that COMMAND.PUB.SYS >><<03734>>03096000
<<    (file number = COMFN ) was locked by the calling       >><<03734>>03098000
<<    procedure.                                             >><<03734>>03100000
                                                               <<03734>>03102000
BEGIN                                                                   03104000
                                                                        03106000
ARRAY REC0(0:COMRECSIZEM1);                                             03108000
ARRAY REC(0:COMRECSIZEM1);                                              03110000
INTEGER RECNO;                                                          03112000
                                                                        03114000
SUBROUTINE READ(BUF,REC);                                               03116000
   VALUE REC;                                                           03118000
   ARRAY BUF;                                                           03120000
   INTEGER REC;                                                         03122000
BEGIN                                                                   03124000
   FREADDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                          03126000
   IF <> THEN                                                           03128000
   BEGIN                                                                03130000
      ERRNO := COMREADFAIL;                                             03132000
      GO OUTL;                                                          03134000
   END;                                                                 03136000
END; << READ >>                                                         03138000
                                                                        03140000
SUBROUTINE WRITE(BUF,REC);                                              03142000
   VALUE REC;                                                           03144000
   ARRAY BUF;                                                           03146000
   INTEGER REC;                                                         03148000
BEGIN                                                                   03150000
   FWRITEDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                         03152000
   IF < THEN                                                            03154000
   BEGIN                                                                03156000
      ERRNO := COMWRITEFAIL;                                            03158000
      GO OUTL;                                                          03160000
   END                                                                  03162000
   ELSE                                                                 03164000
   IF > THEN                                                            03166000
   BEGIN                                                                03168000
      ERRNO := EOFOUND;                                                 03170000
      GO OUTL;                                                          03172000
   END;                                                                 03174000
END; << WRITE >>                                                        03176000
                                                                        03178000
   ERRNO := 0;                                                 <<03734>>03180000
   FREADDIR(COMFN,REC0,COMRECSIZE,0D);                                  03184000
   IF < THEN ERRNO := COMREADFAIL                                       03186000
   ELSE                                                                 03188000
   BEGIN                                                                03190000
      IF > THEN << UNITITIALIZED FILE >>                                03192000
      BEGIN                                                             03194000
         REC0 := 0;                                                     03196000
         MOVE REC0(1) := REC0,(COMRECSIZEM1);                           03198000
         REC0(COMFREEHEAD) := 1;                                        03200000
         WRITE(REC0,0);                                                 03202000
      END;                                                              03204000
         << UPDATE HEAD RECORD >>                                       03206000
      REC0(COMUSE) := REC0(COMUSE) +1;                                  03208000
      IF REC0(COMUSE) > REC0(COMMAXUSE) THEN REC0                       03210000
         (COMMAXUSE) := REC0(COMMAXUSE) +1;                             03212000
      GETCOMREC:=RECNO:=REC0(COMFREEHEAD); << FREE REC NO. >>           03214000
      FREADDIR(COMFN,REC,COMRECSIZE,DOUBLE(REC0(COMFREEHEAD)));         03216000
      IF > THEN << EOF. EXPAND FILE >>                                  03218000
      BEGIN                                                             03220000
         REC(COMLINK):=0; << IN CASE OF ERROR IN SETCATALOG >>          03222000
         WRITE(REC,REC0(COMFREEHEAD));                                  03224000
         REC0(COMFREEHEAD) := REC0(COMFREEHEAD) +1;                     03226000
         WRITE(REC0,0);                                                 03228000
      END                                                               03230000
      ELSE                                                              03232000
      IF < THEN ERRNO := COMREADFAIL                                    03234000
      ELSE                                                              03236000
      BEGIN                                                             03238000
         << GET NEXT FREE REC & STUFF IN HEAD>>                         03240000
         REC0(COMFREEHEAD) := REC(COMLINK);                             03242000
         WRITE(REC0,0);                                                 03244000
         REC(COMLINK):=0; << IN CASE OF ERROR IN SETCATALOG >>          03246000
         WRITE(REC,RECNO);                                              03248000
      END;                                                              03250000
   END;                                                                 03252000
                                                                        03256000
OUTL:                                                                   03258000
END; << GETCOMREC >>                                                    03260000
$TITLE "INITUDC"                                                        03262000
PROCEDURE INITUDC( SHOW, SETCATCOMFN );                        <<03734>>03264000
   VALUE    SHOW, SETCATCOMFN;                                 <<03734>>03266000
   LOGICAL  SHOW;                                              <<03734>>03268000
   INTEGER  SETCATCOMFN;                                       <<03734>>03270000
   OPTION   UNCALLABLE, VARIABLE;                              <<03734>>03272000
COMMENT                                                                 03274000
   OPENS COMMAND FILE & EACH UDC FILE, THEN BUILDS DIRECTORY            03276000
   OF COMMAND NAMES & RECNOS IN DATA SEGMENT. DIRECTORY ENTRY           03278000
   IS AS FOLLOWS:                                                       03280000
   ******************************                                       03282000
   *L*O*H*B*      * ENTRYSIZE   *   L = LIST                            03284000
   ******************************   O = LOGON                           03286000
   *      RECNO                 *   H = NOHELP                          03288000
   ******************************   B = NOBREAK                         03290000
   *      BODYRECNO             *                                       03292000
   ******************************                                       03294000
   *  FILE NO.    * CMDLEN      *                                       03296000
   ******************************                                       03298000
   * COMMAND (MAX. 16 BYTES)    *                                       03300000
   /                            /                                       03302000
   ******************************                                       03304000
                                                                        03306000
   ENTRYSIZE = 0 INDICATES END OF DIRECTORY.                            03308000
                                                                        03310000
;                                                                       03312000
                                                               <<04651>>03314000
<<                                                         >>  <<04651>>03316000
<< Fix Information:                                        >>  <<04651>>03318000
<<                                                         >>  <<04651>>03320000
<< * This fix causes logon UDCs to execute on each level,  >>  <<04651>>03322000
<<   with the logon hierarchy of System-Account-User.  At  >>  <<04651>>03324000
<<   most one logon UDC will execute on each level, so the >>  <<04651>>03326000
<<   maximum number of executing logon UDCs is three.  The >>  <<04651>>03328000
<<   hierarchy was chosen to allow system manager to en-   >>  <<04651>>03330000
<<   force any site-specific security check at logon       >>  <<04651>>03332000
<<   before users have a chance to perform any operations. >>  <<04651>>03334000
<<   Normal UDCs will continue to have the User-Acct-Sys   >>  <<04651>>03336000
<<   hierarchy that was designed to let system managers    >>  <<04651>>03338000
<<   remove specific commands from the CI set.             >>  <<04651>>03340000
<<                                                         >>  <<04651>>03342000
<<                                                          >> <<04631>>03344000
<< Fix information:                                         >> <<04631>>03346000
<<                                                          >> <<04631>>03348000
<< * With this fix, UDC's with OPTION NOHELP will not be    >> <<04631>>03350000
<<   displayed with the execution of                        >> <<04631>>03352000
<<   :SETCATALOG [ufiles..];SHOW.  All OPTION's for a UDC   >> <<04631>>03354000
<<   will be displayed on one OPTION line when ;SHOW is     >> <<04631>>03356000
<<   specified.                                             >> <<04631>>03358000
<<   Lockwords for the UDC files are not displayed when     >> <<04631>>03360000
<<   ;SHOW is specifed                                      >> <<04631>>03362000
<<                                                          >> <<04631>>03364000
BEGIN                                                                   03366000
                                                                        03368000
   ENTRY INITUDCNO; << DON'T DO LOGON >>                                03370000
                                                                        03372000
                                                                        03374000
INTEGER                                                                 03376000
   I,                                                          <<00416>>03378000
   FNX := -1,                                                  <<01510>>03380000
   UDCDSTN,                                                             03382000
   COMFN  := 0,                                                <<03734>>03384000
   UDCFN,                                                               03386000
   FLEN,                                                       <<04846>>03388000
   FGLWDLEN,          << UDC file lockword length >>           <<04846>>03390000
   FGLWDERR,          << FGETLOCKWORD error.      >>           <<04846>>03392000
   LEN,                                                                 03394000
   DUMMY = LEN,                                                         03396000
   ENTRYLEN,                                                            03398000
   RECNO,                                                               03400000
   RECNONEXT,                                                           03402000
   COMRECNO,                                                            03404000
   ERRNO,                                                               03406000
   OFFSET,                                                              03408000
   PASS:=1,                                                    <<04631>>03410000
   OLEN:=10,                                                   <<04631>>03412000
   TEMPLEN,                                                    <<04631>>03414000
   OLDOFFSET;                                                           03416000
                                                                        03418000
BYTE POINTER                                                            03420000
   PTR,                                                                 03422000
   SAVEPTR,                                                    <<01529>>03424000
   SPTR;                                                                03426000
                                                                        03428000
LOGICAL                                                                 03430000
   HAVEHELP:=FALSE,                                            <<04631>>03432000
   HAVEBREAK:=FALSE,                                           <<04631>>03434000
   HAVENOLOGON:=FALSE,                                         <<04631>>03436000
   HAVENOLIST:=FALSE,                                          <<04631>>03438000
   HAVEOPTIONS,                                                <<04631>>03440000
   HAVENOHELP:=FALSE,                                          <<04631>>03442000
   HAVENOBREAK:=FALSE,                                         <<04631>>03444000
   HAVELIST:=FALSE,                                            <<04631>>03446000
   HAVELOGON:=FALSE,                                           <<04631>>03448000
   FOUNDUDC:=FALSE,                                            <<00416>>03450000
   UDCSEXIST,                                                  <<00884>>03452000
   OLDCRIT,                                                    <<04810>>03454000
   FINDCMD,                                                             03456000
   FOUNDLOGON,                                                          03458000
   FOUNDANYLOGON := FALSE,    << Logon UDC at any level. >>    <<04651>>03460000
   OPTIONS,                                                             03462000
   FINDOPTION,                                                          03464000
   DOLOGON;                                                             03466000
DOUBLE NUM'RECS,                                               <<04846>>03468000
       FENTRY'RECNO;          << File entry record number >>   <<04846>>03470000
                                                               <<04651>>03472000
INTEGER ARRAY                                                  <<04651>>03474000
   LOGON'OFFSETS(0:UDCTYPE'NUMLEVELS-1);                       <<04651>>03476000
                                                                        03478000
LOGICAL ARRAY OPTLINEL(0:126);                                 <<04631>>03480000
BYTE ARRAY OPTLINE(*)=OPTLINEL;                                <<04631>>03482000
LOGICAL ARRAY TCMD(0:500);                                     <<04631>>03484000
BYTE ARRAY TEMPCMD(*)=TCMD;                                    <<04631>>03486000
BYTE ARRAY UDCLEVEL(0:7);                                      <<00884>>03488000
BYTE ARRAY LOGONCMD(0:UDCTYPE'NUMLEVELS*(1+DIRMAXCMDSIZE));    <<04651>>03490000
BYTE ARRAY USER(0:7),ACCOUNT(0:7),WILDCARD(0:7);               <<00416>>03492000
ARRAY DISPLAYBUFF'(0:UDCBUFFSIZE +2);                                   03494000
ARRAY BUFF'(*) = DISPLAYBUFF'(2);                                       03496000
BYTE ARRAY BUFF(*) = BUFF';                                             03498000
ARRAY TEMPBUFF'(0:UDCRECSIZE);                                 <<04846>>03500000
BYTE ARRAY TEMPBUFF(*) = TEMPBUFF';                            <<04846>>03502000
BYTE ARRAY DISPLAYBUFF(*) = DISPLAYBUFF';                               03504000
INTEGER ARRAY                                                  <<01510>>03506000
   FNUMS(0:MAXSCPARMSM1);                                      <<01510>>03508000
                                                                        03510000
POINTER DIR'; BYTE POINTER DIR;                                         03512000
                                                                        03514000
                                                                        03516000
SUBROUTINE DEF'MOVETODSEG;                                              03518000
                                                                        03520000
SUBROUTINE ERR(ERRNO,FN);                                               03522000
   VALUE ERRNO,FN;INTEGER ERRNO,FN;                                     03524000
BEGIN                                                                   03526000
   IF ERRNO > 0 THEN ERROR(ERRNO,FERR,FN);                              03528000
   GO OUTL;                                                             03530000
END;  << ERR >>                                                         03532000
                                                                        03534000
SUBROUTINE UERR(ERRNO,FN);                                              03536000
   VALUE ERRNO,FN;INTEGER ERRNO,FN;                                     03538000
BEGIN << ERROR ON UDC >>                                                03540000
   ERROR(ERRNO,UDCFERR,FN,BUFF(COMFNAME));                              03542000
      << FILE NAME WILL BE USED ONLY IF FN=0>>                          03544000
   GO OUTL;                                                             03546000
END;  << UERR >>                                                        03548000
                                                                        03550000
SUBROUTINE SEMERR(ERRNO);                                               03552000
   VALUE ERRNO; INTEGER ERRNO;                                          03554000
BEGIN << SEMANTIC ERROR >>                                              03556000
      << STACK OVERFLOW, BAD UDC FILE >>                                03558000
   ERROR(ERRNO,UDCERR);                                                 03560000
   GO OUTL;                                                             03562000
END; << SEMERR >>                                                       03564000
                                                                        03566000
                                                                        03568000
INTEGER SUBROUTINE CHKOPTION;                                           03570000
<< Subroutine is called for each line of the UDC body until >> <<04631>>03572000
<< FINDOPTIONS goes FALSE inside this routine.  It creates  >> <<04631>>03574000
<< a line containing the UDC's user defined options.  The   >> <<04631>>03576000
<< line is printed in the calling routine after FINDOPTIONS >> <<04631>>03578000
<< is FALSE.  OPTION lines must (and are treated as) follow >> <<04631>>03580000
<< immediately and sequentially after the UDC command       >> <<04631>>03582000
<< definition.                                              >> <<04631>>03584000
<< Only one of NOHELP/HELP, NOBREAK/BREAK, NOLIST/LIST      >> <<04631>>03586000
<< or NOLOGON/LOGON is allowed.                             >> <<04631>>03588000
BEGIN << RETURNS BODYRECNO >>                                           03590000
   FINDPARM(BUFF,SPTR,PTR);                                             03592000
   IF SPTR = "OPTION" THEN                                              03594000
   BEGIN                                                                03596000
      @SAVEPTR := @SPTR;                                       <<01529>>03598000
      HAVEOPTIONS:=TRUE;                                       <<04631>>03600000
      CHKOPTION := RECNONEXT;                                           03602000
      NEXTPARM( PTR, SPTR, PTR );                              <<01529>>03604000
      WHILE SPTR <> 0 DO                                                03606000
      BEGIN                                                             03608000
                                                               <<01529>>03610000
         CASE OPTIONO(SPTR) OF                                          03612000
         BEGIN                                                          03614000
            <<0>> ERROR(-UNKNOWNOPTION,SYNERR,SPTR,SAVEPTR);   <<04631>>03616000
            <<1>> IF HAVELIST=FALSE THEN                       <<04631>>03618000
                     IF HAVENOLIST THEN CIERR(-LISTWARN)       <<04631>>03620000
                        ELSE                                   <<04631>>03622000
                        BEGIN                                  <<04631>>03624000
                        OPTIONS.CIS'OPTLIST:=TRUE;             <<04631>>03626000
                        MOVE OPTLINE(OLEN):=" LIST,";          <<04631>>03628000
                        OLEN:=OLEN+6;                          <<04631>>03630000
                        HAVELIST:=TRUE;                        <<04631>>03632000
                        END;                                   <<04631>>03634000
            <<2>> IF HAVELOGON=FALSE THEN                      <<04631>>03636000
                     IF HAVENOLOGON THEN CIERR(-LOGONWARN)     <<04631>>03638000
                        ELSE                                   <<04631>>03640000
                        BEGIN                                  <<04631>>03642000
                        MOVE OPTLINE(OLEN):=" LOGON,";         <<04631>>03644000
                        IF NOT FOUNDLOGON<<1st logon UDC,this>><<04631>>03646000
                           THEN LOGON'OFFSETS(I)  << level >>  <<04631>>03648000
                                :=OLDOFFSET;                   <<04631>>03650000
                        FOUNDANYLOGON:=FOUNDLOGON:=TRUE;       <<04631>>03652000
                        OPTIONS.CIS'OPTLOGON:=TRUE;            <<04631>>03654000
                        OLEN:=OLEN+7;                          <<04631>>03656000
                        HAVELOGON:=TRUE;                       <<04631>>03658000
                        END;                                   <<04631>>03660000
            <<3>> IF HAVENOHELP=FALSE THEN                     <<04631>>03662000
                     IF HAVEHELP THEN CIERR(-NOHELPWARN)       <<04631>>03664000
                        ELSE                                   <<04631>>03666000
                        BEGIN                                  <<04631>>03668000
                        OPTIONS.CIS'OPTNOHELP:=TRUE;           <<04631>>03670000
                        MOVE OPTLINE(OLEN):=" NOHELP,";        <<04631>>03672000
                        OLEN:=OLEN+8;                          <<04631>>03674000
                        HAVENOHELP:=TRUE;                      <<04631>>03676000
                        END;                                   <<04631>>03678000
            <<4>> IF HAVENOBREAK=FALSE THEN                    <<04631>>03680000
                     IF HAVEBREAK THEN CIERR(-NOBREAKWARN)     <<04631>>03682000
                        ELSE                                   <<04631>>03684000
                        BEGIN                                  <<04631>>03686000
                        HAVENOBREAK:=TRUE;                     <<04631>>03688000
                        OPTIONS.CIS'OPTNOBREAK:=TRUE;          <<04631>>03690000
                        MOVE OPTLINE(OLEN):=" NOBREAK,";       <<04631>>03692000
                        OLEN:=OLEN+9;                          <<04631>>03694000
                        END;                                   <<04631>>03696000
            <<5>> IF HAVENOLIST=FALSE THEN                     <<04631>>03698000
                     IF HAVELIST THEN CIERR(-NOLISTWARN)       <<04631>>03700000
                        ELSE                                   <<04631>>03702000
                        BEGIN                                  <<04631>>03704000
                        MOVE OPTLINE(OLEN):=" NOLIST,";        <<04631>>03706000
                        OLEN:=OLEN+8;                          <<04631>>03708000
                        HAVENOLIST:=TRUE;                      <<04631>>03710000
                        END;                                   <<04631>>03712000
            <<6>> IF HAVENOLOGON=FALSE THEN                    <<04631>>03714000
                     IF HAVELOGON THEN CIERR(-NOLOGONWARN)     <<04631>>03716000
                        ELSE                                   <<04631>>03718000
                        BEGIN                                  <<04631>>03720000
                        MOVE OPTLINE(OLEN):=" NOLOGON,";       <<04631>>03722000
                        OLEN:=OLEN+9;                          <<04631>>03724000
                        HAVENOLOGON:=TRUE;                     <<04631>>03726000
                        END;                                   <<04631>>03728000
            <<7>> IF HAVEHELP=FALSE THEN                       <<04631>>03730000
                     IF HAVENOHELP THEN CIERR(-HELPWARN)       <<04631>>03732000
                        ELSE                                   <<04631>>03734000
                        BEGIN                                  <<04631>>03736000
                        MOVE OPTLINE(OLEN):=" HELP,";          <<04631>>03738000
                        OLEN:=OLEN+6;                          <<04631>>03740000
                        HAVEHELP:=TRUE;                        <<04631>>03742000
                        END;                                   <<04631>>03744000
            <<8>> IF HAVEBREAK = FALSE THEN                    <<04631>>03746000
                     IF HAVENOBREAK THEN CIERR(-BREAKWARN)     <<04631>>03748000
                        ELSE                                   <<04631>>03750000
                        BEGIN                                  <<04631>>03752000
                        MOVE OPTLINE(OLEN):=" BREAK,";         <<04631>>03754000
                        OLEN:=OLEN+7;                          <<04631>>03756000
                        HAVEBREAK:=TRUE;                       <<04631>>03758000
                        END;                                   <<04631>>03760000
              END; << CASE >>                                  <<04631>>03762000
         NEXTPARM( PTR, SPTR, PTR );                           <<01529>>03764000
                                                               <<01529>>03766000
      END;                                                              03768000
   END                                                                  03770000
   ELSE                                                                 03772000
   BEGIN << NO "OPTION">>                                               03774000
      FINDOPTION := FALSE;                                              03776000
      CHKOPTION := RECNO;                                               03778000
   END;                                                                 03780000
END; << CHKOPTION >>                                                    03782000
                                                                        03784000
                                                                        03786000
   << INITUDC MAIN BODY >>                                              03788000
                                                                        03790000
DOLOGON := TRUE;   << CALLED FROM COMMANDINTERP >>                      03792000
GO MAIN;                                                                03794000
                                                                        03796000
                                                                        03798000
INITUDCNO:  << DON'T DO LOGON COMMAND WHILE LOGGED ON>>                 03800000
            << CALLED FROM :SETCATALOG               >>                 03802000
MOVE OPTLINE(0):="    OPTION";                                 <<04631>>03804000
                                                                        03806000
DOLOGON := FALSE;                                                       03808000
COMFN := SETCATCOMFN;  << CXSETCATALOG has already opened and>><<03734>>03810000
                       << locked COMMAND.PUB.SYS.            >><<03734>>03812000
                                                               <<03734>>03814000
                                                                        03816000
MAIN:                                                                   03818000
FGLWDERR := 0;         << Initialize FGETLOCKWORD error >>     <<04846>>03820000
LOGONCMD := CR;     << Blank out logon UDC command image. >>   <<04651>>03822000
MOVE LOGONCMD(1)                                               <<04651>>03824000
   := LOGONCMD, (UDCTYPE'NUMLEVELS*(1+DIRMAXCMDSIZE) );        <<04651>>03826000
                                                               <<04651>>03828000
LOGON'OFFSETS(UDCTYPE'USER) := -1;     << This will hold the >><<04651>>03830000
LOGON'OFFSETS(UDCTYPE'ACCOUNT) := -1;  << directory offsets  >><<04651>>03832000
LOGON'OFFSETS(UDCTYPE'SYSTEM) := -1;   << for logon UDCs.    >><<04651>>03834000
                                                                        03836000
MOVE WILDCARD:="@       ";                                     <<00416>>03838000
ZSIZE(UDCINITSTACKSIZE);                                                03840000
MOVE DISPLAYBUFF' := "    ";                                            03842000
IF DOLOGON THEN        << Not called by CXSETCATALOG.        >><<03734>>03844000
BEGIN                                                          <<03734>>03846000
   MOVE BUFF := "COMMAND.PUB.SYS ";                            <<03734>>03848000
   COMFN := FOPEN( BUFF, 1, %346 );  << Old; SHR,LOCK,EXEC.  >><<03734>>03850000
   IF <> THEN ERR( COMOPENFAIL, COMFN );                       <<03734>>03852000
   OLDCRIT := SETCRITICAL;                                     <<04810>>03854000
   FLOCK( COMFN, TRUE );                                       <<03734>>03856000
   IF <> THEN ERR( COMLOCKFAIL, COMFN );                       <<03734>>03858000
END;                                                           <<03734>>03860000
WHO(,,,USER,,ACCOUNT); <<GET USER'S NAME & ACCOUNT>>           <<00416>>03862000
I:=UDCTYPE'USER-1;<<INIT LOOP CTR FOR SCAN THRU UDC LEVELS>>   <<00416>>03864000
                                                               <<00884>>03866000
<<*************************************>>                      <<00884>>03868000
<<    Start of loop thru UDC levels    >>                      <<00884>>03870000
<<*************************************>>                      <<00884>>03872000
                                                               <<00884>>03874000
WHILE (I:=I+1)<=UDCTYPE'SYSTEM DO                              <<00416>>03876000
BEGIN                                                          <<00416>>03878000
                                                               <<04651>>03880000
   FOUNDLOGON := FALSE;  << Marks logon UDC, this level. >>    <<04651>>03882000
   CASE I OF                                                   <<00416>>03884000
   BEGIN                                                       <<00416>>03886000
      FINDCOMUSER(COMFN,USER,ACCOUNT,UDCSEXIST,RECNO,          <<00884>>03888000
                                          COMRECNO,ERRNO);     <<00884>>03890000
      FINDCOMUSER(COMFN,WILDCARD,ACCOUNT,UDCSEXIST,RECNO,      <<00884>>03892000
                                          COMRECNO,ERRNO);     <<00884>>03894000
      FINDCOMUSER(COMFN,WILDCARD,WILDCARD,UDCSEXIST,RECNO,     <<00884>>03896000
                                        COMRECNO,ERRNO);       <<00884>>03898000
   END;                                                        <<00416>>03900000
   IF ERRNO <> 0 THEN                                          <<00884>>03902000
      IF ERRNO = NOSUCHCOMUSER THEN                            <<00884>>03904000
         BEGIN                                                 <<00884>>03906000
         CASE I OF                                             <<00884>>03908000
            BEGIN                                              <<00884>>03910000
            MOVE UDCLEVEL := ("USER",0);                       <<00884>>03912000
            MOVE UDCLEVEL := ("ACCOUNT",0);                    <<00884>>03914000
            MOVE UDCLEVEL := ("SYSTEM",0);                     <<00884>>03916000
            END;                                               <<00884>>03918000
         CIERR(-NOSUCHCOMUSER,,0,@UDCLEVEL);                   <<00884>>03920000
         GO TO OUTLOOP;                                        <<00884>>03922000
         END                                                   <<00884>>03924000
      ELSE ERR(ERRNO,COMFN);                                   <<00884>>03926000
                                                               <<00884>>03928000
IF NOT UDCSEXIST THEN GO TO OUTLOOP;                           <<00884>>03930000
                                                                        03932000
IF FOUNDUDC THEN GO TO GOTINIT;                                <<00416>>03934000
FOUNDUDC:=TRUE;                                                <<00416>>03936000
   << CHECK SPACE FOR DIR, GET SPACE >>                                 03938000
ASSEMBLE(ZERO; LRA S-0);                                                03940000
@DIR' := TOS;                                                           03942000
ZSIZE(@DIR' +DIRSIZEM1);                                                03944000
IF > THEN SEMERR(STACKOVERFLOW);                                        03946000
TOS := DIRSIZEM1;                                                       03948000
ASSEMBLE(ADDS 0);                                                       03950000
@DIR := @DIR'&LSL(1);                                                   03952000
                                                                        03954000
   << ZERO DIRECTORY >>                                                 03956000
DIR' := 0;                                                              03958000
MOVE DIR'(1) := DIR',(DIRSIZEM1);                                       03960000
                                                                        03962000
<< SET UP FOR BIG LOOP >>                                               03964000
OLDOFFSET := OFFSET := 0;                                               03966000
GOTINIT:                                                       <<00416>>03968000
   <<**************************************************>>      <<00884>>03970000
   <<    Start of loop thru UDC files at this level    >>      <<00884>>03972000
   <<**************************************************>>      <<00884>>03974000
                                                               <<00884>>03976000
DO BEGIN                                                                03978000
   FREADDIR(COMFN,BUFF',COMRECSIZE,DOUBLE(COMRECNO));                   03980000
   IF <> THEN ERR(COMREADFAIL,COMFN);                                   03982000
   FENTRY'RECNO := DOUBLE(COMRECNO);                           <<04846>>03984000
   COMRECNO := BUFF'(COMLINK);                                          03986000
   UDCFN := PVOPEN(BUFF(COMFNAME),1,%200);<<OLD,EAR>>                   03988000
   IF <> THEN                                                           03990000
   BEGIN                                                                03992000
      SCAN BUFF(COMFNAME) UNTIL "/",1;                                  03994000
      @PTR := TOS;                                                      03996000
      IF NOCARRY THEN << GET RID OF PASSWORD IN FILE NAME >>            03998000
      BEGIN                                                             04000000
         MOVE PTR(1) := PTR(1) WHILE AN,1;                              04002000
         @SPTR := TOS;                                                  04004000
         MOVE PTR := SPTR, (19); << OVERLAY PASSWORD >>                 04006000
      END;                                                              04008000
      ERROR(UDCOPENFAIL,UDCFERR,UDCFN,BUFF(COMFNAME));                  04010000
      GO TO OUTL;                                              <<00884>>04012000
   END                                                                  04014000
   ELSE                                                                 04016000
   BEGIN                                                                04018000
      FNUMS( FNX := FNX + 1 ) := UDCFN;  << Save file num >>   <<01510>>04020000
                                                               <<04846>>04022000
   << If UDCs are being initialized through CXSETCATALOG,  >>  <<04846>>04024000
   << then we must ensure that UDC file lockwords appear   >>  <<04846>>04026000
   << in the file entries in COMMAND.PUB.SYS.  This can    >>  <<04846>>04028000
   << only be done after the file is opened, so these      >>  <<04846>>04030000
   << actions are performed here as opposed to within the  >>  <<04846>>04032000
   << CXSETCATALOG executor.  Special handling needs to    >>  <<04846>>04034000
   << happen if the call to FGETLOCKWORD fails--in INITUDC >>  <<04846>>04036000
   << this is signaled by a non-zero FGLWDERR; in          >>  <<04846>>04038000
   << CXSETCATALOG, this is signaled by a negative UDCDSTN.>>  <<04846>>04040000
      IF NOT DOLOGON THEN         << CXSETCATALOG call.        <<04846>>04042000
      BEGIN                                                    <<04846>>04044000
                                                               <<04846>>04046000
         SCAN BUFF(COMFNAME) UNTIL "/.", 1;                    <<04846>>04048000
         IF CARRY                                              <<04846>>04050000
            THEN DEL     << Lockword already in entry.     >>  <<04846>>04052000
         ELSE                                                  <<04846>>04054000
         BEGIN                                                 <<04846>>04056000
                                                               <<04846>>04058000
         << Add lockword to COMMAND.PUB.SYS entry.         >>  <<04846>>04060000
            FLEN := TOS - @BUFF(COMFNAME);                     <<04846>>04062000
            TEMPBUFF := " ";                                   <<04846>>04064000
            MOVE TEMPBUFF(1) := TEMPBUFF, (35);                <<04846>>04066000
            FGLWDLEN := 0;                                     <<04846>>04068000
            MOVE TEMPBUFF(COMFNAME) := BUFF(COMFNAME), (FLEN); <<04846>>04070000
            TEMPBUFF( COMFNAME+FLEN ) := "/";                  <<04846>>04072000
            FGLWDERR := FGETLOCKWORD( UDCFN,                   <<04846>>04074000
                           TEMPBUFF(COMFNAME+FLEN+1),          <<04846>>04076000
                           FGLWDLEN                    );      <<04846>>04078000
            IF FGLWDERR <> 0 THEN GO OUTL;                     <<04846>>04080000
                                                               <<04846>>04082000
            IF FGLWDLEN <> 0 THEN                              <<04846>>04084000
            BEGIN                                              <<04846>>04086000
                                                               <<04846>>04088000
            << If the lockword length is zero, then the    >>  <<04846>>04090000
            << file has no lockword.                       >>  <<04846>>04092000
               TEMPBUFF'(COMLINK) := BUFF'(COMLINK);           <<04846>>04094000
               TEMPBUFF'(COMENTRYTYPE) := BUFF'(COMENTRYTYPE); <<04846>>04096000
               MOVE TEMPBUFF(COMFNAME+FLEN+FGLWDLEN+1)         <<04846>>04098000
                    := BUFF(COMFNAME+FLEN),                    <<04846>>04100000
                 (36-(COMFNAME+FLEN));                         <<04846>>04102000
               FWRITEDIR( COMFN, TEMPBUFF',                    <<04846>>04104000
                          COMRECSIZE, FENTRY'RECNO );          <<04846>>04106000
               IF <> THEN ERR( COMWRITEFAIL, COMFN );          <<04846>>04108000
                                                               <<04846>>04110000
            END;                                               <<04846>>04112000
                                                               <<04846>>04114000
         END;                                                  <<04846>>04116000
                                                               <<04846>>04118000
      END;  << Adding lockwords for SETCATALOGed files. >>     <<04846>>04120000
                                                               <<04846>>04122000
                                                               <<04631>>04124000
      IF SHOW THEN BEGIN                                       <<04631>>04126000
              SCAN BUFF(COMFNAME) UNTIL "/",1;                 <<04631>>04128000
              @PTR:=TOS;                                       <<04631>>04130000
              IF NOCARRY THEN BEGIN << GET RID OF PASSWORD >>  <<04631>>04132000
                              MOVE PTR(1):=PTR(1) WHILE AN,1;  <<04631>>04134000
                              @SPTR:=TOS;                      <<04631>>04136000
                              MOVE PTR:=SPTR,(19);             <<04631>>04138000
                              END;                             <<04631>>04140000
              GENMSG(-1,@BUFF(COMFNAME));                      <<04631>>04142000
              END;                                             <<04631>>04144000
         << DISPLAY FILE NAME >>                                        04146000
                                                                        04148000
      FGETINFO(UDCFN,,,,,,,,,,NUM'RECS);                       <<01306>>04150000
      IF NUM'RECS = 0D THEN SEMERR(UDCEMPTY);                  <<01306>>04152000
         << SET UP FOR LOOP >>                                          04154000
      RECNO := RECNONEXT := 0;                                          04156000
      FINDCMD := TRUE;                                                  04158000
      DO BEGIN << WHIRL THRU FILE & BUILD DIRECTORY >>                  04160000
         READFILE(UDCFN,RECNONEXT,BUFF',ERRNO);                         04162000
                                                               <<04631>>04164000
         IF ERRNO = 0 AND SHOW THEN                            <<01532>>04166000
         BEGIN                                                 <<01532>>04168000
            SCAN DISPLAYBUFF UNTIL 0, 1;                       <<01532>>04170000
            LEN := TOS - @DISPLAYBUFF;                         <<01532>>04172000
             IF FINDCMD THEN                                   <<04631>>04174000
                BEGIN                                          <<04631>>04176000
                HAVEOPTIONS:=FALSE;                            <<04631>>04178000
                MOVE TEMPCMD(0) :=DISPLAYBUFF,(LEN);           <<04631>>04180000
                PASS:=1;                                       <<04631>>04182000
                TEMPLEN:=LEN;                                  <<04631>>04184000
                END;                                           <<04631>>04186000
         END;                                                  <<01532>>04188000
         IF ERRNO <> 0 AND ERRNO <> EOFOUND THEN                        04190000
         BEGIN                                                          04192000
            IF ERRNO = AMPERSANDERR THEN SEMERR(AMPERSANDERR)           04194000
            ELSE UERR(ERRNO,UDCFN);                                     04196000
         END;                                                           04198000
         IF ERRNO = EOFOUND THEN BUFF := "*" ELSE ERRNO:=-1;            04200000
         UPSHIFT(BUFF);  << UPSHIFT EVERYTHING >>                       04202000
         IF FINDCMD THEN                                                04204000
         BEGIN                                                          04206000
            IF ERRNO <> EOFOUND THEN                                    04208000
            BEGIN                                                       04210000
               OPTIONS := FINDCMD := FALSE;                             04212000
               FINDOPTION := TRUE;                                      04214000
                     SCAN BUFF UNTIL " ",1;                    <<01023>>04216000
                     LEN := TOS - @BUFF;                       <<01023>>04218000
                     IF LEN > DIRMAXCMDSIZE THEN               <<01023>>04220000
                        BEGIN                                  <<01023>>04222000
                            ERROR(CMDTOOLONG,IF SHOW THEN      <<01023>>04224000
                            SYNERRNOL ELSE SYNERR,BUFF,BUFF);  <<01531>>04226000
                            GO OUTL;<< OVER 16 CHARS NAME >>   <<01023>>04228000
                        END;                                   <<01023>>04230000
               IF BUFF <> ALPHA THEN                           <<01531>>04232000
               BEGIN                                           <<01531>>04234000
                  ERROR(CMDNOTALPHA,IF SHOW THEN SYNERRNOL     <<01531>>04236000
                        ELSE SYNERR, BUFF, BUFF            );  <<01531>>04238000
                  GO OUTL;   << FIRST CHAR NOT LETTER >>       <<01531>>04240000
               END;                                            <<01531>>04242000
               MOVE DIR(OFFSET + DIRCMD) := BUFF WHILE AN, 1;  <<01531>>04244000
               LEN := TOS - @DIR(OFFSET + DIRCMD);             <<01531>>04246000
               IF NOT FOUNDLOGON THEN                                   04248000
               BEGIN                                                    04250000
                  MOVE LOGONCMD( I*(1+DIRMAXCMDSIZE) )         <<04651>>04252000
                     := DIR( OFFSET + DIRCMD ), (LEN);         <<04651>>04254000
                  LOGONCMD( I*(1+DIRMAXCMDSIZE) + LEN )        <<04651>>04256000
                     := CR;  << Stopper for the CI >>          <<04651>>04258000
               END;                                                     04260000
               ENTRYLEN := DIRHEADSIZE +(LEN+1)&LSR(1);                 04262000
               DIR(OFFSET):=I;<<INIT LIST AREA WITH UDCTYPE>>  <<00416>>04264000
               DIR(OFFSET +DIRENTRYSIZE):=ENTRYLEN;<<WORDS>>            04266000
               DIR(OFFSET +DIRFILENO) := UDCFN;                         04268000
               DIR(OFFSET +DIRCMDLEN) := LEN;                           04270000
               DIR'(OFFSET&LSR(1) +DIRRECNO) := RECNO;                  04272000
               OLDOFFSET := OFFSET;                                     04274000
               OFFSET := OFFSET +ENTRYLEN*2;                            04276000
               IF OFFSET >= DIRSIZEB THEN ERR(                          04278000
                  TOOMANYCMDSFORDIR,-1);                                04280000
            END;                                                        04282000
         END                                                            04284000
         ELSE                                                           04286000
         BEGIN                                                          04288000
            IF FINDOPTION THEN DIR'(OLDOFFSET&LSR(1) +         <<01127>>04290000
               DIRBODYRECNO) := CHKOPTION;                     <<01127>>04292000
            IF FINDOPTION =FALSE                               <<04631>>04294000
            THEN IF((OPTIONS.CIS'OPTNOHELP=FALSE)LAND(SHOW))   <<04631>>04296000
             THEN BEGIN                                        <<04631>>04298000
                  IF PASS = 1 THEN                             <<04631>>04300000
                     BEGIN                                     <<04631>>04302000
                     PRINT(TCMD,-TEMPLEN,0);                   <<04631>>04304000
                     IF HAVEOPTIONS=TRUE THEN                  <<04631>>04306000
                     PRINT(OPTLINEL,-(OLEN-1),0);              <<04631>>04308000
                     PASS:=0;                                  <<04631>>04310000
                     END;                                      <<04631>>04312000
                  PRINT(DISPLAYBUFF',-LEN,0);                  <<04631>>04314000
                  END;                                         <<04631>>04316000
            IF BUFF = "*" THEN                                 <<01127>>04318000
            BEGIN                                              <<01127>>04320000
               FINDCMD := TRUE;                                <<01127>>04322000
               << NOW STUFF ALL OPTIONS >>                     <<01127>>04324000
               TOS := DIR'(OLDOFFSET&LSR(1));                  <<01127>>04326000
               DIR'(X) := TOS LOR OPTIONS;                     <<01127>>04328000
                     HAVEHELP:=FALSE;                          <<04631>>04330000
                     HAVEBREAK:=FALSE;                         <<04631>>04332000
                     HAVENOLOGON:=FALSE;                       <<04631>>04334000
                     HAVENOLIST:=FALSE;                        <<04631>>04336000
                     OLEN:=10;                                 <<04631>>04338000
                     HAVENOHELP:=FALSE;                        <<04631>>04340000
                     HAVENOBREAK:=FALSE;                       <<04631>>04342000
                     HAVELOGON:=FALSE;                         <<04631>>04344000
                     HAVELIST:=FALSE;                          <<04631>>04346000
            END;                                               <<01127>>04348000
         END;                                                           04350000
         RECNO := RECNONEXT;                                            04352000
      END UNTIL ERRNO <> -1;                                            04354000
   END;                                                                 04356000
END UNTIL COMRECNO = 0;                                                 04358000
                                                               <<00884>>04360000
   <<**************************************************>>      <<00884>>04362000
   <<    End of loop thru UDC files at this level      >>      <<00884>>04364000
   <<**************************************************>>      <<00884>>04366000
                                                               <<00884>>04368000
OUTLOOP:                                                       <<00416>>04370000
END;                                                           <<00416>>04372000
                                                               <<00884>>04374000
<<*************************************>>                      <<00884>>04376000
<<    End of loop thru UDC levels      >>                      <<00884>>04378000
<<*************************************>>                      <<00884>>04380000
                                                               <<00884>>04382000
IF NOT FOUNDUDC THEN GO TO OUTL;<<NO UDCS>>                    <<00416>>04384000
DIR(OFFSET +DIRENTRYSIZE) := 0; <<STOPPER>>                             04386000
OFFSET := OFFSET&LSR(1) +DIRHEAD;                                       04388000
LEN := LOGICAL(OFFSET+127) LAND %177600;                                04390000
UDCDSTN := GETDATASEG(LEN,LEN);                                         04392000
IF UDCDSTN = 0 THEN ERR(GETDATASEGERR,-1);                              04394000
MOVETODSEG(UDCDSTN,0,@DIR',OFFSET);                                     04396000
                                                                        04398000
UDCDSTNO := UDCDSTN; << SET UDC ON GLOBALLY >>                 <<04603>>04400000
                                                                        04402000
   << GIVE BACK DIRECTORY STACK SPACE >>                                04404000
TOS := DIRSIZEM1;                                                       04406000
ASSEMBLE(SUBS 0); << NOW CAN DO UDC >>                                  04408000
                                                                        04410000
<< Close COMMAND.PUB.SYS only if it was opened in INITUDC.   >><<03767>>04412000
<< Do not close the file if INITUDCNO (from CXSETCATALOG) was>><<03767>>04414000
<< the invoking entry point.  FCLOSE will handle unlocking   >><<03767>>04416000
<< the file.                                                 >><<03767>>04418000
IF DOLOGON THEN                                                <<04810>>04420000
BEGIN                                                          <<04810>>04422000
   FCLOSE( COMFN, 0, 0 );                                      <<04810>>04424000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>04426000
END;                                                           <<04810>>04428000
                                                               <<03767>>04430000
IF DOLOGON AND FOUNDANYLOGON THEN                              <<04651>>04432000
BEGIN                                                                   04434000
   COMMENT:                                                    <<00863>>04436000
      A CHECK IS MADE AT THIS POINT TO MAKE SURE WE DON'T      <<00863>>04438000
      EXECUTE A UDC AT LOGON THAT HAPPENS TO HAVE THE SAME     <<00863>>04440000
      NAME AS A LOGON UDC AT A LOWER (I.E., ACCT OR SYS) UDC   <<00863>>04442000
      LEVEL;                                                   <<00863>>04444000
                                                               <<04651>>04446000
<< Logon UDCs are executed in the System, Account, User  >>    <<04651>>04448000
<< order, with only one UDC per level executed.          >>    <<04651>>04450000
I := UDCTYPE'SYSTEM;                                           <<04651>>04452000
DO                                                             <<04651>>04454000
BEGIN                                                          <<04651>>04456000
   OFFSET := LOGON'OFFSETS(I);                                 <<04651>>04458000
   IF OFFSET > -1 THEN                      << Found logon >>  <<04651>>04460000
   BEGIN                                                       <<04651>>04462000
                                                               <<04651>>04464000
    OFFSET := OFFSET / 2;  << SEARCHUDC expects offset to  >>  <<04651>>04466000
    OLDOFFSET := OFFSET;   << be a word index into DIR.    >>  <<04651>>04468000
    IF SEARCHUDC( LOGONCMD( I*(1+DIRMAXCMDSIZE) ), OFFSET,     <<04651>>04470000
                  UDCFN, RECNO, RECNO, OPTIONS )               <<04651>>04472000
      THEN                                                     <<00863>>04474000
   BEGIN                                                       <<00863>>04476000
      IF OPTIONS.CIS'OPTLOGON THEN                             <<04603>>04478000
      BEGIN                                                    <<00863>>04480000
         MOVE CIS'BCOMIMAGE                                    <<04651>>04482000
             := LOGONCMD( I * (1+DIRMAXCMDSIZE) ),             <<04651>>04484000
                (DIRMAXCMDSIZE+1);  << Include the CR. >>      <<04651>>04486000
         UDC( CIS'BCOMIMAGE, OLDOFFSET );                      <<04651>>04488000
      END;                                                     <<00863>>04490000
   END                                                         <<00863>>04492000
   ELSE                                                        <<00863>>04494000
      SUDDENDEATH(535); << COULDN'T FIND LOGON CMD IN DIR >>   <<00863>>04496000
                                                               <<04651>>04498000
   END;                                                        <<04651>>04500000
                                                               <<04651>>04502000
END UNTIL (I := I-1) < UDCTYPE'USER;                           <<04651>>04504000
                                                               <<04651>>04506000
END;                                                                    04508000
                                                               <<03767>>04510000
                                                               <<03767>>04514000
RETURN;                                                                 04516000
                                                                        04518000
   << NORMAL EXIT >>                                                    04520000
                                                                        04522000
OUTL:                                                                   04524000
                                                               <<03767>>04526000
<< Close COMMAND.PUB.SYS only if it was opened in INITUDC.   >><<03767>>04528000
<< Do not close the file if INITUDCNO (from CXSETCATALOG) was>><<03767>>04530000
<< the invoking entry point.  FCLOSE will handle unlocking   >><<03767>>04532000
<< the file.                                                 >><<03767>>04534000
IF DOLOGON THEN                                                <<04810>>04536000
BEGIN                                                          <<04810>>04538000
   FCLOSE( COMFN, 0, 0 );                                      <<04810>>04540000
   RESETCRITICAL( OLDCRIT );                                   <<04810>>04542000
END;                                                           <<04810>>04544000
                                                               <<04846>>04546000
   << If FGETLOCKWORD failed, inform CXSETCATALOG.      >>     <<04846>>04548000
      IF FGLWDERR <> 0 THEN                                    <<04846>>04550000
      BEGIN                                                    <<04846>>04552000
         UDCDSTNO := -1;                                       <<04846>>04554000
         FERROR'( UDCFN, FGLWDERR );                           <<04846>>04556000
         << CXSETCATALOG prints CI error. >>                   <<04846>>04558000
      END;                                                     <<04846>>04560000
                                                               <<04846>>04562000
FOR I := FNX STEP -1 UNTIL 0  << CLOSE UDCFILE IF ERROR >>     <<01510>>04564000
   DO  FCLOSE( FNUMS(I), 0, 0 );                               <<01510>>04566000
                                                               <<04846>>04568000
END; << INITUDC >>                                                      04570000
$TITLE "OPTIONO"                                                        04572000
INTEGER PROCEDURE OPTIONO(STRING);                                      04574000
   VALUE STRING;                                                        04576000
   BYTE POINTER STRING;                                                 04578000
   OPTION INTERNAL;                                                     04580000
COMMENT                                                                 04582000
   RETURNS AN INDEX (OPTION NO.) INTO THE ARRAY OF                      04584000
   VALID NAMES FOLLOWING "OPTION"                                       04586000
;                                                                       04588000
BEGIN                                                                   04590000
                                                                        04592000
INTEGER LEN;                                                            04594000
                                                                        04596000
BYTE ARRAY DICT(*) = PB :=                                              04598000
   6,4,"LIST",    << 1 >>                                               04600000
   7,5,"LOGON",   << 2 >>                                               04602000
   8,6,"NOHELP",  << 3 >>                                               04604000
   9,7,"NOBREAK", << 4 >>                                               04606000
   8,6,"NOLIST",  << 5 >>   << DEFAULT OPTIONS >>              <<01529>>04608000
   9,7,"NOLOGON", << 6 >>                                      <<01529>>04610000
   6,4,"HELP",    << 7 >>                                      <<01529>>04612000
   7,5,"BREAK",   << 8 >>                                      <<01529>>04614000
   0;                                                                   04616000
                                                                        04618000
BYTE ARRAY ENDICT(*) = PB := 0; << END ADDRESS OF DICT >>               04620000
                                                                        04622000
BYTE POINTER DICTP;                                                     04624000
                                                                        04626000
TOS := 0;                                                               04628000
@DICTP := @S0 &LSL(1);      << BYTE ADDRESS        >>                   04630000
TOS := X := (@ENDICT -@DICT -1) &LSR(1);                                04632000
                            << WORD LENGTH OF DICT >>                   04634000
ASSEMBLE( ADDS 0);          << ALLOCTE SPACE       >>                   04636000
TOS := @DICTP &LSR(1);      << WORD ADR TARGET     >>                   04638000
TOS := @DICT &LSR(1);       << WORD ADR SOURCE     >>                   04640000
TOS := X;                   << COUNT               >>                   04642000
ASSEMBLE( MOVE PB );        << PUT DICT INTO STACK >>                   04644000
                                                                        04646000
MOVE STRING := STRING WHILE ANS,1;                                      04648000
LEN := TOS -@STRING;                                                    04650000
                                                                        04652000
OPTIONO := SEARCH(STRING,LEN,DICTP);                                    04654000
                                                                        04656000
END; << OPTIONO >>                                                      04658000
$TITLE "PARSECOM"                                                       04660000
PROCEDURE PARSECOM(COMPTR,NUMHEADPARMS,PARMSINFO,ERRNO);                04662000
   VALUE COMPTR,NUMHEADPARMS;                                           04664000
   BYTE POINTER COMPTR;                                                 04666000
   INTEGER NUMHEADPARMS,ERRNO;                                          04668000
   ARRAY PARMSINFO;                                                     04670000
   OPTION UNCALLABLE;                                                   04672000
COMMENT                                                                 04674000
   PARSES IMAGE TYPED AT TERMINAL & MATCHES PARMS WITH                  04676000
   THOSE FOUND IN UDCHEAD.                                              04678000
;                                                                       04680000
BEGIN                                                                   04682000
                                                                        04684000
INTEGER                                                                 04686000
   PARMCOUNT,                                                           04688000
   PLEN,                                                                04690000
   COUNT,                                                               04692000
   DLEN;                                                                04694000
BYTE POINTER                                                            04696000
   SAVEIMAGE,                                                           04698000
   PTR,                                                                 04700000
   FORMALNAMEPTR,                                                       04702000
   BADSPOTPTR := @FORMALNAMEPTR,                                        04704000
   HPTR;                                                                04706000
LOGICAL                                                                 04708000
   KEYWORD;                                                             04710000
                                                                        04712000
SUBROUTINE ERR(ERRN,PTR);                                               04714000
   VALUE ERRN; INTEGER ERRN;                                            04716000
   BYTE ARRAY PTR;                                                      04718000
BEGIN                                                                   04720000
   ERRNO := ERRN;                                                       04722000
   ERROR(ERRNO,IMAGERR,PTR,SAVEIMAGE);                                  04724000
   GO OUTL;                                                             04726000
END; << ERR >>                                                          04728000
                                                                        04730000
@SAVEIMAGE := @COMPTR;                                                  04732000
KEYWORD := FALSE;                                                       04734000
PARMCOUNT := ERRNO := 0;                                                04736000
                                                                        04738000
   << FIND 1ST NON-BLANK AFTER COMMAND >>                               04740000
SCAN COMPTR WHILE " ",1;                                                04742000
ASSEMBLE(DUP);                                                          04744000
MOVE * := * WHILE ANS,1;                                                04746000
SCAN * WHILE " ",1;                                                     04748000
@PTR := TOS;                                                            04750000
                                                                        04752000
IF PTR = "," OR PTR = ";" THEN PARMCOUNT := 1;                          04754000
   << AT DELIMITER ?                        >>                          04756000
   << POSITIONAL PARMS, 1ST PARM IS OMITTED >>                          04758000
WHILE PTR <> 0 DO                                                       04760000
BEGIN                                                                   04762000
   PARMCOUNT := PARMCOUNT +1;                                           04764000
   IF PARMCOUNT > UDCMAXPARMS THEN ERR(TOOMANYPARMS,PTR(1));   <<01125>>04766000
   IF PARMCOUNT > NUMHEADPARMS THEN ERR(EXCESSPARMS,PTR(1));   <<01125>>04768000
   PLEN := NEXTPARM(PTR,COMPTR,PTR);                                    04770000
   IF < THEN ERR(NOCLOSEQUOTE,COMPTR);                                  04772000
   IF = THEN                                                            04774000
   BEGIN                                                                04776000
      IF KEYWORD THEN ERR(EXPECTPARM,COMPTR);                           04778000
   END                                                                  04780000
   ELSE                                                                 04782000
   BEGIN                                                                04784000
         << LOOK FOR "=" TO IND. KEYWORD >>                             04786000
      IF PARMCOUNT = 1 AND PTR = "=" THEN KEYWORD := TRUE;              04788000
            << DO NOT ALLOW POSITIONAL AND KEYWORDED >>        <<01049>>04790000
            << AT THE SAME TIME.                     >>        <<01049>>04792000
        IF (KEYWORD LAND PTR <> "=") OR                        <<01049>>04794000
           (NOT KEYWORD LAND PTR = "=") THEN                   <<01049>>04796000
           ERR(NOTYPEMIX,COMPTR);                              <<01049>>04798000
      IF NOT KEYWORD THEN                                               04800000
      BEGIN << PLACE INTO 'DEFAULT' >>                                  04802000
         PARMSINFO((PARMCOUNT -1)*3 +2) := @COMPTR;                     04804000
         PARMSINFO((PARMCOUNT -1)*3).(8:8) := PLEN;                     04806000
      END                                                               04808000
      ELSE                                                              04810000
      BEGIN << KEYWORD >>                                               04812000
                                                                        04814000
            << CHECK OUT FORMAL NAME >>                                 04816000
         IF COMPTR <> ALPHA THEN ERR(FMLNAMENOTALPHA,COMPTR);           04818000
                                                                        04820000
            << UPSHIFT >>                                               04822000
         MOVE COMPTR := COMPTR WHILE ANS,1;                             04824000
         @BADSPOTPTR := TOS;                                            04826000
         IF @COMPTR +PLEN <> @BADSPOTPTR THEN ERR(                      04828000
            INVFORMALNAME,BADSPOTPTR);                                  04830000
                                                                        04832000
         @FORMALNAMEPTR := @COMPTR; <<FORMAL NAME>>                     04834000
            << NOW FIND 2ND PART OF PARM PAIR>>                         04836000
         DLEN := NEXTPARM(PTR,COMPTR,PTR);                              04838000
         IF < THEN ERR(NOCLOSEQUOTE,PTR);                               04840000
         IF = THEN ERR(EXPECTPARM,PTR);                                 04842000
            << NOW LOOK FOR MATCH >>                                    04844000
         COUNT := -1;                                                   04846000
         WHILE (COUNT := COUNT +1) < NUMHEADPARMS DO                    04848000
         BEGIN                                                          04850000
            @HPTR := PARMSINFO(COUNT*3 +1);                             04852000
            IF PLEN = INTEGER(PARMSINFO(COUNT*3).(0:8)) THEN            04854000
               IF FORMALNAMEPTR = HPTR,(PLEN) THEN                      04856000
            BEGIN << MATCH >>                                           04858000
               IF DLEN > 0 THEN                                         04860000
               BEGIN                                                    04862000
                  PARMSINFO(COUNT*3).(8:8) := DLEN;                     04864000
                  PARMSINFO(COUNT*3 +2) := @COMPTR;                     04866000
                  GO MATCH;                                             04868000
               END;                                                     04870000
            END;                                                        04872000
         END;                                                           04874000
            << NO MATCH >>                                              04876000
         ERR(UNKNOWNPARM,COMPTR);                                       04878000
MATCH:                                                                  04880000
      END; << KEYWORD USED >>                                           04882000
   END;                                                                 04884000
END; << LOOP >>                                                         04886000
OUTL:                                                                   04888000
                                                                        04890000
END; << PARSECOM >>                                                     04892000
$TITLE "PARSEUDCHEAD"                                                   04894000
PROCEDURE PARSEUDCHEAD(UDCPTR,NUMPARMS,PARMS,OPTIONS,ERRNO);            04896000
   VALUE UDCPTR,OPTIONS;                                                04898000
   BYTE POINTER UDCPTR;                                                 04900000
   INTEGER NUMPARMS,ERRNO;                                              04902000
   ARRAY PARMS;                                                         04904000
   LOGICAL OPTIONS;                                                     04906000
   OPTION UNCALLABLE;                                                   04908000
COMMENT  PARMS IS 3 WORD ENTRY:                                         04910000
   ******************************                                       04912000
   * PARM LEN   * DEFAULT LEN   *                                       04914000
   ******************************                                       04916000
   *     <FORMALNAME PTR>       *                                       04918000
   ******************************                                       04920000
   *      <DEFAULT PTR>         *                                       04922000
   ******************************                                       04924000
;                                                                       04926000
BEGIN                                                                   04928000
                                                                        04930000
INTEGER                                                                 04932000
   PLEN;                                                                04934000
BYTE POINTER                                                            04936000
   PTR,                                                                 04938000
   UDCBASE,                                                             04940000
   BADSPOTPTR;                                                          04942000
                                                                        04944000
SUBROUTINE ERR(ERRN,PTR);                                               04946000
   VALUE ERRN;                                                          04948000
   INTEGER ERRN; BYTE ARRAY PTR;                                        04950000
BEGIN                                                                   04952000
   ERROR(ERRN,IF OPTIONS.CIS'OPTNOHELP THEN SYNERRNOL          <<04603>>04954000
                                       ELSE SYNERR,            <<04603>>04956000
      PTR,UDCBASE);                                                     04958000
   ERRNO := ERRN;                                                       04960000
   GO OUTL;                                                             04962000
END;                                                                    04964000
                                                                        04966000
NUMPARMS := 0;                                                          04968000
@UDCBASE := @UDCPTR;                                                    04970000
FINDPARM(UDCPTR,UDCPTR,PTR); <<PTR AT 1ST DELIM>>                       04972000
WHILE PTR <> 0 DO                                                       04974000
BEGIN                                                                   04976000
   NUMPARMS := NUMPARMS +1;                                             04978000
   IF NUMPARMS > UDCMAXPARMS THEN ERR(TOOMANYPARMS,UDCPTR);             04980000
   PLEN := NEXTPARM(PTR,UDCPTR,PTR);                                    04982000
   IF < THEN ERR(NOCLOSEQUOTE,UDCPTR);                                  04984000
   IF = THEN ERR(EXPECTPARM,UDCPTR);                                    04986000
                                                                        04988000
      << CHECK OUT FORMAL NAME >>                                       04990000
   IF UDCPTR = "!" THEN                                                 04992000
   BEGIN << "!" PRECEDES FORMAL NAME >>                                 04994000
      @UDCPTR := @UDCPTR +1;                                            04996000
      PLEN := PLEN -1;                                                  04998000
   END;                                                                 05000000
                                                                        05002000
   IF UDCPTR <> ALPHA THEN ERR(FMLNAMENOTALPHA,UDCPTR);                 05004000
      << UPSHIFT >>                                                     05006000
   MOVE UDCPTR := UDCPTR WHILE ANS,1;                                   05008000
   @BADSPOTPTR := TOS;                                                  05010000
   IF @UDCPTR +PLEN <> @BADSPOTPTR THEN ERR(INVFORMALNAME,              05012000
      BADSPOTPTR);                                                      05014000
                                                                        05016000
      << STUFF PLEN & PTR INTO PARMS >>                                 05018000
   PARMS((NUMPARMS -1)*3) := 0;                                         05020000
   PARMS(X).(0:8) := PLEN;                                              05022000
   PARMS(X:=X+1) := @UDCPTR;                                            05024000
   IF PTR = "=" THEN                                                    05026000
   BEGIN << DEFAULT PROVIDED >>                                         05028000
      PLEN := NEXTPARM(PTR,UDCPTR,PTR);                                 05030000
      IF < THEN ERR(NOCLOSEQUOTE,UDCPTR);                               05032000
      IF = THEN ERR(EXPECTPARM,UDCPTR);                                 05034000
         << STUFF DEFAULT LEN & PTR INTO PARMS >>                       05036000
      PARMS((NUMPARMS -1)*3).(8:8) := PLEN;                             05038000
      PARMS(X:=X+2) := @UDCPTR;                                         05040000
   END;                                                                 05042000
END; << PARM LOOP >>                                                    05044000
                                                                        05046000
OUTL:                                                                   05048000
END; << PARSEUDCHEAD >>                                                 05050000
$TITLE "READFILE"                                                       05052000
PROCEDURE READFILE(FN,RECNO,BUFF',ERRNO);                               05054000
   VALUE FN;                                                            05056000
   INTEGER FN,RECNO,ERRNO;                                              05058000
   ARRAY BUFF';                                                         05060000
   OPTION UNCALLABLE;                                                   05062000
COMMENT                                                                 05064000
   USED TO READ UDC HEAD OR BODY RECORDS UNTIL NO CONTINUATION          05066000
   RECORD IS FOUND.                                                     05068000
   RETURNS NEXT RECORD # IN RECNO.                                      05070000
;                                                                       05072000
BEGIN                                                                   05074000
                                                                        05076000
POINTER PTR';                                                           05078000
BYTE POINTER PTR;                                                       05080000
INTEGER LEN;                                                            05082000
LOGICAL AMPERSAND;                                                      05084000
                                                                        05086000
AMPERSAND := FALSE;                                                     05088000
ERRNO := -1;                                                            05090000
@PTR' := @BUFF';                                                        05092000
@PTR := @BUFF' & LSL(1);                                                05094000
PTR := 0;                                                               05096000
DO BEGIN                                                                05098000
   FREADDIR(FN,PTR',UDCRECSIZE,DOUBLE(RECNO));                          05100000
   IF < THEN ERRNO := UDCREADFAIL                                       05102000
   ELSE                                                                 05104000
   IF > THEN ERRNO := IF AMPERSAND THEN AMPERSANDERR                    05106000
      ELSE EOFOUND                                                      05108000
   ELSE                                                                 05110000
   BEGIN                                                                05112000
      RECNO := RECNO +1;                                                05114000
      LEN := DEBLANK(PTR,UDCRECSIZEB -8);                               05116000
      PTR(LEN) := 0;                                                    05118000
      IF LEN > 0 AND PTR(LEN -1) = "&" THEN                             05120000
      BEGIN                                                             05122000
         AMPERSAND := TRUE;                                             05124000
         PTR(LEN -1) := " ";                                            05126000
         IF LOGICAL(LEN) THEN                                           05128000
         BEGIN                                                          05130000
            PTR(LEN) := " ";                                            05132000
            LEN := LEN +1;                                              05134000
         END;                                                           05136000
         @PTR := @PTR(LEN);                                             05138000
         @PTR' := @PTR&LSR(1);                                          05140000
         IF (@PTR' -@BUFF') +UDCRECSIZE >= UDCBUFFSIZE THEN             05142000
            ERRNO := TOOMANYREC                                         05144000
         ELSE                                                           05146000
      END                                                               05148000
      ELSE ERRNO := 0;                                                  05150000
   END;                                                                 05152000
END UNTIL ERRNO <> -1;                                                  05154000
                                                                        05156000
END; << READFILE >>                                                     05158000
$TITLE "RECIPUDC"                                                       05160000
INTEGER PROCEDURE RECIPUDC(NTRY,LEVEL,INX,SIRS);                        05162000
   VALUE LEVEL,INX,SIRS;                                                05164000
   INTEGER LEVEL,INX;                                                   05166000
   DOUBLE SIRS;                                                         05168000
   ARRAY NTRY;                                                          05170000
   OPTION UNCALLABLE;                                                   05172000
COMMENT                                                                 05174000
   Called by DIRECSCAN of UDCDIRCREAD/UDCDIRCWRITE to          <<00884>>05176000
   read/write command file record numbers from/to the system   <<00884>>05178000
   directory. NTRY is the user or account entry being visited. <<00884>>05180000
   OWNARRAY(INX) is the PARMARRAY of UDCDIRCREAD/UDCDIRCWRITE. <<00884>>05182000
                                                               <<00884>>05184000
      OWNARRAY(INX+0) = Read/Write indicator                   <<00884>>05186000
      OWNARRAY(INX+1) = UDC type (user,account,system)         <<00884>>05188000
      OWNARRAY(INX+2) = Command file record number             <<00884>>05190000
      OWNARRAY(INX+3) = UDC's exist flag                       <<00884>>05192000
;                                                                       05194000
BEGIN                                                                   05196000
                                                                        05198000
INTEGER DELTAQ = Q-0;                                                   05200000
ARRAY DDS(*) = DB +0;                                                   05202000
ARRAY OWNARRAY(*) = Q+0;                                                05204000
                                                                        05206000
EQUATE                                                                  05208000
   DADIRTY = %221;                                             <<00884>>05210000
DEFINE DIRTYF = (15:1) #;                                               05212000
                                                                        05214000
INX := INX -DELTAQ;                                                     05216000
CASE OWNARRAY(INX+1) OF                                        <<00416>>05218000
BEGIN                                                          <<00416>>05220000
<< User Level >>                                               <<00884>>05222000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>05224000
      BEGIN                                                    <<00884>>05226000
      NTRY(USERUDCPTR) := OWNARRAY(INX+2);                     <<00884>>05228000
      NTRY(USERUDCBIT) := OWNARRAY(INX+3);                     <<00884>>05230000
      END                                                      <<00884>>05232000
   ELSE                                                        <<00884>>05234000
      BEGIN                                                    <<00884>>05236000
      OWNARRAY(INX+2) := NTRY(USERUDCPTR);                     <<00884>>05238000
      OWNARRAY(INX+3) := NTRY(USERUDCBIT);                     <<00884>>05240000
      END;                                                     <<00884>>05242000
                                                               <<00884>>05244000
<< Account Level >>                                            <<00884>>05246000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>05248000
      BEGIN                                                    <<00884>>05250000
      NTRY(ACCTUDCPTR) := OWNARRAY(INX+2);                     <<00884>>05252000
      NTRY(ACCTUDCBIT) := OWNARRAY(INX+3);                     <<00884>>05254000
      END                                                      <<00884>>05256000
   ELSE                                                        <<00884>>05258000
      BEGIN                                                    <<00884>>05260000
      OWNARRAY(INX+2) := NTRY(ACCTUDCPTR);                     <<00884>>05262000
      OWNARRAY(INX+3) := NTRY(ACCTUDCBIT);                     <<00884>>05264000
      END;                                                     <<00884>>05266000
                                                               <<00884>>05268000
<< System Level >>                                             <<00884>>05270000
   IF OWNARRAY(INX) = DIRCWRITE THEN                           <<00884>>05272000
      BEGIN                                                    <<00884>>05274000
      NTRY(SYSUDCPTR) := OWNARRAY(INX+2);                      <<00884>>05276000
      NTRY(SYSUDCBIT) := OWNARRAY(INX+3);                      <<00884>>05278000
      END                                                      <<00884>>05280000
   ELSE                                                        <<00884>>05282000
      BEGIN                                                    <<00884>>05284000
      OWNARRAY(INX+2) := NTRY(SYSUDCPTR);                      <<00884>>05286000
      OWNARRAY(INX+3) := NTRY(SYSUDCBIT);                      <<00884>>05288000
      END;                                                     <<00884>>05290000
END;                                                           <<00884>>05292000
IF OWNARRAY(INX) = DIRCWRITE THEN                              <<00884>>05294000
   DDS(DADIRTY).DIRTYF  := 1;                                  <<00884>>05296000
RECIPUDC := 5; <<SIRS NOT RELEASED. STOP SCAN >>                        05298000
                                                                        05300000
END; << RECIPUDC >>                                                     05302000
$TITLE "RELCOMREC"                                                      05304000
PROCEDURE RELCOMREC(COMFN,RECNO,ERRNO);                                 05306000
   VALUE COMFN,RECNO;                                                   05308000
   INTEGER COMFN,RECNO,ERRNO;                                           05310000
   OPTION UNCALLABLE;                                                   05312000
COMMENT - RETURNS RECORD FROM COMMAND.PUB.SYS TO FREE LIST              05314000
;                                                                       05316000
<< Assumptions:  This procedure assumes that COMMAND.PUB.SYS >><<03734>>05318000
<<    (file number = COMFN) has been locked by the calling   >><<03734>>05320000
<<    procedure.                                             >><<03734>>05322000
                                                               <<03734>>05324000
BEGIN                                                                   05326000
                                                                        05328000
ARRAY REC0(0:COMRECSIZEM1);                                             05330000
ARRAY REC(0:COMRECSIZEM1);                                              05332000
                                                                        05334000
SUBROUTINE READ(BUF,REC);                                               05336000
   VALUE REC;                                                           05338000
   ARRAY BUF;                                                           05340000
   INTEGER REC;                                                         05342000
BEGIN                                                                   05344000
   FREADDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                          05346000
   IF <> THEN                                                           05348000
   BEGIN                                                                05350000
      ERRNO := COMREADFAIL;                                             05352000
      GO OUTL;                                                          05354000
   END;                                                                 05356000
END; << READ >>                                                         05358000
                                                                        05360000
SUBROUTINE WRITE(BUF,REC);                                              05362000
   VALUE REC;                                                           05364000
   ARRAY BUF;                                                           05366000
   INTEGER REC;                                                         05368000
BEGIN                                                                   05370000
   FWRITEDIR(COMFN,BUF,COMRECSIZE,DOUBLE(REC));                         05372000
   IF <> THEN                                                           05374000
   BEGIN                                                                05376000
      ERRNO := COMWRITEFAIL;                                            05378000
      GO OUTL;                                                          05380000
   END;                                                                 05382000
END; << WRITE >>                                                        05384000
                                                                        05386000
   ERRNO := 0;                                                 <<03734>>05388000
   READ(REC0,0);                                                        05392000
      << READ RETURNED RECORD & MARK AS NEW FREE HEAD>>                 05394000
   READ(REC,RECNO);                                                     05396000
   REC(COMLINK) := REC0(COMFREEHEAD);                                   05398000
   REC(COMENTRYTYPE) := COMFREEENTRY;                                   05400000
   WRITE(REC,RECNO);                                                    05402000
      << UPDATE HEAD RECORD >>                                          05404000
   REC0(COMFREEHEAD) := RECNO;                                          05406000
   REC0(COMUSE) := REC0(COMUSE) -1;                                     05408000
   WRITE(REC0,0);                                                       05410000
                                                                        05414000
OUTL:                                                                   05416000
END; << RELCOMREC >>                                                    05418000
$TITLE "SEARCHUDC"                                                      05420000
LOGICAL PROCEDURE SEARCHUDC(STRING,OFFSET,UDCFN,                        05422000
      RECNO,BODYRECNO,OPTIONS);                                         05424000
   INTEGER UDCFN,OFFSET,RECNO,BODYRECNO;                                05426000
   BYTE ARRAY STRING;                                                   05428000
   LOGICAL OPTIONS;                                                     05430000
   OPTION UNCALLABLE;                                                   05432000
BEGIN                                                                   05434000
                                                                        05436000
INTEGER                                                                 05438000
   ENTRYLEN,                                                            05440000
   LEN,                                                                 05442000
   CMDLEN;                                                              05444000
                                                                        05446000
                                                                        05448000
BYTE POINTER PTR;                                                       05450000
                                                                        05452000
ARRAY DIR'(0:DIRMAXENTRYSIZE); BYTE ARRAY DIR(*) = DIR';                05454000
                                                                        05456000
SUBROUTINE DEF'MOVEFROMDSEG;                                            05458000
                                                                        05460000
SCAN STRING WHILE " ",1;                                                05462000
@PTR := TOS;                                                            05464000
MOVE PTR := PTR WHILE ANS,1;                                            05466000
CMDLEN := TOS -@PTR;                                                    05468000
ENTRYLEN := DIRMAXENTRYSIZE; << LARGEST >>                              05470000
DO BEGIN                                                                05472000
   <<GET DIRECTORY ONE ENTRY AT A TIME>>                                05474000
   <<GET ENTRY + LENGTH OF NEXT ENTRY (2 MORE WORDS>>                   05476000
   MOVEFROMDSEG(@DIR',UDCDSTNO,OFFSET,ENTRYLEN+DIRHEAD);       <<04603>>05478000
   LEN := DIR(DIRENTRYSIZE); << THIS ENTRY >>                           05480000
   ENTRYLEN := DIR(LEN*2 +DIRENTRYSIZE);                                05482000
   OFFSET := OFFSET +LEN;                                               05484000
   IF LEN <> 0 THEN                                                     05486000
   BEGIN                                                                05488000
      IF CMDLEN = INTEGER(DIR(DIRCMDLEN)) AND PTR = DIR                 05490000
         (DIRCMD),(CMDLEN) THEN                                         05492000
      BEGIN                                                             05494000
         SEARCHUDC := TRUE;                                             05496000
         OPTIONS := DIR';<<LIST,LOGON,NOHELP,NOBREAK>>                  05498000
         RECNO := DIR'(DIRRECNO);                                       05500000
         BODYRECNO := DIR'(DIRBODYRECNO);                               05502000
         UDCFN := DIR(DIRFILENO);                                       05504000
         LEN := 0;                                                      05506000
      END;                                                              05508000
   END;                                                                 05510000
END UNTIL LEN = 0;                                                      05512000
                                                                        05514000
END; << SEARCHUDC >>                                                    05516000
$TITLE "UDC"                                                            05518000
LOGICAL PROCEDURE UDC(COMIMAGE,OFFSET);                                 05520000
   VALUE OFFSET;                                                        05522000
   INTEGER OFFSET;                                                      05524000
   BYTE ARRAY COMIMAGE;                                                 05526000
   OPTION UNCALLABLE;                                                   05528000
COMMENT                                                                 05530000
   THIS PROCEDURE DOES IT ALL FOR USER DEFINED COMMANDS.                05532000
   COMIMAGE IS COMMAND IMAGE                                            05534000
   ENDING IN %15, OFFSET IS INDEX IN DIRECTORY TO ALLOW                 05536000
   NESTING BUT STOP RECURSION.                                          05538000
   RETURNS TRUE IF COMIMAGE WAS A UDC.                                  05540000
;                                                                       05542000
BEGIN                                                                   05544000
                                                                        05546000
INTEGER                                                                 05548000
   SAVE'CIS'IFNESTING,                                         <<04603>>05550000
   COMLEN,                                                              05552000
   ERRNO,                                                               05554000
   FCONTROLDUMMY = ERRNO,                                               05556000
   NUMPARMS,                                                            05558000
   UDCFN,                                                               05560000
   RECNO,                                                               05562000
   BODYRECNO;                                                           05564000
                                                                        05566000
LOGICAL                                                                 05568000
   SAVE'CIS'IFSKIP,                                            <<04603>>05570000
   SAVE'CIS'ELSESEEN,                                          <<04603>>05572000
   OPTIONS,                                                    <<00538>>05574000
   OLDUDC2,                                                    <<01510>>05576000
   OLDSTATE;                                                   <<00538>>05578000
                                                                        05580000
BYTE POINTER PTR;                                                       05582000
                                                                        05584000
ARRAY HEADBUFF'(0:UDCBUFFSIZE);                                         05586000
BYTE ARRAY HEADBUFF(*) = HEADBUFF';                                     05588000
ARRAY PARMSINFO(0:PINFOSIZE);                                           05590000
BYTE ARRAY UDCIMAGE(0:CIS'MAXCOMLEN);                          <<04603>>05592000
                                                                        05594000
UDC := TRUE;                                                            05596000
SCAN COMIMAGE UNTIL CR,1;                                               05598000
COMLEN := TOS -@COMIMAGE;                                               05600000
MOVE UDCIMAGE := COMIMAGE,(COMLEN);                                     05602000
UDCIMAGE(COMLEN) := 0;                                                  05604000
                                                                        05606000
   << UPSHIFT COMMAND NAME >>                                           05608000
SCAN UDCIMAGE WHILE " ",1;                                              05610000
ASSEMBLE(DUP);                                                          05612000
MOVE * := * WHILE ANS;                                                  05614000
                                                                        05616000
   IF SEARCHUDC(UDCIMAGE,OFFSET,UDCFN,RECNO,BODYRECNO,OPTIONS)          05618000
      THEN                                                     <<U.RAO>>05620000
   BEGIN                                                                05622000
                                                               <<00835>>05624000
      << IF IN THE FALSE PORTION OF AN IF STATEMENT THEN >>    <<00835>>05626000
      << DON'T EXPAND THE UDC.                           >>    <<00835>>05628000
      IF CIS'IFSKIP THEN RETURN;                               <<04603>>05630000
                                                               <<00835>>05632000
      IF CIS'UDCNESTLEVEL=0 <<1 LEVEL UDC, SAVE COPY FOR REDO>><<04603>>05634000
         THEN MOVE CIS'BLASTCOMIMAGE := COMIMAGE,(COMLEN +1);  <<04603>>05636000
      CIS'UDCNESTLEVEL := CIS'UDCNESTLEVEL +1;<<NOW IN UDC>>   <<04603>>05638000
      CIS'CONTINUSTATESTK := CIS'CONTINUSTATESTK & DLSL(2);    <<04603>>05640000
         <<ADJUST CONTINUE FLAGS FOR NEW UDC NEST LEVEL>>      <<01.RO>>05642000
      READFILE(UDCFN,RECNO,HEADBUFF',ERRNO);                            05644000
      IF ERRNO <> 0 THEN ERROR(ERRNO,UDCFERR,UDCFN)                     05646000
      ELSE                                                              05648000
      BEGIN                                                             05650000
         PARSEUDCHEAD(HEADBUFF,NUMPARMS,PARMSINFO,OPTIONS,ERRNO);       05652000
         IF ERRNO = 0 THEN                                              05654000
         BEGIN                                                          05656000
            PARSECOM(UDCIMAGE,NUMPARMS,PARMSINFO,ERRNO);                05658000
            IF ERRNO = 0 THEN                                           05660000
            BEGIN                                                       05662000
                  << CHECK FOR REQUIRED PARMS >>                        05664000
               X := -3;                                                 05666000
               WHILE (X := X+3) < NUMPARMS*3 DO IF PARMSINFO            05668000
                  (X).(8:8) = 0 THEN                                    05670000
                  BEGIN                                                 05672000
                     @PTR := PARMSINFO(X:=X+1);                         05674000
                     ERRNO := MISSINGPARM;                              05676000
                     ERROR(ERRNO,IF OPTIONS.CIS'OPTNOHELP THEN <<04603>>05678000
                        SYNERRNOL ELSE SYNERR,PTR,                      05680000
                        HEADBUFF);                                      05682000
                     X := NUMPARMS*3; << STOP LOOPING >>                05684000
                  END;                                                  05686000
               IF ERRNO = 0 THEN                                        05688000
               BEGIN                                                    05690000
                  << SAVE PREVIOUS UDC OPTIONS >>              <<00619>>05692000
                  OLDUDC2 := CIS'UDC2;                         <<04603>>05694000
                  OLDSTATE := CIS'UDC3;                        <<04603>>05696000
                  COMMENT:                                     <<00538>>05698000
                     SET NEW BREAK STATE.  BREAK ACTS          <<00538>>05700000
                     LIKE A BLANKET.;                          <<00538>>05702000
                  CIS'UDC3 := OPTIONS;                         <<04603>>05704000
                  CIS'UDCNOBREAKOPT :=                         <<04603>>05706000
                                    IF OLDSTATE.CIS'OPTNOBREAK <<04603>>05708000
                                                 OR            <<04603>>05710000
                                       OPTIONS.CIS'OPTNOBREAK  <<04603>>05712000
                                      THEN TRUE ELSE FALSE;    <<04603>>05714000
                  IF OPTIONS.CIS'OPTNOBREAK THEN FCONTROL(1,   <<04603>>05716000
                     DISABLEBREAK,FCONTROLDUMMY);                       05718000
                                                               <<00835>>05720000
                  << SAVE CURRENT IF NESTING INFO >>           <<00835>>05722000
                  SAVE'CIS'IFNESTING := CIS'IFNESTING;         <<04603>>05724000
                  SAVE'CIS'IFSKIP := CIS'IFSKIP;               <<04603>>05726000
                  SAVE'CIS'ELSESEEN := CIS'ELSESEEN;           <<04603>>05728000
                                                               <<00835>>05730000
                  FEEDCI(UDCFN,BODYRECNO,COMIMAGE,NUMPARMS,             05732000
                     PARMSINFO,OFFSET,OPTIONS,ERRNO);                   05734000
                                                               <<00835>>05736000
                  << CHECK IF EXITING UDC AT SAME IF LEVEL >>  <<00835>>05738000
                  << UNLESS UDC EXITTING ABNORMALLY.       >>  <<01288>>05740000
                  IF (ERRNO = 0) AND                           <<01288>>05742000
                     (CIS'IFNESTING <> SAVE'CIS'IFNESTING) THEN<<04603>>05744000
                    ERROR(-UDCIFS'NEQ'ENDIFS,UDCERR);          <<01288>>05746000
                                                               <<00835>>05748000
                  << RESTORE IF NESTING GLOBALS >>             <<00835>>05750000
                  CIS'IFNESTING := SAVE'CIS'IFNESTING;         <<04603>>05752000
                  CIS'IFSKIP := SAVE'CIS'IFSKIP;               <<04603>>05754000
                  CIS'ELSESEEN := SAVE'CIS'ELSESEEN;           <<04603>>05756000
                                                               <<00835>>05758000
                                                               <<00835>>05760000
                  IF CIS'UDCEXITBREAK THEN                     <<04603>>05762000
                  BEGIN << UNWIND. PUT COMIMAGE BACK >>                 05764000
                     MOVE COMIMAGE := UDCIMAGE,(COMLEN);                05766000
                     COMIMAGE(COMLEN) := CR;                            05768000
                     IF CIS'PENDINGCOMLEN <> 0                 <<04603>>05770000
                       THEN CIS'PENDINGCOMLEN                  <<04603>>05772000
                        := COMLEN;<<ADJUST COMLEN FOR CI >>    <<13.EB>>05774000
                  END;                                                  05776000
                  IF OPTIONS.CIS'OPTNOBREAK                    <<04603>>05778000
                             AND NOT OLDSTATE.CIS'OPTNOBREAK   <<04603>>05780000
                     THEN FCONTROL(1,ENABLEBREAK,              <<00538>>05782000
                                   FCONTROLDUMMY);             <<00538>>05784000
                  << RESTORE PREVIOUS UDC OPTIONS >>           <<00619>>05786000
                  CIS'UDC3 := OLDSTATE;                        <<04603>>05788000
                  CIS'UDC2 := CIS'UDC2 LOR OLDUDC2;            <<04603>>05790000
               END;                                                     05792000
            END;                                                        05794000
         END;                                                           05796000
      END;                                                              05798000
      CIS'CONTINUSTATESTK := CIS'CONTINUSTATESTK & DLSR(2);    <<04603>>05800000
         <<ADJUST CONTINUE FLAGS TO PREVIOUS UDC NEST LEVEL>>  <<01.RO>>05802000
      IF CIS'UDCFATALCIERR AND CIS'CONTSTATE >= 1 THEN         <<04603>>05804000
         CIS'UDCFATALCIERR := FALSE; <<CLEAR UDC CI ABORT FLAG <<04603>>05806000
      IF CIS'UDCNESTLEVEL <> 0 THEN CIS'UDCNESTLEVEL :=        <<04603>>05808000
         CIS'UDCNESTLEVEL -1; << DECREMENT LEVEL >>            <<04603>>05810000
   END                                                                  05812000
   ELSE                                                                 05814000
   IF UDCIMAGE = "HELP " AND UDCHELP(UDCIMAGE(5)) THEN         <<01307>>05816000
      BEGIN                                                    <<01307>>05818000
      IF CIS'UDCNESTLEVEL = 0 THEN                             <<04603>>05820000
         MOVE CIS'BLASTCOMIMAGE := COMIMAGE,(COMLEN + 1);      <<04603>>05822000
      END                                                      <<01307>>05824000
   ELSE                                                        <<01307>>05826000
      UDC := FALSE;                                            <<01307>>05828000
                                                                        05830000
END; << UDC >>                                                          05832000
$TITLE "UDCHELP"                                                        05834000
LOGICAL PROCEDURE UDCHELP(COMIMAGE);                                    05836000
   VALUE COMIMAGE;                                                      05838000
   BYTE POINTER COMIMAGE;                                               05840000
   OPTION UNCALLABLE;                                                   05842000
BEGIN                                                                   05844000
                                                                        05846000
INTEGER                                                                 05848000
   LEN,                                                        <<01532>>05850000
   ERRNO,                                                               05852000
   ERRNO1,                                                              05854000
   UDCFN,                                                               05856000
   OFFSET,                                                              05858000
   RECNO,                                                               05860000
   DUMMY;                                                               05862000
LOGICAL OPTIONS;                                                        05864000
                                                                        05866000
BYTE POINTER PTR;                                                       05868000
                                                                        05870000
ARRAY UDCBUFF'(0:UDCBUFFSIZE);                                          05872000
BYTE ARRAY UDCBUFF(*) = UDCBUFF';                                       05874000
                                                                        05876000
OFFSET := 0;                                                            05878000
IF SEARCHUDC(COMIMAGE,OFFSET,UDCFN,RECNO,DUMMY,OPTIONS)                 05880000
   THEN                                                                 05882000
BEGIN                                                                   05884000
   IF NOT OPTIONS.CIS'OPTNOHELP THEN                           <<04603>>05886000
   BEGIN                                                                05888000
      UDCHELP := TRUE;                                         <<00835>>05890000
                                                               <<00835>>05892000
      << IF IN THE FALSE PART OF AN IF STATEMENT THEN >>       <<00835>>05894000
      << DON'T EXECUTE THE COMMAND.                   >>       <<00835>>05896000
      IF CIS'IFSKIP THEN RETURN;                               <<04603>>05898000
                                                               <<00835>>05900000
      SCAN COMIMAGE WHILE " ",1;<<DEBLANK>>                             05902000
      ASSEMBLE(DUP);                                                    05904000
      MOVE * := * WHILE ANS,1;<<SKIP COMMAND NAME>>                     05906000
      SCAN * WHILE " ",1;                                               05908000
      @PTR := TOS;                                                      05910000
      IF NOCARRY THEN << EXTRA PARMS >>                                 05912000
         ERROR( -IGNORED, IMAGERR, PTR, COMIMAGE(-4) );        <<01360>>05914000
      GENMSG(CISET,UDCHELPHEAD); << HEADER >>                           05916000
      PRINT(ERRNO,0,0); <<CRLF>>                                        05918000
                                                                        05920000
      ERRNO := -1;                                                      05922000
      DO BEGIN                                                          05924000
         READFILE(UDCFN,RECNO,UDCBUFF',ERRNO1);                         05926000
         IF ERRNO1 = EOFOUND THEN ERRNO := 0                            05928000
         ELSE                                                           05930000
         BEGIN                                                          05932000
            IF ERRNO1 <> 0 THEN ERRNO := ERRNO1                         05934000
            ELSE                                                        05936000
            BEGIN                                                       05938000
               IF UDCBUFF = "*" THEN ERRNO := 0                         05940000
               ELSE                                            <<01532>>05942000
               BEGIN                                           <<01532>>05944000
                  SCAN UDCBUFF UNTIL 0, 1;                     <<01532>>05946000
                  LEN := TOS - @UDCBUFF;                       <<01532>>05948000
                  PRINT( UDCBUFF', -LEN, 0 );                  <<01532>>05950000
               END;                                            <<01532>>05952000
            END;                                                        05954000
         END;                                                           05956000
      END UNTIL ERRNO <> -1;                                            05958000
   END;                                                                 05960000
END;                                                                    05962000
                                                                        05964000
END; << UDCHELP >>                                                      05966000
$TITLE "UPSHIFT"                                                        05968000
PROCEDURE UPSHIFT(PTR);                                                 05970000
   VALUE PTR; BYTE POINTER PTR;                                         05972000
   OPTION UNCALLABLE;                                                   05974000
COMMENT UPSHIFTS UNTIL 0 IF FOUND.                                      05976000
;                                                                       05978000
BEGIN                                                                   05980000
   TOS := @PTR;                                                         05982000
   DO BEGIN                                                             05984000
      ASSEMBLE(DUP);                                                    05986000
      MOVE * := * WHILE ANS,1;                                          05988000
      TOS := TOS +1;                                                    05990000
   END UNTIL BPS0(-1) = 0;                                              05992000
END; << UPSHIFT >>                                                      05994000
$TITLE "SEARCHCOMFILE"                                         <<00884>>05996000
PROCEDURE                                                      <<00884>>05998000
     SEARCHCOMFILE(COMFN,UNAME,ANAME,USERREC,FILEREC,ERRNO);   <<00884>>06000000
   VALUE COMFN;                                                <<00884>>06002000
   INTEGER COMFN,USERREC,FILEREC,ERRNO;                        <<00884>>06004000
   BYTE ARRAY UNAME,ANAME;                                     <<00884>>06006000
   OPTION UNCALLABLE,VARIABLE;                                 <<00884>>06008000
BEGIN                                                          <<00884>>06010000
COMMENT                                                        <<00884>>06012000
   Performs a linear search of the UDC Command file for a given<<00884>>06014000
   user & account, or any user in an account if only the accoun<<00884>>06016000
   is specified.  Searching begins at the record number passed <<00884>>06018000
   in 'USERREC'.  If a match is found before the end of the    <<00884>>06020000
   file, the record number of the user entry is returned in    <<00884>>06022000
   'USERREC' and the record number of the first file entry is  <<00884>>06024000
   returned in 'FILEREC'.                                      <<00884>>06026000
   ;                                                           <<00884>>06028000
DEFINE                                                         <<00884>>06030000
   UNAMEPARM = VARMASK.(11:1) #,                               <<00884>>06032000
   USERRECPARM = VARMASK.(13:1) #,                             <<00884>>06034000
   FILERECPARM = VARMASK.(14:1) #;                             <<00884>>06036000
LOGICAL                                                        <<00884>>06038000
   VARMASK = Q-4;                                              <<00884>>06040000
DOUBLE                                                         <<00884>>06042000
   RECNO;                                                      <<00884>>06044000
ARRAY                                                          <<00884>>06046000
   REC'(0:COMRECSIZEM1);                                       <<00884>>06048000
BYTE ARRAY                                                     <<00884>>06050000
   REC(*) = REC';                                              <<00884>>06052000
                                                               <<00884>>06054000
SUBROUTINE SET'RETURN'PARMS;                                   <<00884>>06056000
   BEGIN                                                       <<00884>>06058000
   IF USERRECPARM THEN USERREC := INTEGER(RECNO);              <<00884>>06060000
   IF FILERECPARM THEN FILEREC := REC'(COMLINK);               <<00884>>06062000
   ERRNO := 0;                                                 <<00884>>06064000
   END;                                                        <<00884>>06066000
                                                               <<00884>>06068000
                                                               <<00884>>06070000
ERRNO := -1;                                                   <<00884>>06072000
RECNO := DOUBLE(USERREC);                                      <<00884>>06074000
DO BEGIN                                                       <<00884>>06076000
   FREADDIR(COMFN,REC',COMRECSIZE,RECNO);                      <<00884>>06078000
   IF < THEN ERRNO := COMREADFAIL                              <<00884>>06080000
   ELSE                                                        <<00884>>06082000
      IF > THEN ERRNO := EOFOUND                               <<00884>>06084000
      ELSE                                                     <<00884>>06086000
         IF REC'(COMENTRYTYPE) = COMUSERENTRY THEN             <<00884>>06088000
            IF UNAMEPARM THEN                                  <<00884>>06090000
               BEGIN                                           <<00884>>06092000
               IF REC(COMUNAME) = UNAME,(8) AND                <<00884>>06094000
                  REC(COMANAME) = ANAME,(8) THEN               <<00884>>06096000
                     SET'RETURN'PARMS;                         <<00884>>06098000
               END                                             <<00884>>06100000
            ELSE                                               <<00884>>06102000
               BEGIN << Look for any user in this account >>   <<00884>>06104000
               IF REC(COMANAME) = ANAME,(8) THEN               <<00884>>06106000
                     SET'RETURN'PARMS;                         <<00884>>06108000
               END;                                            <<00884>>06110000
   RECNO := RECNO + 1D;                                        <<00884>>06112000
   END                                                         <<00884>>06114000
UNTIL ERRNO <> -1;                                             <<00884>>06116000
                                                               <<00884>>06118000
END; << SEARCHCOMFILE >>                                       <<00884>>06120000
$CONTROL SEGMENT = MAIN                                        <<00884>>06122000
END. << MODULE UDC >>                                          <<00884>>06124000
