$CONTROL USLINIT,CODE,MAP,PRIVILEGED                                    00015000
<< LOGSEG1 - MODULE 91 >>                                               00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$CONTROL ADR                                                   <<01878>>00055000
$CONTROL SEGMENT=LOGSEG1,MAIN=LOGSEG1                                   00060000
<<-------------------------------------------------------->>   <<01883>>00065000
<< USE X1 = ON TO COMPILE IN DEBUGGING/BUG CATCHER CODE.  >>   <<01883>>00070000
<<-------------------------------------------------------->>   <<01883>>00075000
$SET X1=OFF                                                    <<01883>>00080000
BEGIN                                                                   00085000
                                                                        00090000
<< Correct bad parsing - Store fully qual. filename correctly.><<01878>>00095000
<<Add error checking of DST# and offset for intrinsics.     >> <<01878>>00100000
<< Adds comments and makes use of equated values. >>           <<01878>>00105000
<< Resolves LISTLOG printing 20 lines of garbage.           >> <<01878>>00110000
<< Enhancement - Logging to labeled serial disc, LINUS  >>     <<01878>>00115000
<< SHOWLOGSTATUS check status of log process in all cases.   >><<01878>>00120000
<< Check for new process status INITIALIZING.               >> <<01878>>00125000
<< Remove any declarations of unused items. General clean up.>><<01878>>00130000
<< Problem with Log Process calling FLUSH and losing STOPS.  >><<01878>>00135000
<< Make use of include file for table definitions, etc.      >><<01878>>00140000
<< All intrinsics now check user capability mask for LG or OP>><<01878>>00145000
<< Remove all dependencies to the DST table.                 >><<01878>>00150000
<< Print out File System errors and U.L. errors.             >><<01878>>00155000
<< Reinsert missing lines of the fix file.                   >><<01878>>00160000
<< Fix problem with CHECKINDEX -- lock LOGTAB.               >><<01878>>00165000
<< OPENLOG to bump user count, obtain entry in LOGBUFF iff no>><<01878>>00170000
<<   entry exists for this user.                             >><<01878>>00175000
<< Enhancement -- :CHANGELOG.                                >><<01878>>00180000
DEFINE                                                         <<01878>>00185000
  CC  =  STATUS'.(6:2)#;                                       <<01878>>00190000
$INCLUDE INCLPCB5                                              <<01878>>00195000
$INCLUDE INCLLOG                                               <<01878>>00200000
$IF X1=ON                                                      <<01883>>00205000
$PAGE "*** BUG CATCHER DEFINES, EQUATES, AND VARIABLES ***"    <<01883>>00210000
                                                               <<01883>>00215000
EQUATE                                                         <<01883>>00220000
   <<----------------------------------------------------->>   <<01883>>00225000
   << NOTE: IT IS POSSIBLE TO LOG "K" EVENTS IN THE BUG   >>   <<01883>>00230000
   <<       CATCHER EXTRA DATA SEGEMENT BEFORE WRAPPING   >>   <<01883>>00235000
   <<       ARROUND.                                      >>   <<01883>>00240000
   <<                                                     >>   <<01883>>00245000
   << WHERE: K = (DSEG'LENGTH / SIZE'OF'ENTRY) -1         >>   <<01883>>00250000
   <<----------------------------------------------------->>   <<01883>>00255000
                                                               <<01883>>00260000
   SIZE'OF'ENTRY       = 8,                                    <<01883>>00265000
   DSEG'LENGTH         = 32764;                                <<01883>>00270000
                                                               <<01883>>00275000
DEFINE                                                         <<01883>>00280000
   <<----------------------------------------------------->>   <<01883>>00285000
   << DEFINE XDS HEADER FORMAT.                           >>   <<01883>>00290000
   <<----------------------------------------------------->>   <<01883>>00295000
                                                               <<01883>>00300000
   DSEGH'CUR'ENTRY     = DSEG'HEADER(2)#,                      <<01883>>00305000
   DSEGH'DSEGNO        = DSEG'HEADER(3)#,                      <<01883>>00310000
   DSEGH'ENTRY'LEN     = DSEG'HEADER(1)#,                      <<01883>>00315000
   DSEGH'MAX'ENTRIES   = DSEG'HEADER(0)#;                      <<01883>>00320000
                                                               <<01883>>00325000
DEFINE                                                         <<01883>>00330000
   <<----------------------------------------------------->>   <<01883>>00335000
   << DEFINE EVENT RECORD FORMAT IN XDS.                  >>   <<01883>>00340000
   <<----------------------------------------------------->>   <<01883>>00345000
                                                               <<01883>>00350000
   DSEG'PIN            = DSEG(INDEX+1)#,                       <<01883>>00355000
   DSEG'STATUS         = DSEG(INDEX+2)#,                       <<01883>>00360000
   DSEG'DELTAP         = DSEG(INDEX+3)#,                       <<01883>>00365000
   DSEG'EVENT          = DSEG(INDEX+4)#,                       <<01883>>00370000
   DSEG'MISC1          = DSEG(INDEX+5)#,                       <<01883>>00375000
   DSEG'MISC2          = DSEG(INDEX+6)#,                       <<01883>>00380000
   DSEG'MISC3          = DSEG(INDEX+7)#,                       <<01883>>00385000
   DSEG'MISC4          = DSEG(INDEX+8)#;                       <<01883>>00390000
                                                               <<01883>>00395000
DEFINE                                                         <<01883>>00400000
   <<----------------------------------------------------->>   <<01883>>00405000
   << SYSGLOB EXTENSION CELL FOR REMEMBERING XDS DST NUM. >>   <<01883>>00410000
   << NOTE: CHECK TO BE SURE CELL IS UNUSED!              >>   <<01883>>00415000
   <<----------------------------------------------------->>   <<01883>>00420000
                                                               <<01883>>00425000
   SYSGLOBEXT'DSEG     = SYSGLOBEXT(%15)#;                     <<01883>>00430000
                                                               <<01883>>00435000
POINTER                                                        <<01883>>00440000
   SYSGLOBEXT          = << ST+ >> %377;                       <<01883>>00445000
                                                               <<01883>>00450000
EQUATE                                                         <<01883>>00600000
   <<---------------------------------------------------->>    <<01883>>00605000
   << EQUATES FOR VARIOUS BUG CATCHER EVENT NUMBERS.     >>    <<01883>>00610000
   <<---------------------------------------------------->>    <<01883>>00615000
                                                               <<01883>>00620000
   BC'RELEASE             = 1,                                 <<01883>>00625000
   BC'OBTAIN              = BC'RELEASE+1,                      <<01883>>00630000
   BC'AWAKE               = BC'OBTAIN+1,                       <<01883>>00635000
   BC'WAIT                = BC'AWAKE+1,                        <<01883>>00640000
   BC'ATTACHIO            = BC'WAIT+1,                         <<01883>>00645000
   BC'VALUES              = BC'ATTACHIO+1,                     <<01883>>00650000
   BC'RELDATASEG          = BC'VALUES+1,                       <<01883>>00651000
   BC'RELSIR              = BC'RELDATASEG+1,                   <<01883>>00652000
   BC'GETSIR              = BC'RELSIR+1;                       <<01883>>00653000
                                                               <<01883>>00655000
$IF                                                            <<01883>>00660000
$PAGE  "EXTERNAL PROCEDURES"                                   <<01878>>00665000
LOGICAL PROCEDURE PARSELOGID(PARMSP,PARMPTR,LEN,ERR);          <<01878>>00670000
   VALUE LEN;                                                  <<01878>>00675000
   BYTE ARRAY PARMSP;                                          <<01878>>00680000
   BYTE POINTER PARMPTR;                                       <<01878>>00685000
   INTEGER LEN,ERR;                                            <<01878>>00690000
   OPTION FORWARD,INTERNAL;                                    <<01878>>00695000
                                                               <<01878>>00700000
                                                               <<01878>>00705000
                                                               <<01878>>00710000
LOGICAL PROCEDURE PARSELOG(PARMPTR,DELIMPTR,FILENAME,          <<01878>>00715000
                           TYP',ALLOW'CHANGE,ERR);             <<01878>>00720000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>00725000
   BYTE ARRAY FILENAME;                                        <<01878>>00730000
   LOGICAL TYP', ALLOW'CHANGE;                                 <<01878>>00735000
   INTEGER ERR;                                                <<01878>>00740000
   OPTION FORWARD,INTERNAL;                                    <<01878>>00745000
                                                               <<01878>>00750000
                                                               <<01878>>00755000
                                                               <<01878>>00760000
LOGICAL PROCEDURE PARSEPASS(PARMPTR,DELIMPTR,BPASS,ERR);       <<01878>>00765000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>00770000
   BYTE ARRAY BPASS;                                           <<01878>>00775000
   INTEGER ERR;                                                <<01878>>00780000
   OPTION FORWARD,INTERNAL;                                    <<01878>>00785000
                                                               <<01878>>00790000
PROCEDURE DEPOSIT'FILENAME(STRING,NAME',LOCK',GROUP',ACCT');   <<01878>>00795000
   BYTE ARRAY STRING,NAME',LOCK',GROUP',ACCT';                 <<01878>>00800000
   OPTION FORWARD;                                             <<01878>>00805000
                                                               <<01878>>00810000
PROCEDURE EXTRACT'FILENAME(FILENAME,NAME',LOCK',GROUP',ACCT'); <<01878>>00815000
   BYTE ARRAY FILENAME,NAME',LOCK',GROUP',ACCT';               <<01878>>00820000
   OPTION FORWARD;                                             <<01878>>00825000
                                                               <<01878>>00830000
LOGICAL PROCEDURE ALTER'LID'ENTRY(LOGID',BPASS,FILENAME,TYPE');<<01878>>00835000
   VALUE TYPE';                                                <<01878>>00840000
   BYTE ARRAY LOGID',BPASS,FILENAME;                           <<01878>>00845000
   INTEGER TYPE';                                              <<01878>>00850000
   OPTION VARIABLE,FORWARD;                                    <<01878>>00855000
                                                               <<01878>>00860000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<01878>>00865000
   VALUE PDEF;                                                 <<01878>>00870000
   DOUBLE PDEF;                                                <<01878>>00875000
   LOGICAL GPTR,APTR,ERRPTR;                                   <<01878>>00880000
   OPTION EXTERNAL;                                            <<01878>>00885000
                                                               <<01878>>00890000
                                                               <<01878>>00895000
                                                               <<01878>>00900000
                                                               <<01878>>00905000
                                                               <<01878>>00910000
                                                               <<01878>>00915000
INTEGER PROCEDURE IOSTAT(STAT);                                <<01878>>00920000
   VALUE STAT;                                                 <<01878>>00925000
   INTEGER STAT;                                               <<01878>>00930000
   OPTION EXTERNAL;                                            <<01878>>00935000
                                                               <<01878>>00940000
                                                               <<01878>>00945000
                                                               <<01878>>00950000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,   <<01878>>00955000
        PARM4,PARM5,DEST,REPLY,OFFSET,DST',CONTROL);           <<01878>>00960000
   VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,DEST,  <<01878>>00965000
         REPLY,OFFSET,DST',CONTROL;                            <<01878>>00970000
   INTEGER SETNO,MSGNO,DEST,DST';                              <<01878>>00975000
   LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,    <<01878>>00980000
           CONTROL;                                            <<01878>>00985000
   OPTION VARIABLE,EXTERNAL;                                   <<01878>>00990000
                                                               <<01878>>00995000
                                                               <<01878>>01000000
                                                               <<01878>>01005000
                                                                        01010000
PROCEDURE WRITEDSEG(EN);                                                01015000
VALUE EN;                                                               01020000
INTEGER EN;                                                             01025000
OPTION EXTERNAL;                                                        01030000
                                                                        01035000
DOUBLE PROCEDURE CHEK(INTRINEXIT,FLAGS,PARMS,CAPMASK,OPTVMSK);          01040000
VALUE INTRINEXIT,FLAGS,PARMS,CAPMASK,OPTVMSK;                           01045000
DOUBLE PARMS,CAPMASK;                                                   01050000
LOGICAL INTRINEXIT,FLAGS,OPTVMSK;                                       01055000
OPTION VARIABLE,UNCALLABLE,EXTERNAL;                                    01060000
DOUBLE PROCEDURE CHEK'NOABORT(INTRINEXIT,FLAGS,PARMS,CAPMASK,           01065000
                              OPTVMSK);                                 01070000
VALUE INTRINEXIT,FLAGS,PARMS,CAPMASK,OPTVMSK;                           01075000
DOUBLE PARMS,CAPMASK;                                                   01080000
LOGICAL INTRINEXIT,FLAGS,OPTVMSK;                                       01085000
OPTION VARIABLE,UNCALLABLE,EXTERNAL;                                    01090000
                                                                        01095000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     01100000
VALUE DSTX;                                                             01105000
LOGICAL DSTX;                                                           01110000
OPTION EXTERNAL;                                                        01115000
                                                                        01120000
PROCEDURE MOVE'FROM'DSEG(TARGET,SEGMENT,OFFSET,COUNT);         <<01878>>01125000
   VALUE TARGET,SEGMENT,OFFSET,COUNT;                          <<01878>>01130000
   INTEGER TARGET,SEGMENT,OFFSET,COUNT;                        <<01878>>01135000
   OPTION FORWARD,INTERNAL;                                    <<01878>>01140000
                                                               <<01878>>01145000
                                                               <<01878>>01150000
                                                               <<01878>>01155000
PROCEDURE MOVE'TO'DSEG(SEGMENT,OFFSET,SOURCE,COUNT);           <<01878>>01160000
   VALUE SEGMENT,OFFSET,SOURCE,COUNT;                          <<01878>>01165000
   INTEGER SEGMENT,OFFSET,SOURCE,COUNT;                        <<01878>>01170000
   OPTION FORWARD,INTERNAL;                                    <<01878>>01175000
                                                               <<01878>>01180000
                                                               <<01878>>01185000
                                                               <<01878>>01190000
LOGICAL PROCEDURE CHEKINDEX(BUFDST,ENUM);                      <<01878>>01195000
   VALUE ENUM;                                                 <<01878>>01200000
   INTEGER BUFDST,ENUM;                                        <<01878>>01205000
   OPTION FORWARD,PRIVILEGED,INTERNAL;                         <<01878>>01210000
                                                               <<01878>>01215000
                                                               <<01878>>01220000
                                                               <<01878>>01225000
                                                                        01230000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         01235000
VALUE PCBPT,N,WAITF;                                                    01240000
INTEGER PCBPT,N,WAITF;                                                  01245000
OPTION PRIVILEGED UNCALLABLE,EXTERNAL;                                  01250000
                                                                        01255000
PROCEDURE WAIT(WAITC,JPCOUNTX);                                         01260000
VALUE WAITC,JPCOUNTX;                                                   01265000
INTEGER WAITC,JPCOUNTX;                                                 01270000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  01275000
                                                                        01280000
LOGICAL PROCEDURE GETSIR(SIRN);                                         01285000
VALUE SIRN;                                                             01290000
INTEGER SIRN;                                                           01295000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  01300000
                                                                        01305000
PROCEDURE RELSIR(SIRN,A);                                               01310000
VALUE SIRN,A;                                                           01315000
INTEGER SIRN;                                                           01320000
LOGICAL A;                                                              01325000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  01330000
                                                                        01335000
DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);   01340000
VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                        01345000
INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                      01350000
OPTION EXTERNAL;                                                        01355000
                                                                        01360000
INTRINSIC WHO,CLOCK,CALENDAR,ASCII,DASCII,SEARCH,PRINT;        <<01878>>01365000
                                                                        01370000
                                                                        01375000
LOGICAL PROCEDURE FINDLOG(LOGNAME,INDEX);                               01380000
INTEGER INDEX;                                                          01385000
BYTE ARRAY LOGNAME;                                                     01390000
OPTION EXTERNAL;                                                        01395000
                                                                        01400000
LOGICAL PROCEDURE GENTRY(INDEX,TYPE);                                   01405000
VALUE TYPE;                                                             01410000
INTEGER INDEX,TYPE;                                                     01415000
OPTION EXTERNAL;                                                        01420000
                                                                        01425000
LOGICAL PROCEDURE RELENTRY(INDEX,TYPE);                                 01430000
VALUE INDEX,TYPE;                                                       01435000
INTEGER INDEX,TYPE;                                                     01440000
OPTION EXTERNAL;                                                        01445000
                                                                        01450000
PROCEDURE ERRORON;                                                      01455000
OPTION EXTERNAL;                                                        01460000
                                                                        01465000
PROCEDURE ERROREXIT(INTRINEXIT,ERRWORD,PARAM);                          01470000
VALUE INTRINEXIT,ERRWORD,PARAM;                                         01475000
LOGICAL INTRINEXIT,ERRWORD,PARAM;                                       01480000
OPTION EXTERNAL;                                                        01485000
                                                                        01490000
PROCEDURE RELEASE(RES,ALTRES,WAKEUP);                                   01495000
VALUE RES,ALTRES,WAKEUP;                                                01500000
LOGICAL WAKEUP;                                                         01505000
LOGICAL POINTER RES,ALTRES;                                             01510000
OPTION EXTERNAL;                                                        01515000
                                                                        01520000
INTEGER PROCEDURE OBTAIN(RES,ALTRES);                                   01525000
VALUE RES,ALTRES;                                                       01530000
LOGICAL POINTER RES,ALTRES;                                             01535000
OPTION EXTERNAL;                                                        01540000
                                                                        01545000
PROCEDURE FENTRY(LOGID',PASS,FNAME,UNAME,UACCT,TYPE);          <<01878>>01550000
BYTE ARRAY LOGID',PASS,FNAME,UNAME,UACCT;                      <<01878>>01555000
LOGICAL TYPE;                                                           01560000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE,FORWARD;                          01565000
                                                                        01570000
                                                                        01575000
                                                               <<01878>>01580000
LOGICAL PROCEDURE SETCRITICAL;                                 <<01878>>01585000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<01878>>01590000
                                                               <<01878>>01595000
PROCEDURE RESETCRITICAL(CRSTATE);                              <<01878>>01600000
VALUE CRSTATE;                                                 <<01878>>01605000
LOGICAL CRSTATE;                                               <<01878>>01610000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<01878>>01615000
                                                               <<01878>>01620000
                                                                        01625000
                                                                        01630000
PROCEDURE CIERR(ERRNUM,ERRADDR,PARMMASK,PARM);                          01635000
VALUE ERRNUM,PARMMASK,PARM;                                             01640000
INTEGER ERRNUM,PARMMASK,PARM;                                           01645000
BYTE ARRAY ERRADDR;                                                     01650000
OPTION VARIABLE,EXTERNAL;                                               01655000
                                                                        01660000
                                                                        01665000
                                                                        01670000
PROCEDURE QUALIFYFILENAME(OLDNAME,NEWNAME);                             01675000
BYTE ARRAY OLDNAME,NEWNAME;                                             01680000
OPTION EXTERNAL;                                                        01685000
                                                                        01690000
                                                                        01695000
INTEGER PROCEDURE FINDPARM(STRING,PARMPTR,DELIMPTR);                    01700000
BYTE ARRAY STRING;                                                      01705000
BYTE POINTER PARMPTR,DELIMPTR;                                          01710000
OPTION VARIABLE,EXTERNAL;                                               01715000
                                                                        01720000
INTEGER PROCEDURE NEXTPARM(STRING,PARMPTR,DELIMPTR);                    01725000
BYTE ARRAY STRING;                                                      01730000
BYTE POINTER PARMPTR,DELIMPTR;                                          01735000
OPTION VARIABLE,EXTERNAL;                                               01740000
                                                                        01745000
                                                               <<01878>>01750000
PROCEDURE DEL'LOCKWORD(FILENAME);                              <<01878>>01755000
   BYTE ARRAY FILENAME;                                        <<01878>>01760000
   OPTION EXTERNAL;                                            <<01878>>01765000
                                                               <<01878>>01770000
                                                               <<01878>>01775000
PROCEDURE FLUSH(INDEX,FLAG);                                   <<01878>>01780000
VALUE INDEX,FLAG;                                              <<01878>>01785000
INTEGER INDEX;                                                 <<01878>>01790000
LOGICAL FLAG;                                                  <<01878>>01795000
OPTION FORWARD;                                                <<01878>>01800000
                                                               <<01883>>01805000
$IF X1=ON                                                      <<01883>>01810000
                                                               <<01883>>01815000
INTEGER PROCEDURE GETDATASEG (DSLEN, VDSLEN);                  <<01883>>01820000
   VALUE   DSLEN, VDSLEN;                                      <<01883>>01825000
   INTEGER DSLEN, VDSLEN;                                      <<01883>>01830000
   OPTION  EXTERNAL;                                           <<01883>>01835000
                                                               <<01883>>01840000
$IF                                                            <<01883>>01845000
                                                               <<01883>>01850000
                                                               <<01878>>01855000
PROCEDURE LOGINFO(ENTRY'INDEX,STATUS',ITEMNUM1,ITEMVAL1,       <<01878>>01860000
     ITEMNUM2,ITEMVAL2,ITEMNUM3,ITEMVAL3,ITEMNUM4,ITEMVAL4);   <<01878>>01865000
VALUE ENTRY'INDEX,ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4;         <<01878>>01870000
DOUBLE ENTRY'INDEX;                                            <<01878>>01875000
INTEGER STATUS',ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4;           <<01878>>01880000
BYTE ARRAY ITEMVAL1,ITEMVAL2,ITEMVAL3,ITEMVAL4;                <<01878>>01885000
OPTION VARIABLE,PRIVILEGED,FORWARD;                           <<*LOG2>> 01890000
                                                               <<01883>>01895000
$IF X1=ON                                                      <<01883>>01900000
$PAGE "*** BUG CATCHER XDS ALLOCATION PROCEDURE ***"           <<01883>>01905000
INTEGER PROCEDURE GET'BC'XDS'NUMBER;                           <<01883>>01910000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01883>>01915000
                                                               <<01883>>01916000
<< -------------------------------------------------- >>       <<01883>>01917000
<< PURPOSE:                                           >>       <<01883>>01918000
<<    THIS PROCEDURE WILL EITHER ALLOCATE AN EXTRA    >>       <<01883>>01919000
<<    DATA SEGMENT (XDS), DETERMINE THAT ONE HAS      >>       <<01883>>01919100
<<    ALREADY BEEN ALOCATED, OR INDICATE THAT ONE     >>       <<01883>>01919200
<<    CANNOT BE ALLOCATED.                            >>       <<01883>>01919210
<<                                                    >>       <<01883>>01919220
<<    THE XDS TO BE ALLOCATED IS INTENDED TO BE USED  >>       <<01883>>01919230
<<    BY THE PROCEDURE WHAT'S'UP WHICH IS THE INTER-  >>       <<01883>>01919240
<<    FACE IN A BUG CATCHING/EVENT LOGGING SETUP.     >>       <<01883>>01919250
<<    THIS SETUP IS ESPECIALLY HANDY FOR DEBUGGING    >>       <<01883>>01919260
<<    TIMING RELATED PROBLEMS.                        >>       <<01883>>01919270
<<                                                    >>       <<01883>>01919280
<< DETAILS:                                           >>       <<01883>>01919290
<<    THE XDS NUMBER IS KEPT IN A SYSGLOB EXTENSION   >>       <<01883>>01919300
<<    CELL. THIS CELL WILL HAVE BEEN ZEROED OUT BY    >>       <<01883>>01919310
<<    INITIAL AT SYSTEM BOOT TIME SO WE CAN CHECK     >>       <<01883>>01919320
<<    IT AGAINST ZERO TO DETERMINE IF AN XDS HAS      >>       <<01883>>01919330
<<    ALREADY BEEN ALLOCATED. IF IT HAS WE SIMPLY     >>       <<01883>>01919340
<<    RETURN THIS NUMBER. IF NONE HAS BEEN ALLOCATED  >>       <<01883>>01919350
<<    THEN WE WILL ATTEMPT TO ALLOCATE ONE AND INIT-  >>       <<01883>>01919450
<<    IALIZE THE HEADER AREA (SEE XDS DEFINITIONS AT  >>       <<01883>>01919550
<<    FRONT OF THIS LISTING).                         >>       <<01883>>01919650
<<                                                    >>       <<01883>>01919750
<< RETURNS:                                           >>       <<01883>>01919850
<<    XDS DST# ==> IF ONE WAS ALREADY ALLOCATED OR    >>       <<01883>>01919950
<<                 THIS CALL ALLOCETED ONE.           >>       <<01883>>01919960
<<    0        ==> IF NO XDS WAS OR COULD BE          >>       <<01883>>01919970
<<                 ALLOCATED.                         >>       <<01883>>01919980
<<                                                    >>       <<01883>>01919990
<< DB CAN BE ANYWHERE WHEN THIS PROCEDURE IS CALLED   >>       <<01883>>01919991
<<                                                    >>       <<01883>>01919992
<< -------------------------------------------------- >>       <<01883>>01919993
                                                               <<01883>>01920000
BEGIN << -- GET'BC'XDS'NUMBER -->>                             <<01883>>01925000
                                                               <<01883>>01930000
   INTEGER                                                     <<01883>>01935000
      DST'AT'ENTRY,                                            <<01883>>01940000
      SEG'NUM;                                                 <<01883>>01945000
                                                               <<01883>>01950000
   LOGICAL ARRAY DSEG'HEADER(0:SIZE'OF'ENTRY-1) = Q;           <<01883>>01955000
                                                               <<01883>>01956000
<<----------------------------------------------------------->><<01883>>01957000
<< B E G I N   P R O C   G E T ' B C ' X D S ' N U M B E R   >><<01883>>01958000
<<----------------------------------------------------------->><<01883>>01959000
                                                               <<01883>>01970000
   IF ((SEG'NUM := SYSGLOBEXT'DSEG) <> 0) THEN                 <<01883>>01975000
      GET'BC'XDS'NUMBER := SEG'NUM                             <<01883>>01980000
   ELSE                                                        <<01883>>01985000
      BEGIN                                                    <<01883>>01990000
         SEG'NUM := GETDATASEG(DSEG'LENGTH, 0);                <<01883>>01995000
         IF < OR (SEG'NUM = 0) THEN                            <<01883>>02000000
            GET'BC'XDS'NUMBER := 0                             <<01883>>02001000
         ELSE                                                  <<01883>>02010000
            BEGIN                                              <<01883>>02015000
               << NO MORE SPLIT STACK ... PUT DB AT STACK >>   <<01883>>02015100
               DST'AT'ENTRY := EXCHANGEDB (0);                 <<01883>>02016000
               DSEGH'DSEGNO         := SEG'NUM;                <<01883>>02020000
               DSEGH'MAX'ENTRIES    := DSEG'LENGTH /           <<01883>>02025000
                                            SIZE'OF'ENTRY;     <<01883>>02030000
               DSEGH'CUR'ENTRY      := 0;                      <<01883>>02035000
               DSEGH'ENTRY'LEN      := SIZE'OF'ENTRY;          <<01883>>02040000
                                                               <<01883>>02045000
               << -- ZERO OUT UNUSED PART OF ENTRY -- >>       <<01883>>02050000
               DSEG'HEADER(4) := 0;                            <<01883>>02055000
               MOVE DSEG'HEADER(5) := DSEG'HEADER(4), (3);     <<01883>>02060000
                                                               <<01883>>02065000
               TOS := SEG'NUM;                                 <<01883>>02070000
               TOS := 0;                                       <<01883>>02075000
               TOS := @DSEG'HEADER;                            <<01883>>02080000
               TOS := SIZE'OF'ENTRY;                           <<01883>>02085000
               ASSEMBLE( MTDS 4 );                             <<01883>>02090000
                                                               <<01883>>02095000
               GET'BC'XDS'NUMBER := SYSGLOBEXT'DSEG := SEG'NUM;<<01883>>02100000
               << PUT DB BACK AT STACK >>                      <<01883>>02101100
               EXCHANGEDB (DST'AT'ENTRY);                      <<01883>>02102000
            END;                                               <<01883>>02105000
      END;                                                     <<01883>>02110000
                                                               <<01883>>02115000
END;  << -- GET'BC'XDS'NUMBER -- >>                            <<01883>>02130000
                                                               <<01883>>02135000
$PAGE "*** BUG CATCHER EVENT LOGGING PROCEDURE ***"            <<01883>>02140000
PROCEDURE WHAT'S'UP ( EVENT, P1, P2, P3, P4 );                 <<01883>>02145000
   VALUE   EVENT, P1, P2, P3, P4;                              <<01883>>02150000
   INTEGER EVENT, P1, P2, P3, P4;                              <<01883>>02155000
   OPTION  PRIVILEGED, UNCALLABLE, VARIABLE;                   <<01883>>02160000
                                                               <<01883>>02165000
BEGIN << -- WHAT'S'UP -- >>                                    <<01883>>02170000
                                                               <<01883>>02175000
   INTEGER                                                     <<01883>>02180000
      SEG'NUM,                                                 <<01883>>02181000
      DST'AT'ENTRY,                                            <<01883>>02185000
      INDEX := 0;                                              <<01883>>02190000
                                                               <<01883>>02195000
   LOGICAL                                                     <<01883>>02200000
      PMASK = Q-4;                                             <<01883>>02205000
                                                               <<01883>>02210000
   INTEGER                                                     <<01883>>02215000
      STATUS'REG = Q-1,                                        <<01883>>02220000
      DELTA'P    = Q-2;                                        <<01883>>02225000
                                                               <<01883>>02230000
   LOGICAL ARRAY DSEG (0:SIZE'OF'ENTRY-1) = Q;                 <<01883>>02235000
   LOGICAL ARRAY DSEG'HEADER(0:SIZE'OF'ENTRY-1) = Q;           <<01883>>02240000
                                                               <<01883>>02245000
   EQUATE                                                      <<01883>>02250000
      PCB'SIZE = %25;                                          <<01883>>02255000
                                                               <<01883>>02260000
   <<-------------------------------------------------------->><<01883>>02265000
   << B E G I N   P R O C E D U R E   W H A T ' S ' U P      >><<01883>>02270000
   <<-------------------------------------------------------->><<01883>>02275000
                                                               <<01883>>02280000
   IF (SEG'NUM := GET'BC'XDS'NUMBER) <= 0 THEN                 <<01883>>02285000
      RETURN; << JUST RETURN ==> CAN'T GET XDS >>              <<01883>>02286000
                                                               <<01883>>02290000
   << DEFAULT ALL NON-SPECIFIED PARAMETS TO 0 >>               <<01883>>02295000
   IF PMASK.(15:1) = 0 THEN                                    <<01883>>02300000
      P4 := 0;                                                 <<01883>>02305000
   IF PMASK.(14:1) = 0 THEN                                    <<01883>>02310000
      P3 := 0;                                                 <<01883>>02315000
   IF PMASK.(13:1) = 0 THEN                                    <<01883>>02320000
      P2 := 0;                                                 <<01883>>02325000
   IF PMASK.(12:1) = 0 THEN                                    <<01883>>02330000
      P1 := 0;                                                 <<01883>>02335000
   IF PMASK.(11:1) = 0 THEN                                    <<01883>>02340000
      EVENT := 0;                                              <<01883>>02345000
                                                               <<01883>>02350000
   DST'AT'ENTRY := EXCHANGEDB(0); << NO MORE SPLIT STACK ... >><<01883>>02362000
                                                               <<01883>>02365000
   << COPY DSEG HEADER INTO STACK >>                           <<01883>>02370000
   TOS := @DSEG'HEADER;                                        <<01883>>02375000
   TOS := SEG'NUM;                                             <<01883>>02380000
   TOS := 0;                                                   <<01883>>02385000
   TOS := SIZE'OF'ENTRY;                                       <<01883>>02390000
   ASSEMBLE( MFDS 4 );                                         <<01883>>02395000
                                                               <<01883>>02400000
   IF (DSEGH'CUR'ENTRY := DSEGH'CUR'ENTRY + 1) >=              <<01883>>02405000
                                    DSEGH'MAX'ENTRIES THEN     <<01883>>02410000
      DSEGH'CUR'ENTRY := 1; << WRAP'AROUND >>                  <<01883>>02415000
                                                               <<01883>>02420000
   << COPY MODIFIED DSEG HEADER BACK INTO XDS >>               <<01883>>02425000
   TOS := SEG'NUM;                                             <<01883>>02430000
   TOS := 0;                                                   <<01883>>02435000
   TOS := @DSEG'HEADER;                                        <<01883>>02440000
   TOS := SIZE'OF'ENTRY;                                       <<01883>>02445000
   ASSEMBLE( MTDS 4 );                                         <<01883>>02450000
                                                               <<01883>>02455000
   DSEG'PIN       := CURPRC / PCB'SIZE;                        <<01883>>02460000
   DSEG'STATUS    := STATUS'REG;                               <<01883>>02465000
   DSEG'DELTAP    := DELTA'P;                                  <<01883>>02470000
   DSEG'EVENT     := EVENT;                                    <<01883>>02475000
   DSEG'MISC1     := P1;                                       <<01883>>02480000
   DSEG'MISC2     := P2;                                       <<01883>>02485000
   DSEG'MISC3     := P3;                                       <<01883>>02490000
   DSEG'MISC4     := P4;                                       <<01883>>02495000
                                                               <<01883>>02500000
   << COPY LOG RECORD INTO XDS >>                              <<01883>>02505000
   TOS := SEG'NUM;                                             <<01883>>02510000
   TOS := DSEGH'CUR'ENTRY * SIZE'OF'ENTRY;                     <<01883>>02515000
   TOS := @DSEG;                                               <<01883>>02520000
   TOS := SIZE'OF'ENTRY;                                       <<01883>>02525000
   ASSEMBLE( MTDS 4 );                                         <<01883>>02530000
                                                               <<01883>>02535000
   EXCHANGEDB (DST'AT'ENTRY); << PUT DB BACK ... >>            <<01883>>02545000
                                                               <<01883>>02550000
END;  << -- WHAT'S'UP -- >>                                    <<01883>>02555000
$IF                                                            <<01883>>02560000
$PAGE "USER LOGGING CAPABILITY CHECK"                          <<01883>>02561000
LOGICAL PROCEDURE OKAY'UCAP;                                   <<01878>>02565000
OPTION PRIVILEGED,INTERNAL;                                    <<01878>>02570000
                                                               <<01878>>02575000
BEGIN                                                          <<01878>>02580000
                                                               <<01878>>02585000
<< Called from all intrinsics to insure that the user has    >><<01878>>02590000
<< User logging (LG) or System Supervisor (OP) capability.   >><<01878>>02595000
<<                                                           >><<01878>>02600000
<< DB must be at stack!!                                     >><<01878>>02605000
<<                                                           >><<01878>>02610000
<< RETURNS:                                                  >><<01878>>02615000
<<    TRUE - user has proper capability.                     >><<01878>>02620000
<<    FALSE- illegal capability.                             >><<01878>>02625000
<<                                                           >><<01878>>02630000
                                                               <<01878>>02635000
ENTRY                                                          <<01878>>02640000
   CHECK'FOR'SM'OP;                                            <<01878>>02645000
DEFINE                                                         <<01878>>02650000
   PXJITDST    =  PCBX(11)#,         << JIT dst # from PCBX  >><<01878>>02655000
   LG          =  (UCAP.(8:1) = 1)#, << User Logging capabil.>><<01878>>02660000
   OP          =  (UCAP.(5:1) = 1)#, << System Supervisor cap>><<01878>>02665000
   SM          =  (UCAP.(0:1) = 1)#; << System Manager cap   >><<01878>>02670000
                                                               <<01878>>02675000
                                                               <<01878>>02680000
EQUATE                                                         <<01878>>02685000
   JITUCAP  = 38;   << Offset into JIT for capability mask   >><<01878>>02690000
                                                               <<01878>>02695000
                                                               <<01878>>02700000
INTEGER POINTER                                                <<01878>>02705000
   PCBX,            << Pointer to PCBX >>                      <<01878>>02710000
   PS0  = S-0;                                                 <<01878>>02715000
                                                               <<01878>>02720000
                                                               <<01878>>02725000
LOGICAL                                                        <<01878>>02730000
   ONLY'CHECK'SM'OP,                                           <<01878>>02735000
   RETURN'VALUE = OKAY'UCAP,                                   <<01878>>02740000
   UCAP;            << User's capability mask (from JIT).    >><<01878>>02745000
                                                               <<01878>>02750000
                                                               <<01878>>02755000
                                                               <<01878>>02760000
IF (ONLY'CHECK'SM'OP := FALSE) THEN                            <<01878>>02765000
   BEGIN                                                       <<01878>>02770000
CHECK'FOR'SM'OP :                                              <<01878>>02775000
   ONLY'CHECK'SM'OP := TRUE;                                   <<01878>>02780000
   END;                                                        <<01878>>02785000
                                                               <<01878>>02790000
                                                               <<01878>>02795000
PUSH(DL);              << Set up the                         >><<01878>>02800000
TOS := TOS - PS0(-1);  <<     pointer to                     >><<01878>>02805000
@PCBX := TOS;          <<         the PCBX                   >><<01878>>02810000
                                                               <<01878>>02815000
<< Now want to get the user capability mask from the JIT     >><<01878>>02820000
                                                               <<01878>>02825000
MOVE'FROM'DSEG(@UCAP,PXJITDST,JITUCAP,1);                      <<01878>>02830000
                                                               <<01878>>02835000
IF ONLY'CHECK'SM'OP THEN                                       <<01878>>02840000
   BEGIN                                                       <<01878>>02845000
   IF SM OR OP                                                 <<01878>>02850000
      THEN RETURN'VALUE := TRUE                                <<01878>>02855000
   ELSE RETURN'VALUE := FALSE;                                 <<01878>>02860000
   END                                                         <<01878>>02865000
ELSE                                                           <<01878>>02870000
   BEGIN                                                       <<01878>>02875000
   IF LG OR OP                                                 <<01878>>02880000
     THEN RETURN'VALUE := TRUE                                 <<01878>>02885000
   ELSE RETURN'VALUE := TRUE;                                  <<01878>>02890000
   END;                                                        <<01878>>02895000
                                                               <<01878>>02900000
                                                               <<01878>>02905000
END;        << Okay'ucap >>                                    <<01878>>02910000
                                                               <<01878>>02915000
                                                               <<01878>>02920000
LOGICAL PROCEDURE COMPSTRING(STRING1,STRING2,MAXLEN);          <<01878>>02925000
   VALUE MAXLEN;                                               <<01878>>02930000
   INTEGER MAXLEN;                                             <<01878>>02935000
   BYTE ARRAY STRING1;                                         <<01878>>02940000
   BYTE ARRAY STRING2;                                         <<01878>>02945000
   OPTION FORWARD;                                             <<01878>>02950000
                                                               <<01878>>02955000
$PAGE   "LOGGING INTRINSICS -- OPENLOG"                        <<01878>>02960000
PROCEDURE OPENLOG(INDEX',WLOGID',WPASS,MODE,STAT);                      02965000
DOUBLE INDEX';                                                          02970000
INTEGER MODE,STAT;                                                      02975000
LOGICAL ARRAY WPASS,WLOGID';                                            02980000
OPTION PRIVILEGED;                                                      02985000
                                                               <<01878>>02990000
COMMENT                                                        <<01878>>02995000
  Intrinsic to obtain access to a user logging file.           <<01878>>03000000
                                                               <<01878>>03005000
There must already be an entry in the LOGTAB for this logid    <<01878>>03010000
(i.e. LOG command to activate the process). If it's there, will<<01878>>03015000
try to get an entry in the Logging Buffer. Then sets bit in    <<01878>>03020000
PXFIXED to signify access to a User Logging file. Then output  <<01878>>03025000
an Open log record to the buffer area of the Logging Buffer.   <<01878>>03030000
                                                               <<01878>>03035000
Will only obtain an entry in the LOGBUFF iff this is the       <<01878>>03040000
first OPENLOG call for this user.                              <<01878>>03045000
                                                               <<01878>>03050000
PARAMETERS:                                                    <<01878>>03055000
 INDEX' - Returned to user. First word contains the entry      <<01878>>03060000
         offset into the LOGBUFF. Second word contains the     <<01878>>03065000
         offset to the LOGTAB entry for the given logid.       <<01878>>03070000
 WLOGID' - User supplied. Contains user logging identification.<<01878>>03075000
         (Up to 8 characters long).                            <<01878>>03080000
 WPASS - User supplied. Contains password associated with the  <<01878>>03085000
         logging identifier.  (Up to 8 characters long).       <<01878>>03090000
 MODE  - User supplied. Zero for wait. One for no wait.        <<01878>>03095000
 STAT  - Status information returned to the user.              <<01878>>03100000
;                                                              <<01878>>03105000
                                                               <<01878>>03110000
BEGIN                                                                   03115000
   BYTE ARRAY BLOGID'(*) = WLOGID';                            <<01878>>03120000
   BYTE ARRAY BPASS(*) = WPASS;                                <<01878>>03125000
                                                               <<01878>>03130000
   LOGICAL STATREG = Q-1;                                      <<01878>>03135000
  DEFINE                                                       <<01878>>03140000
     PRIV   =  STATREG.(0:1) = 1#;                             <<01878>>03145000
   INTEGER S0 = S-0;                                                    03150000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<01878>>03155000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      03160000
   DOUBLE ARRAY DENTRY'(*) = ENTRY';                                    03165000
                                                                        03170000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    03175000
   INTEGER INDEX,TABINDEX;                                              03180000
   LOGICAL A,CRSTATE;                                          <<01878>>03185000
   LOGICAL MATCH;   << True if OPENLOG already called by user>><<01878>>03190000
   LOGICAL MATCH';                                             <<01878>>03195000
   INTEGER I;                                                  <<01878>>03200000
   BYTE ARRAY CUSER(0:8) = Q;                                  <<01878>>03205000
   BYTE ARRAY CGROUP(0:8) = Q;                                 <<01878>>03210000
   BYTE ARRAY CACCT(0:8) = Q;                                  <<01878>>03215000
   INTEGER LOGTABINDEX;                                        <<01878>>03220000
   INTEGER ENUM;                                                        03225000
   ARRAY WPASS'(0:4) = Q;     << Local copy of password >>     <<01878>>03230000
   BYTE ARRAY PASS'(*) = WPASS';                               <<01878>>03235000
   LOGICAL SPLIT'STACK;                                        <<01878>>03240000
                                                                        03245000
   DEFINE INTRINEXIT = [10/210,6/5]#,                                   03250000
   FLAG  = [1/1,8/0,7/5]#;                                              03255000
                                                                        03260000
   DOUBLE PARMS;                                                        03265000
   LOGICAL PARMS1 = PARMS;                                              03270000
   LOGICAL PARMS2 = PARMS+1;                                            03275000
   LOGICAL POINTER BUF,PXFIXED;                                         03280000
   LOGICAL POINTER S0' = S-0;                                           03285000
   DOUBLE POINTER DBUF;                                                 03290000
   BYTE POINTER BBUF;                                                   03295000
   INTEGER X = X;                                                       03300000
   INTEGER BUFDST;                                                      03305000
   LOGICAL NOWAIT;                                                      03310000
   INTEGER STACK,SCODE';                                                03315000
   LOGICAL ARRAY TLOGID(0:4) = Q;   << Local copy of logid >>  <<01878>>03320000
   BYTE ARRAY BTLOGID(*) = TLOGID;                             <<01878>>03325000
   LOGICAL ARRAY TPASS(0:4) = Q;    << Password from LIDTAB >> <<01878>>03330000
   BYTE ARRAY BTPASS(*) = TPASS;                               <<01878>>03335000
                                                                        03340000
                                                                        03345000
                                                                        03350000
                                                                        03355000
                                                                        03360000
SUBROUTINE CHECKMESSAGE;                                                03365000
BEGIN                                                                   03370000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<01878>>03375000
   BEGIN                                                                03380000
      TOS:=LOGBUFF(LOGMSG);                                    <<01878>>03385000
      RELEASE(LOGBUFF(RESOURCE2),NULL,1);                      <<01884>>03390000
$IF X1=ON                                                               03390100
      WHAT'S'UP ( BC'RELEASE,2 );                                       03390200
$IF                                                                     03390300
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>03391000
$IF X1=ON                                                      <<01883>>03395000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>03405000
$IF                                                            <<01883>>03410000
      EXCHANGEDB(STACK);                                       <<01878>>03415000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                03420000
      INDEX' := 0D;                                            <<01878>>03425000
      RESETCRITICAL(CRSTATE);                                  <<01878>>03430000
      ERROREXIT(INTRINEXIT,0,0);                                        03435000
   END;                                                                 03440000
END;                                                                    03445000
                                                                        03450000
                                                               <<01878>>03455000
                                                               <<01878>>03460000
   ERRORON;                                                             03465000
                                                               <<01878>>03470000
   IF (MODE <> 0) AND (MODE <> 1) THEN                                  03475000
   BEGIN                                                                03480000
      STAT:=MODEERR;                                                    03485000
      ERROREXIT(INTRINEXIT,0,0);                                        03490000
   END;                                                                 03495000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    03500000
   PARMS1:=0; PARMS2:=[6/0,2/2,2/2,2/2,2/2,2/2];                        03505000
IF PRIV THEN  SCODE' := INDEX1  ELSE SCODE' := 0;              <<01878>>03510000
   TOS := CHEK(INTRINEXIT,FLAG,PARMS);                         <<01878>>03515000
   IF CARRY                                                    <<01878>>03520000
     THEN SPLIT'STACK := TRUE                                  <<01878>>03525000
   ELSE SPLIT'STACK := FALSE;                                  <<01878>>03530000
                                                               <<01878>>03535000
   IF @WLOGID'+3 > S0  OR  @WPASS+3 > S0 THEN                  <<01878>>03540000
   BEGIN                                                       <<01878>>03545000
      STAT := BOUNDSERR;                                       <<01878>>03550000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>03555000
   END;                                                        <<01878>>03560000
                                                               <<01878>>03565000
   << Now get a local copy of the logid and password. Use  >>  <<01878>>03570000
   << the WHILE loop in case we're in split stack mode.    >>  <<01878>>03575000
                                                               <<01878>>03580000
   X := 0;                                                     <<01878>>03585000
   DO  BTLOGID(X) := " "  UNTIL (X := X+1) > = 8;              <<01878>>03590000
                                                               <<01878>>03595000
   X := 0;                                                     <<01878>>03600000
   DO PASS'(X) := " " UNTIL (X := X+1) >= 8;                   <<01878>>03605000
                                                               <<01878>>03610000
   X := 0;                                                     <<01878>>03615000
   WHILE (BLOGID'(X) = ALPHA  OR  BLOGID'(X) = NUMERIC)        <<01878>>03620000
         AND  X <= 8  DO                                       <<01878>>03625000
   BEGIN                                                       <<01878>>03630000
      BTLOGID(X) := BLOGID'(X);                                <<01878>>03635000
      X := X + 1;                                              <<01878>>03640000
   END;                                                        <<01878>>03645000
                                                               <<01878>>03650000
   IF X <= 0 THEN                                              <<01878>>03655000
   BEGIN                                                       <<01878>>03660000
      STAT := INVALIDLOGID;                                    <<01878>>03665000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>03670000
   END;                                                        <<01878>>03675000
                                                               <<01878>>03680000
   X := 0;                                                     <<01878>>03685000
   WHILE (BPASS(X) = ALPHA  OR  BPASS(X) = NUMERIC)            <<01878>>03690000
         AND  X <= 8  DO                                       <<01878>>03695000
   BEGIN                                                       <<01878>>03700000
      PASS'(X) := BPASS(X);                                    <<01878>>03705000
      X := X + 1;                                              <<01878>>03710000
   END;                                                        <<01878>>03715000
                                                               <<01878>>03720000
                                                               <<01878>>03725000
   << Set DB to the stack. >>                                  <<01878>>03730000
                                                               <<01878>>03735000
   IF SPLIT'STACK                                              <<01878>>03740000
     THEN STACK := EXCHANGEDB(0)                               <<01878>>03745000
   ELSE STACK := 0;                                            <<01878>>03750000
                                                               <<01878>>03755000
                                                               <<01878>>03760000
   << Make sure we have the proper capability >>               <<01878>>03765000
                                                               <<01878>>03770000
   IF NOT OKAY'UCAP THEN                                       <<01878>>03775000
   BEGIN                                                       <<01878>>03780000
      EXCHANGEDB(STACK);                                       <<01878>>03785000
      STAT := ILLEGALCAP;                                      <<01878>>03790000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>03795000
   END;                                                        <<01878>>03800000
                                                               <<01878>>03805000
   CRSTATE:=SETCRITICAL;                                       <<01878>>03810000
                                                               <<01878>>03815000
   << Upshift. Everything in the tables is in upper case. >>   <<01878>>03820000
                                                               <<01878>>03825000
   BTPASS(8) := " ";                                           <<01878>>03830000
   BTLOGID(8) := " ";                                          <<01878>>03835000
   PASS'(8) := " ";                                            <<01878>>03840000
   MOVE BTLOGID := BTLOGID WHILE ANS;                          <<01878>>03845000
   MOVE PASS' := PASS' WHILE ANS;                              <<01878>>03850000
                                                               <<01878>>03855000
   A := GETSIR(LOGSIR);                                        <<01878>>03860000
                                                               <<01878>>03865000
<< See if it's in the LIDTAB. Also get the password for  >>    <<01878>>03870000
<< the password check.                                   >>    <<01878>>03875000
                                                               <<01878>>03880000
      FENTRY(BTLOGID,BTPASS);                                  <<01878>>03885000
      IF > THEN                                                         03890000
      BEGIN                                                             03895000
         EXCHANGEDB(STACK);                                    <<01878>>03900000
         RELSIR(LOGSIR,A);                                     <<01878>>03905000
         INDEX' := 0D;                                         <<01878>>03910000
         STAT:=INVALIDLOGID;                                            03915000
         RESETCRITICAL(CRSTATE);                               <<01878>>03920000
         ERROREXIT(INTRINEXIT,0,0);                                     03925000
      END;                                                     <<01878>>03930000
      << Make sure the password found in the LIDTAB matches >> <<01878>>03935000
      << that passed in by the user.                        >> <<01878>>03940000
                                                               <<01878>>03945000
      IF NOT COMPSTRING(BTPASS,PASS',8) THEN                   <<01878>>03950000
      BEGIN                                                    <<01878>>03955000
         EXCHANGEDB(STACK);                                    <<01878>>03960000
         RELSIR(LOGSIR,A);                                     <<01878>>03965000
         STAT := PASSERR;                                      <<01878>>03970000
         INDEX' := 0D;                                         <<01878>>03975000
         RESETCRITICAL(CRSTATE);                               <<01878>>03980000
         ERROREXIT(INTRINEXIT,0,0);                            <<01878>>03985000
      END;                                                     <<01878>>03990000
                                                               <<01878>>03995000
<< See if there's an entry in the LOGTAB - an active process.>><<01878>>04000000
                                                               <<01878>>04005000
   IF FINDLOG(BTLOGID,TABINDEX) THEN                           <<01878>>04010000
   BEGIN                                                       <<01878>>04015000
      LOGTABINDEX := TABINDEX;                                 <<01878>>04020000
                                                               <<01878>>04025000
      << Get the entry >>                                      <<01878>>04030000
                                                               <<01878>>04035000
      MOVE'FROM'DSEG(@ENTRY',LOGDST,TABINDEX,TENTRYSIZE);      <<01878>>04040000
      IF BENTRY' = "        " THEN                             <<01878>>04045000
      BEGIN                                                    <<01878>>04050000
         RELSIR(LOGSIR,A);                                     <<01878>>04055000
         EXCHANGEDB(STACK);                                    <<01878>>04060000
         STAT := NOLOGPROC;                                    <<01878>>04065000
         INDEX' := 0D;                                         <<01878>>04070000
         RESETCRITICAL(CRSTATE);                               <<01878>>04075000
         ERROREXIT(INTRINEXIT,0,0);                            <<01878>>04080000
      END;                                                     <<01878>>04085000
      TABINDEX := 0;                                           <<01878>>04090000
      IF ENTRY'(STATUS) = RECOVERING OR                        <<01878>>04095000
         ENTRY'(STATUS) = INITIALIZING   THEN                  <<01878>>04100000
      BEGIN                                                    <<01878>>04105000
         RELSIR(LOGSIR,A);                                     <<01878>>04110000
         EXCHANGEDB(STACK);                                    <<01878>>04115000
         STAT := INITLOGPROC;                                  <<*2226>>04120000
         INDEX' := 0D;                                         <<01878>>04125000
         RESETCRITICAL(CRSTATE);                               <<01878>>04130000
         ERROREXIT(INTRINEXIT,0,0);                            <<01878>>04135000
      END;                                                     <<01878>>04140000
                                                               <<01878>>04145000
      << Found in LOGTAB >>                                    <<01878>>04150000
   END                                                         <<01878>>04155000
   ELSE                                                        <<01878>>04160000
   BEGIN                                                       <<01878>>04165000
      << Entry not in LOGTAB >>                                <<01878>>04170000
                                                               <<01878>>04175000
      RELSIR(LOGSIR,A);                                        <<01878>>04180000
      EXCHANGEDB(STACK);                                       <<01878>>04185000
      STAT := NOLOGPROC;                                       <<01878>>04190000
      INDEX' := 0D;                                            <<01878>>04195000
      RESETCRITICAL(CRSTATE);                                  <<01878>>04200000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>04205000
   END;                                                        <<01878>>04210000
                                                               <<01878>>04215000
                                                               <<01878>>04220000
   WHO(,,,CUSER,CGROUP,CACCT);                                 <<01878>>04225000
                                                               <<01878>>04230000
   BUFDST := ENTRY'(DST);   << Get LOGBUFF dst# >>             <<01878>>04235000
                                                               <<01878>>04240000
   EXCHANGEDB(BUFDST);                                         <<01878>>04245000
                                                               <<01878>>04250000
<< Don't allow OPENLOG if the log process is suspended.  >>    <<01878>>04255000
                                                               <<01878>>04260000
      IF LOGBUFF(MSG) = STOP OR LOGBUFF(MSG) = SUSPEND THEN    <<01878>>04265000
      BEGIN                                                    <<01878>>04270000
         RELSIR(LOGSIR,A);                                     <<01878>>04275000
         EXCHANGEDB(STACK);                                    <<01878>>04280000
         STAT:=SUSPENDED;                                      <<01878>>04285000
         INDEX':=0D;                                           <<01878>>04290000
         RESETCRITICAL(CRSTATE);                               <<01878>>04295000
         ERROREXIT(INTRINEXIT,0,0);                            <<01878>>04300000
      END;                                                     <<01878>>04305000
                                                               <<01878>>04310000
   OBTAIN(LOGBUFF(RESOURCE3),NULL);                            <<01884>>04315000
$IF X1=ON                                                      <<01883>>04320000
       WHAT'S'UP ( BC'OBTAIN,3 );                              <<01883>>04330000
$IF                                                            <<01883>>04335000
                                                               <<01878>>04340000
<< We want to first look for a match in the LOGBUFF. Only    >><<01878>>04345000
<< obtain an entry for the first OPENLOG from this user.     >><<01878>>04350000
                                                               <<01878>>04355000
MATCH := FALSE;                                                <<01878>>04360000
INDEX := LOGBUFF(UHEAD);     << Search in-use list >>          <<01878>>04365000
                                                               <<01878>>04370000
WHILE (INDEX <> NULL) AND (NOT MATCH) DO                       <<01878>>04375000
BEGIN                                                          <<01878>>04380000
   IF LOGBUFF(UPIN) = MYPIN AND ILOGBUFF(SCODE) = SCODE' THEN  <<01878>>04385000
      BEGIN         << POSSIBLE MATCH >>                       <<01878>>04390000
        I := 0;                                                <<01878>>04395000
        MATCH' := TRUE;                                        <<01878>>04400000
        WHILE  I <= 7 AND MATCH' DO                            <<01878>>04405000
           BEGIN                                               <<01878>>04410000
           IF BLOGBUFF(USER+I) = CUSER (I) AND                 <<01878>>04415000
              BLOGBUFF(GROUP+I) = CGROUP (I) AND               <<01878>>04420000
              BLOGBUFF(ACCT+I) = CACCT (I)  THEN               <<01878>>04425000
              I :=  I + 1                                      <<01878>>04430000
           ELSE                                                <<01878>>04435000
              MATCH' := FALSE;                                 <<01878>>04440000
           END;                                                <<01878>>04445000
        IF MATCH' THEN                                         <<01878>>04450000
           BEGIN          << FOUND A MATCH >>                  <<01878>>04455000
           LOGBUFF (OPENCNT) := LOGBUFF (OPENCNT) + 1;         <<01878>>04460000
           MATCH := TRUE ;                                     <<01878>>04465000
           ENUM := INDEX;                                      <<01878>>04470000
           END                                                 <<01878>>04475000
        ELSE                                                   <<01878>>04480000
           INDEX := LOGBUFF (NENTRY);                          <<01878>>04485000
     END                                                       <<01878>>04490000
   ELSE                                                        <<01878>>04495000
     INDEX := LOGBUFF (NENTRY);                                <<01878>>04500000
END;                                                           <<01878>>04505000
   EXCHANGEDB(0);     << DB at stack >>                        <<01878>>04510000
                                                               <<01878>>04515000
IF NOT MATCH  THEN                                             <<01878>>04520000
BEGIN                                                          <<01878>>04525000
                                                               <<01878>>04530000
<< Try to get an entry in the Logging Buffer.            >>    <<01878>>04535000
                                                               <<01878>>04540000
   IF NOT GENTRY(INDEX,BUFDST) THEN                            <<01878>>04545000
   BEGIN                                                                04550000
      <<NO MORE ENTRIES>>                                               04555000
      EXCHANGEDB(BUFDST);                                      <<01878>>04560000
      RELEASE(LOGBUFF(RESOURCE3),NULL,1);                      <<01884>>04565000
$IF X1=ON                                                      <<01883>>04570000
       WHAT'S'UP (BC'RELEASE,3 );                              <<01883>>04580000
$IF                                                            <<01883>>04585000
      EXCHANGEDB(STACK);                                       <<01878>>04590000
      STAT:=NOLOGENTRIES;                                               04595000
      INDEX':=0D;                                                       04600000
      RELSIR(LOGSIR,A);                                        <<01878>>04605000
      RESETCRITICAL(CRSTATE);                                  <<01878>>04610000
      ERROREXIT(INTRINEXIT,0,0);                                        04615000
   END;                                                                 04620000
   EXCHANGEDB(BUFDST);                                         <<01884>>04621000
   RELEASE(LOGBUFF(RESOURCE3),NULL,1);                         <<01884>>04625000
$IF X1=ON                                                               04625100
       WHAT'S'UP(BC'RELEASE, 3 );                                       04625200
$IF                                                                     04625300
   EXCHANGEDB(0);                                              <<01884>>04626000
   RELSIR(LOGSIR,A);                                           <<01878>>04630000
                                                               <<01878>>04635000
<< Get ready to set logging bit in PXFIXED.              >>    <<01878>>04640000
                                                               <<01878>>04645000
   PUSH(DL);                                                            04650000
   ASSEMBLE(DUP);                                                       04655000
   TOS:=TOS-2;                                                          04660000
   TOS:=S0';                                                            04665000
   ASSEMBLE(XCH,DEL,SUB);                                               04670000
   @PXFIXED:=TOS;                                                       04675000
   PXFXLOGGING:=1;                                             <<01878>>04680000
                                                               <<01878>>04685000
<< Initialize the entry.   >>                                  <<01878>>04690000
                                                               <<01878>>04695000
   ENTRY' := "  ";                                             <<01878>>04700000
   MOVE ENTRY'(1):=ENTRY',(BENTRYSIZE-1);                               04705000
   ENUM:=INDEX;                                                         04710000
   INDEX:=0;                                                            04715000
   MOVE BENTRY'(USER) := CUSER, (8);                           <<01878>>04720000
   MOVE BENTRY'(GROUP) := CGROUP, (8);                         <<01878>>04725000
   MOVE BENTRY'(ACCT) := CACCT, (8);                           <<01878>>04730000
                                                               <<01878>>04735000
   DENTRY'(RECS):=0D;                                                   04740000
   ENTRY'(WSTATE):=ACT;                                                 04745000
   ENTRY'(SCODE) := SCODE';                                    <<01878>>04750000
   ENTRY'(UPIN) := MYPIN;                                      <<01878>>04755000
   MOVE'FROM'DSEG(@ENTRY'(LGNUM),BUFDST,USERNO,1);             <<01878>>04760000
   ENTRY'(LGNUM):=ENTRY'(LGNUM)+1;                                      04765000
   MOVE'TO'DSEG(BUFDST,USERNO,@ENTRY'(LGNUM),1);               <<01878>>04770000
   ENTRY'(ERROR):=0;                                                    04775000
   ENTRY'(OPENCNT) := 1;                                       <<01878>>04780000
                                                                        04785000
                                                               <<01878>>04790000
   <<NOW WRITE ENTRY TO LOGBUFF>>                                       04795000
                                                                        04800000
   MOVE'TO'DSEG(BUFDST,ENUM,@ENTRY',BENTRYSIZE-2);             <<01878>>04805000
   INDEX:=ENUM;                                                         04810000
END     << No match -- create a new entry >>                   <<01878>>04815000
ELSE                                                           <<01884>>04820000
   BEGIN                                                       <<01884>>04825000
   <<NOW PREPARE A LOG OPEN RECORD>>                                    04830000
   EXCHANGEDB ( BUFDST );                                      <<01884>>04835000
   RELEASE(LOGBUFF(RESOURCE3),NULL,1);                         <<01884>>04840000
$IF X1=ON                                                               04840100
       WHAT'S'UP(BC'RELEASE,3);                                         04840200
$IF                                                                     04840300
   EXCHANGEDB(0);                                              <<01884>>04841000
   RELSIR(LOGSIR,A);                                           <<01884>>04842000
   END;                                                        <<01884>>04843000
EXCHANGEDB(BUFDST);                                            <<01884>>04862000
OBTAIN(LOGBUFF(RESOURCE1),NULL);                               <<01884>>04865000
$IF X1=ON                                                      <<01883>>04870000
       WHAT'S'UP ( BC'OBTAIN,1 );                              <<01883>>04880000
$IF                                                            <<01883>>04885000
   CHECKMESSAGE;                                                        04890000
   IF LOGBUFF(BSPACE) <= 0 AND DLOGBUFF(FSPACE') <             <<01878>>04895000
   DOUBLE(BLKFACTOR) AND NOWAIT THEN                           <<01878>>04900000
   BEGIN                                                                04905000
      LOGBUFF(OPENCNT) := LOGBUFF(OPENCNT) - 1;                <<01878>>04910000
      IF LOGBUFF(OPENCNT) = 0  THEN                            <<01878>>04915000
      BEGIN                                                    <<01878>>04920000
         EXCHANGEDB(0);                                        <<01878>>04925000
         RELENTRY(ENUM,BUFDST);  << No other users-release it>><<01878>>04930000
         EXCHANGEDB(BUFDST);                                   <<01878>>04935000
      END;                                                     <<01878>>04940000
      EXCHANGEDB(STACK);                                       <<*2537>>04941000
      EXCHANGEDB(BUFDST);                                      <<*2537>>04942000
      PDISABLE;                                                <<*2537>>04943000
                                                               <<01878>>04945000
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>04950000
$IF X1=ON                                                      <<01883>>04955000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>04965000
$IF                                                            <<01883>>04970000
      EXCHANGEDB(STACK);                                       <<01878>>04975000
      PENABLE;                                                 <<*2537>>04976000
                                                               <<01878>>04980000
      STAT := NWAITERR;                                        <<01878>>04985000
      RESETCRITICAL(CRSTATE);                                  <<01878>>04990000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>04995000
   END;                                                                 05000000
                                                               <<01878>>05005000
   FORIT:                                                      <<01878>>05010000
                                                               <<01878>>05015000
   IF LOGBUFF(LOGTYPE) = DISC THEN                             <<01878>>05020000
   BEGIN                                                                05025000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<01878>>05030000
      BEGIN                                                    <<01878>>05035000
         FLUSH(ENUM,FALSE);                                    <<01878>>05040000
         CHECKMESSAGE;                                         <<01878>>05045000
      END;                                                     <<01878>>05050000
   END;                                                                 05055000
                                                               <<01878>>05060000
   IF LOGBUFF(BSPACE) >= 1 THEN                                         05065000
   BEGIN                                                                05070000
      @BUF:=BUFBASE+(LOGBUFF(BUFUSED))*RECSIZE;                <<01878>>05075000
      @BBUF:=2*@BUF;                                                    05080000
      @DBUF:=@BUF;                                                      05085000
      INDEX:=ENUM;                                                      05090000
      MOVE BBUF(LID'):=BLOGBUFF(LOGID),(8);                    <<01878>>05095000
      DBUF(RNUM):=DLOGBUFF(TRECS):=DLOGBUFF(TRECS)+1D;                  05100000
      BUF(CODE):=OPEN;                                                  05105000
      BUF(CODE).(0:8):=LOGBUFF(SCODE).(0:8);                            05110000
                                                                        05115000
      DBUF(TIME):=CLOCK;                                                05120000
      BUF(DATE):=CALENDAR;                                              05125000
      BUF(LNUM):=LOGBUFF(LGNUM);                                        05130000
      MOVE BBUF(CREATOR):=BLOGBUFF(USER),(24);                          05135000
       BUF(LPIN) := MYPIN;                                     <<01878>>05140000
      X:=RECSIZEM1;                                            <<01878>>05145000
      TOS:=-1;                                                          05150000
      DO                                                                05155000
      BEGIN                                                             05160000
         IF X <> CKSUM THEN                                             05165000
         TOS:=TOS XOR BUF(X);                                           05170000
      END UNTIL (X:=X-1) < 0;                                           05175000
      BUF(CKSUM):=TOS;                                                  05180000
      LOGBUFF(BSPACE):=LOGBUFF(BSPACE)-1;                               05185000
      LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                <<01878>>05190000
   END                                                                  05195000
   ELSE                                                                 05200000
   BEGIN                                                                05205000
      FLUSH(ENUM,FALSE);                                       <<01878>>05210000
      CHECKMESSAGE;                                            <<01878>>05215000
      GO FORIT;                                                         05220000
   END;                                                                 05225000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>05230000
$IF X1=ON                                                               05230200
   WHAT'S'UP ( BC'RELEASE );                                            05230300
$IF                                                                     05230400
   RELEASE(LOGBUFF(RESOURCE1),NULL,1);                         <<01884>>05231000
$IF X1=ON                                                      <<01883>>05235000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>05245000
$IF                                                            <<01883>>05250000
   EXCHANGEDB(STACK);                                          <<01878>>05255000
   STAT:=0;                                                             05260000
   INDEX1(1) := LOGTABINDEX;                                   <<01878>>05265000
   INDEX1:=ENUM;                                                        05270000
   RESETCRITICAL(CRSTATE);                                     <<01878>>05275000
   ERROREXIT(INTRINEXIT,0,0);                                           05280000
END;                                                                    05285000
                                                                        05290000
$PAGE   "LOGGING INTRINSICS  --  WRITELOG"                              05295000
                                                                        05300000
PROCEDURE WRITELOG(INDEX',DATA,LEN,MODE,STAT);                 <<01878>>05305000
DOUBLE INDEX';                                                          05310000
INTEGER MODE,LEN,STAT;                                         <<01878>>05315000
LOGICAL ARRAY DATA;                                                     05320000
OPTION PRIVILEGED;                                                      05325000
                                                                        05330000
COMMENT                                                        <<01878>>05335000
 Intrinsic to write physical records to the logging file.      <<01878>>05340000
                                                               <<01878>>05345000
Will try to output the record(s) to the buffer area of the     <<01878>>05350000
Logging Buffer. If the buffer area is full, will flush it to   <<01878>>05355000
the disc logging file or to the disc buffer file (via call to  <<01878>>05360000
FLUSH).                                                        <<01878>>05365000
                                                               <<01878>>05370000
BEGINLOG,ENDLOG - will do as above but will force the new      <<01878>>05375000
records (and the buffer area) to be flushed to disc.           <<01878>>05380000
PARAMETERS:                                                    <<01878>>05385000
                                                               <<01878>>05390000
 INDEX' - Originally from OPENLOG, identifies user's access    <<01878>>05395000
          to logging file.                                     <<01878>>05400000
 DATA   - Array supplied by user, containing the information   <<01878>>05405000
         to be logged.                                         <<01878>>05410000
 LEN'   - Length of array DATA. Positive count = # words,      <<01878>>05415000
         negative count = # bytes. (If > 119 words, info will  <<01878>>05420000
         be divided into more than one physical record).       <<01878>>05425000
 MODE   - Wait = 0, No wait = 1, Write and flush = 2.          <<01878>>05430000
 STAT   - Status info returned to user.                        <<01878>>05435000
;                                                              <<01878>>05440000
                                                               <<01878>>05445000
BEGIN                                                                   05450000
   ENTRY BEGINLOG,ENDLOG;                                      <<01878>>05455000
                                                               <<01878>>05460000
                                                               <<01878>>05465000
   INTEGER LENGTH;                                             <<01878>>05470000
   INTEGER S0 = S-0;                                                    05475000
   INTEGER INDEX;                                              <<01878>>05480000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    05485000
   INTEGER X = X;                                                       05490000
   INTEGER QLEN,RECSOUT,TRECSOUT;                                       05495000
   INTEGER RLEN;   <<RECORD LENGTH>>                           <<01878>>05500000
                                                               <<01878>>05505000
   INTEGER ENUM;                                               <<01878>>05510000
   LOGICAL NOWAIT,CRSTATE;                                     <<01878>>05515000
   LOGICAL POINTER BUF;                                                 05520000
   DOUBLE POINTER DBUF;                                                 05525000
   BYTE POINTER BBUF;                                                   05530000
                                                                        05535000
   INTEGER ORIGINAL'DB;                                        <<01878>>05540000
   INTEGER BUFDST;                                                      05545000
   DOUBLE PARMS;                                                        05550000
   LOGICAL PARMS1 = PARMS;                                              05555000
   LOGICAL PARMS2 = PARMS + 1;                                          05560000
   LOGICAL BEGIN'TRAN,END'TRAN;                                <<01878>>05565000
   LOGICAL FLUSH'FLAG;                                         <<01878>>05570000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<01878>>05575000
   BYTE ARRAY BENTRY'(*) = ENTRY';                             <<01878>>05580000
   BYTE ARRAY CNAME(0:8) = Q;                                  <<01878>>05585000
   BYTE ARRAY CGROUP(0:8) = Q;                                 <<01878>>05590000
   BYTE ARRAY CACCT(0:8) = Q;                                  <<01878>>05595000
                                                                        05600000
   DEFINE INTRINEXIT = [10/211,6/5]#,                                   05605000
   FLAG  = [1/1,8/0,7/5]#;                                              05610000
                                                                        05615000
                                                                        05620000
                                                                        05625000
                                                                        05630000
SUBROUTINE CHECKMESSAGE;                                                05635000
BEGIN                                                                   05640000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<01878>>05645000
   BEGIN                                                                05650000
      TOS:=LOGBUFF(LOGMSG);                                    <<01878>>05655000
      RELEASE(LOGBUFF(RESOURCE2),NULL,1);                      <<01884>>05660000
$IF X1=ON                                                               05660200
      WHAT'S'UP ( BC'RELEASE,2 );                                       05660300
$IF                                                                     05660400
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>05661000
$IF X1=ON                                                      <<01883>>05665000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>05675000
$IF                                                            <<01883>>05680000
      << Set DB back to original DB, was set to Buffer DST. >> <<01878>>05685000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>05690000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                05695000
      RESETCRITICAL(CRSTATE);                                  <<01878>>05700000
      ERROREXIT(INTRINEXIT,0,0);                                        05705000
   END;                                                                 05710000
END;                                                                    05715000
                                                                        05720000
SUBROUTINE OUTPUTRECORD;                                       <<01878>>05725000
                                                               <<01878>>05730000
<<*********************************************************>>  <<01878>>05735000
<< Outputs a Log Record to the buffer area of the Logging  >>  <<01878>>05740000
<< buffer. DB at entry is set to the Logging Buffer.  It   >>  <<01878>>05745000
<< is set to DB upon entry (users buffer DST) for the move >>  <<01878>>05750000
<< to the Logging Buffer from the users buffer. DB is then >>  <<01878>>05755000
<< set back to the Logging Buffer DST.                     >>  <<01878>>05760000
<<*********************************************************>>  <<01878>>05765000
                                                               <<01878>>05770000
                                                               <<01878>>05775000
BEGIN                                                          <<01878>>05780000
   @BUF := BUFBASE + LOGBUFF(BUFUSED)*RECSIZE;                 <<01878>>05785000
   @DBUF := @BUF;                                              <<01878>>05790000
   @BBUF := 2 * @BUF;                                          <<01878>>05795000
   DBUF(RNUM) := DLOGBUFF(TRECS) := DLOGBUFF(TRECS) + 1D;      <<01878>>05800000
                                                               <<01878>>05805000
   IF RECSOUT > 0 THEN BUF(CODE) := CONT   <<Continuation rec>><<01878>>05810000
     ELSE                                                      <<01878>>05815000
       IF BEGIN'TRAN THEN BUF(CODE) := TRAN'BEGIN              <<01878>>05820000
         ELSE                                                  <<01878>>05825000
           IF END'TRAN THEN BUF(CODE) := TRAN'END              <<01878>>05830000
             ELSE BUF(CODE) := USER'SUB;                       <<01878>>05835000
   BUF(CODE).(0:8) := LOGBUFF(SCODE).(0:8);                    <<01878>>05840000
   BUF(DATE) := CALENDAR;                                      <<01878>>05845000
   DBUF(TIME) := CLOCK;                                        <<01878>>05850000
   BUF(LNUM') := LOGBUFF(LGNUM);                               <<01878>>05855000
   BUF(LEN') := RLEN;                                          <<01878>>05860000
   << DB is set from the Logging Buffer to the original DB. >> <<01878>>05865000
   EXCHANGEDB(ORIGINAL'DB);                                    <<01878>>05870000
                                                               <<01878>>05875000
   << Move data into buffer >>                                 <<01878>>05880000
   IF QLEN - RECSOUT * DATAREA > DATAREA                       <<01878>>05885000
       THEN LENGTH := DATAREA                                  <<01878>>05890000
     ELSE LENGTH := QLEN - RECSOUT * DATAREA;                  <<01878>>05895000
                                                               <<01878>>05900000
   MOVE'TO'DSEG(BUFDST,@BUF(UAREA),@DATA+RECSOUT*DATAREA,      <<01878>>05905000
                LENGTH);                                       <<01878>>05910000
   << Now set DB back to the Logging Buffer DST.            >> <<01878>>05915000
   EXCHANGEDB(BUFDST);                                         <<01878>>05920000
                                                               <<01878>>05925000
   << Compute checksum >>                                      <<01878>>05930000
   X := RECSIZEM1;                                             <<01878>>05935000
   TOS := -1;                                                  <<01878>>05940000
   DO BEGIN                                                    <<01878>>05945000
       IF X <> CKSUM  THEN                                     <<01878>>05950000
         TOS := TOS XOR BUF(X);                                <<01878>>05955000
   END UNTIL (X := X-1) < 0;                                   <<01878>>05960000
   BUF(CKSUM) := TOS;                                          <<01878>>05965000
   LOGBUFF(BSPACE) := LOGBUFF(BSPACE) - 1;                     <<01878>>05970000
   LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                   <<01878>>05975000
   RECSOUT := RECSOUT + 1;                                     <<01878>>05980000
END;               <<Subroutine OUTPUTRECORD>>                 <<01878>>05985000
                                                               <<01878>>05990000
                                                                        05995000
                                                               <<01878>>06000000
   BEGIN'TRAN:=END'TRAN:=FALSE;                                <<01878>>06005000
   GO OVER;                                                    <<01878>>06010000
                                                               <<01878>>06015000
BEGINLOG:                                                      <<01878>>06020000
   BEGIN'TRAN:=TRUE;                                           <<01878>>06025000
   END'TRAN := FALSE;                                          <<01878>>06030000
   GO OVER;                                                    <<01878>>06035000
                                                               <<01878>>06040000
ENDLOG:                                                        <<01878>>06045000
   END'TRAN:=TRUE;                                             <<01878>>06050000
   BEGIN'TRAN := FALSE;                                        <<01878>>06055000
                                                               <<01878>>06060000
OVER:                                                          <<01878>>06065000
   ERRORON;                                                             06070000
   IF (MODE <> 0) AND (MODE <> 1) AND (MODE <> 2) THEN         <<01878>>06075000
   BEGIN                                                                06080000
      STAT:=MODEERR;                                                    06085000
                                                               <<01878>>06090000
      ERROREXIT(INTRINEXIT,0,0);                                        06095000
   END;                                                                 06100000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    06105000
   IF MODE = 2 THEN FLUSH'FLAG:=TRUE ELSE FLUSH'FLAG:=FALSE;   <<01878>>06110000
   PARMS1:=0; PARMS2:=[8/2,2/2,2/2,2/2,2/2];                            06115000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                                    06120000
   RLEN:=LEN;                                                 <<<01878>>06125000
   IF LEN < 0 THEN                                             <<01878>>06130000
   <<Convert to a word count.>>                                <<01878>>06135000
   BEGIN                                                       <<01878>>06140000
      TOS:=LEN;                                                <<01878>>06145000
      TOS:=2;                                                  <<01878>>06150000
      ASSEMBLE(DIV);                                           <<01878>>06155000
      IF TOS <> 0 THEN                                         <<01878>>06160000
      QLEN:=-(LEN/2)+1                                         <<01878>>06165000
      ELSE QLEN:=-(LEN/2);                                     <<01878>>06170000
      ASSEMBLE(DEL);                                                    06175000
   END                                                         <<01878>>06180000
   ELSE QLEN:=LEN;                                            <<<01878>>06185000
   IF @DATA+(QLEN-1) > S0 THEN                                 <<01878>>06190000
   BEGIN                                                                06195000
      STAT:=BOUNDSERR;                                                  06200000
                                                               <<01878>>06205000
      ERROREXIT(INTRINEXIT,0,0);                                        06210000
   END;                                                                 06215000
                                                               <<01878>>06220000
   BUFDST := INDEX1(1);                                        <<01878>>06225000
   ENUM := INDEX1;                                             <<01878>>06230000
                                                               <<01878>>06235000
   ORIGINAL'DB  := EXCHANGEDB(0);<< Set DB to stack.        >> <<01878>>06240000
                                                               <<01878>>06245000
   << Make sure we have the proper capability >>               <<01878>>06250000
                                                               <<01878>>06255000
   IF NOT OKAY'UCAP THEN                                       <<01878>>06260000
   BEGIN                                                       <<01878>>06265000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>06270000
      STAT := ILLEGALCAP;                                      <<01878>>06275000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>06280000
   END;                                                        <<01878>>06285000
                                                               <<01878>>06290000
   << Verify the validity of the INDEX parameter. >>           <<01878>>06295000
                                                               <<01878>>06300000
   CRSTATE := SETCRITICAL;                                     <<01878>>06305000
                                                               <<01878>>06310000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<01878>>06315000
   BEGIN               << Bad DST or bad entry offset >>       <<01878>>06320000
      EXCHANGEDB(ORIGINAL'DB);   << Back to entry condition >> <<01878>>06325000
      RESETCRITICAL(CRSTATE);                                  <<01878>>06330000
      STAT := INDEXERR;                                        <<01878>>06335000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>06340000
   END;                                                        <<01878>>06345000
    INDEX := 0;                                                <<01878>>06350000
   WHO(,,,CNAME,CGROUP,CACCT);                                 <<01878>>06355000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<01878>>06360000
   IF BENTRY' = "        "  THEN                               <<01878>>06365000
   BEGIN                                                       <<01878>>06370000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>06375000
      RESETCRITICAL(CRSTATE);                                  <<01878>>06380000
      STAT:=INDEXERR;                                          <<01878>>06385000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>06390000
   END;                                                        <<01878>>06395000
   IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <> CACCT,(8) <<01878>>06400000
      OR BENTRY'(GROUP) <> CGROUP,(8) OR                       <<01878>>06405000
      ENTRY'(UPIN) <> MYPIN     THEN                           <<01878>>06410000
   BEGIN                                                       <<01878>>06415000
      <<ILLEGAL CALL>>                                         <<01878>>06420000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>06425000
      RESETCRITICAL(CRSTATE);                                  <<01878>>06430000
      STAT:=SECVIOL;                                           <<01878>>06435000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>06440000
   END;                                                        <<01878>>06445000
   INDEX := ENUM;                                              <<01878>>06450000
   RECSOUT:=0;                                                          06455000
   TRECSOUT:=IF QLEN MOD DATAREA = 0  THEN QLEN/DATAREA        <<01878>>06460000
              ELSE QLEN/DATAREA+1;                             <<01878>>06465000
   << DB from STACK to Logging Buffer DST.                  >> <<01878>>06470000
   EXCHANGEDB(BUFDST);                                         <<01878>>06475000
   CHECKMESSAGE;                                                        06480000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<01878>>06485000
   BEGIN                                                                06490000
      <<CHECK FOR SPACE>>                                               06495000
      OBTAIN(LOGBUFF(RESOURCE1),NULL);                         <<01884>>06500000
$IF X1=ON                                                      <<01883>>06505000
       WHAT'S'UP ( BC'OBTAIN,1 );                              <<01883>>06515000
$IF                                                            <<01883>>06520000
                                                                        06525000
      IF ILOGBUFF(BSPACE) < TRECSOUT AND NOWAIT THEN                    06530000
      IF DLOGBUFF(FSPACE') < DOUBLE(TRECSOUT) THEN             <<01878>>06535000
      BEGIN                                                             06540000
         <<NO ROOM IN BUFFER OR DISC>>                                  06545000
         LOGBUFF(ERROR):=-1;                                            06550000
         RELEASE(LOGBUFF(RESOURCE1),NULL,1);                   <<01884>>06555000
$IF X1=ON                                                      <<01883>>06560000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>06570000
$IF                                                            <<01883>>06575000
         EXCHANGEDB(ORIGINAL'DB);                              <<01878>>06580000
         STAT:=NWAITERR;                              <<TEMP>>          06585000
         RESETCRITICAL(CRSTATE);                               <<01878>>06590000
         ERROREXIT(INTRINEXIT,0,0);                                     06595000
      END;                                                              06600000
                                                                        06605000
      DO                                                                06610000
      BEGIN                                                             06615000
         IF LOGBUFF(BSPACE) >= 1 THEN OUTPUTRECORD             <<01878>>06620000
         ELSE                                                           06625000
         BEGIN                               <<WRITE TO DISC>>          06630000
               FLUSH(ENUM,FLUSH'FLAG);                         <<01878>>06635000
               CHECKMESSAGE;                                   <<01878>>06640000
         END;                                                           06645000
      END UNTIL RECSOUT >= TRECSOUT;                                    06650000
      IF BEGIN'TRAN OR END'TRAN OR FLUSH'FLAG                  <<01878>>06655000
         THEN FLUSH(ENUM,FLUSH'FLAG);                          <<01878>>06660000
      CHECKMESSAGE;                                            <<01878>>06665000
      RELEASE(LOGBUFF(RESOURCE2),NULL,1);                      <<01884>>06670000
$IF X1=ON                                                               06670200
      WHAT'S'UP ( BC'RELEASE,2 );                                       06670300
$IF                                                                     06670400
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>06671000
$IF X1=ON                                                      <<01883>>06675000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>06685000
$IF                                                            <<01883>>06690000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>06695000
      STAT:=0;                                                          06700000
      <<End tape logging>>                                     <<01878>>06705000
   END                                                                  06710000
   ELSE                                                                 06715000
   BEGIN                                      <<DISC LOGGING>>          06720000
      OBTAIN(LOGBUFF(RESOURCE1),NULL);                         <<01884>>06725000
$IF X1=ON                                                      <<01883>>06730000
       WHAT'S'UP ( BC'OBTAIN,1 );                              <<01883>>06740000
$IF                                                            <<01883>>06745000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<01878>>06750000
      BEGIN                                                    <<01878>>06755000
         FLUSH(ENUM,FLUSH'FLAG);                               <<01878>>06760000
         CHECKMESSAGE;                                         <<01878>>06765000
      END;                                                     <<01878>>06770000
      DO                                                                06775000
      BEGIN                                                             06780000
         IF LOGBUFF(BSPACE) >= 1 THEN                                   06785000
         BEGIN                                                          06790000
            OUTPUTRECORD;                                      <<01878>>06795000
            IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))   <<01878>>06800000
            THEN                                               <<01878>>06805000
            BEGIN                                              <<01878>>06810000
               FLUSH(ENUM,FLUSH'FLAG);                         <<01878>>06815000
               CHECKMESSAGE;                                   <<01878>>06820000
            END;                                               <<01878>>06825000
         END                                                            06830000
         ELSE                                                           06835000
         BEGIN                                                          06840000
            FLUSH(ENUM,FLUSH'FLAG);                            <<01878>>06845000
            CHECKMESSAGE;                                      <<01878>>06850000
         END;                                                           06855000
      END UNTIL RECSOUT >= TRECSOUT;                                    06860000
      IF BEGIN'TRAN OR END'TRAN OR FLUSH'FLAG                  <<01878>>06865000
         THEN FLUSH(ENUM,FLUSH'FLAG);                          <<01878>>06870000
      CHECKMESSAGE;                                            <<01878>>06875000
      RELEASE(LOGBUFF(RESOURCE2),NULL,1);                      <<01884>>06880000
$IF X1=ON                                                               06880200
      WHAT'S'UP ( BC'RELEASE,2 );                                       06880300
$IF                                                                     06880400
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>06881000
$IF X1=ON                                                      <<01883>>06885000
       WHAT'S'UP ( BC'RELEASE );                               <<01883>>06895000
$IF                                                            <<01883>>06900000
      EXCHANGEDB(ORIGINAL'DB);                                 <<01878>>06905000
      STAT:=0;                                                          06910000
   END;                                                                 06915000
   RESETCRITICAL(CRSTATE);                                     <<01878>>06920000
   ERROREXIT(INTRINEXIT,0,0);                                           06925000
END;                                                                    06930000
$PAGE    "LOGGING INTRINSICS  --  LOGSTATUS"                   <<01878>>06935000
PROCEDURE LOGSTATUS(ENTRY'INDEX,LOGINFO'ARRAY,STATUS');        <<01878>>06940000
DOUBLE ENTRY'INDEX;                                            <<01878>>06945000
INTEGER STATUS';                                               <<01878>>06950000
LOGICAL ARRAY LOGINFO'ARRAY;                                   <<01878>>06955000
OPTION PRIVILEGED;                                             <<01878>>06960000
BEGIN                                                          <<01878>>06965000
                                                               <<01878>>06970000
                                                               <<01878>>06975000
COMMENT                                                        <<01878>>06980000
 Intrinsic to interrogate a logging system for information     <<01878>>06985000
 pertaining to size of the logfile, space remaining in the     <<01878>>06990000
 logfile, and the number of users who have opened the logfile. <<01878>>06995000
 This information is obtained from the communications area of  <<01878>>07000000
 the memory logging buffer and passes it to the user.          <<01878>>07005000
                                                               <<01878>>07010000
PARAMETERS:                                                    <<01878>>07015000
                                                               <<01878>>07020000
 ENTRY'INDEX - Supplied by the user. (Originally obtained from <<01878>>07025000
               intrinsic OPENLOG).                             <<01878>>07030000
 LOGINFO'ARRAY - Formatted array returned to the user          <<01878>>07035000
                 containing:                                   <<01878>>07040000
              Word 0,1 : total records written to the log file.<<01878>>07045000
              Word 2,3 : size of logfile.                      <<01878>>07050000
              Word 4,5 : space remaining in the logfile.       <<01878>>07055000
              Word 6   : number of users using the logfile.    <<01878>>07060000
 STATUS'    - Status information returned to the user.         <<01878>>07065000
              (0 = all O.K.)                                   <<01878>>07070000
;                                                              <<01878>>07075000
                                                               <<01878>>07080000
                                                               <<01878>>07085000
                                                               <<01878>>07090000
   DOUBLE ARRAY DLOGINFO'ARRAY(*) = LOGINFO'ARRAY;             <<01878>>07095000
   LOGICAL ARRAY INDEX'(*) = ENTRY'INDEX;                      <<01878>>07100000
   INTEGER  STACK;                                             <<01878>>07105000
   LOGICAL BUFDST,ENUM;                                        <<01878>>07110000
   LOGICAL ARRAY ENTRY'(0:BENTRYSIZE-1) = Q;                   <<01878>>07115000
   BYTE ARRAY BENTRY'(*) = ENTRY';                             <<01878>>07120000
   INTEGER DB,CRSTATE;                                         <<01878>>07125000
   INTEGER INDEX,TABINDEX;                                     <<01878>>07130000
   DOUBLE PARMS, BOUNDS;                                       <<01878>>07135000
                                                               <<01878>>07140000
   LOGICAL                                                     <<01878>>07145000
      LOWER'BOUND = BOUNDS,                                    <<01880>>07150000
      UPPER'BOUND = BOUNDS + 1;                                <<01880>>07155000
                                                               <<01878>>07160000
   LOGICAL PARMS1 = PARMS;                                     <<01878>>07165000
   LOGICAL PARMS2 = PARMS + 1;                                 <<01878>>07170000
   DOUBLE QRECS,QFSIZE,QFSPACE;                                <<01878>>07175000
   INTEGER QUSERS;                                             <<01878>>07180000
   BYTE ARRAY CNAME(0:8) = Q;                                  <<01878>>07185000
   BYTE ARRAY CGROUP(0:8) = Q;                                 <<01878>>07190000
   BYTE ARRAY CACCT(0:8) = Q;                                  <<01878>>07195000
   DEFINE INTRINEXIT = [10/214,6/3]#,                          <<01878>>07200000
   FLAG = [1/1,8/0,7/3]#;                                      <<01878>>07205000
                                                               <<01878>>07210000
   EQUATE                                                      <<01878>>07215000
   REC   =   0,                                                <<01878>>07220000
   SIZE   =   1,                                               <<01878>>07225000
   SPACE   =   2,                                              <<01878>>07230000
   USERS   =   6;                                              <<01878>>07235000
                                                               <<01878>>07240000
   ERRORON;                                                    <<01878>>07245000
   PARMS1:=0;                                                  <<01878>>07250000
   PARMS2:=[8/0,2/0,2/2,2/2,2/2];                              <<01878>>07255000
   BOUNDS := CHEK(INTRINEXIT,FLAG,PARMS);                      <<01878>>07260000
                                                               <<01878>>07265000
   IF LOGICAL (@LOGINFO'ARRAY + 6) > UPPER'BOUND THEN          <<01878>>07270000
      BEGIN                                                    <<01878>>07275000
      STATUS' := BOUNDSERR;                                    <<01878>>07280000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>07285000
      END;                                                     <<01878>>07290000
                                                               <<01878>>07295000
   LOGINFO(ENTRY'INDEX,STATUS',1,DLOGINFO'ARRAY,2,           <<*LOG2>>  07300000
           DLOGINFO'ARRAY(1),3,DLOGINFO'ARRAY(2),4,            <<01878>>07305000
           LOGINFO'ARRAY(6));                                  <<01878>>07310000
   ERROREXIT(INTRINEXIT,0,0);                                  <<01878>>07315000
END;                                                           <<01878>>07320000
$PAGE   "LOGGING INTRINSICS  --  CLOSELOG"                              07325000
                                                                        07330000
PROCEDURE CLOSELOG(INDEX',MODE,STAT);                                   07335000
DOUBLE INDEX';                                                          07340000
INTEGER STAT,MODE;                                                      07345000
OPTION PRIVILEGED;                                                      07350000
                                                               <<01878>>07355000
COMMENT                                                        <<01878>>07360000
  Intrinsic to close access to a User Logging file.            <<01878>>07365000
Will output a close record to the buffer area of the Logging   <<01878>>07370000
Buffer. (Calls FLUSH if no room). Releases the entry in the    <<01878>>07375000
Logging Buffer for this user.                                  <<01878>>07380000
                                                               <<01878>>07385000
Will only release the entry in the LOGBUFF iff this is the     <<01878>>07390000
last CLOSELOG (i.e. openlog count = 0) for this user.          <<01878>>07395000
                                                               <<01878>>07400000
PARAMETERS:                                                    <<01878>>07405000
                                                               <<01878>>07410000
 INDEX' - Originally from OPENLOG, identifies the user's       <<01878>>07415000
         access to the logging file.                           <<01878>>07420000
 MODE   - 0 = wait,  1 = no wait.                              <<01878>>07425000
 STAT   - Status information returned to user.                 <<01878>>07430000
                                                               <<01878>>07435000
;                                                              <<01878>>07440000
BEGIN                                                                   07445000
                                                               <<01878>>07450000
   BYTE ARRAY CNAME(0:8) = Q;                                           07455000
   BYTE ARRAY CGROUP(0:8) = Q;                                          07460000
   BYTE ARRAY CACCT(0:8) = Q;                                           07465000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<01878>>07470000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      07475000
                                                                        07480000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    07485000
   INTEGER INDEX;                                              <<01878>>07490000
LOGICAL NOWAIT,CRSTATE;                                        <<01878>>07495000
   INTEGER DB;                                                 <<01878>>07500000
   DOUBLE PARMS;                                                        07505000
   LOGICAL PARMS1 = PARMS;                                              07510000
   LOGICAL PARMS2 = PARMS + 1;                                          07515000
                                                                        07520000
   DEFINE INTRINEXIT = [10/212,6/3]#,                                   07525000
   FLAG  = [1/1,8/0,7/3]#;                                              07530000
                                                                        07535000
   LOGICAL POINTER BUF;                                        <<01878>>07540000
   DOUBLE POINTER DBUF;                                                 07545000
   BYTE POINTER BBUF;                                                   07550000
   INTEGER X = X;                                                       07555000
   INTEGER BUFDST;                                                      07560000
   INTEGER STACK,ENUM;                                                  07565000
                                                                        07570000
                                                                        07575000
                                                                        07580000
                                                                        07585000
SUBROUTINE CHECKMESSAGE;                                                07590000
BEGIN                                                                   07595000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<01878>>07600000
   BEGIN                                                                07605000
      TOS:=LOGBUFF(LOGMSG);                                    <<01878>>07610000
      RELEASE(LOGBUFF(RESOURCE2),NULL,1);                      <<01884>>07615000
$IF X1=ON                                                               07615200
      WHAT'S'UP ( BC'RELEASE,2 );                                       07615300
$IF                                                                     07615400
      RELEASE(LOGBUFF(RESOURCE1),NULL,1);                      <<01884>>07616000
$IF X1=ON                                                      <<01883>>07620000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>07630000
$IF                                                            <<01883>>07635000
      DB:=EXCHANGEDB(STACK);                                   <<01878>>07640000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                07645000
      RESETCRITICAL(CRSTATE);                                  <<01878>>07650000
      ERROREXIT(INTRINEXIT,0,0);                                        07655000
   END;                                                                 07660000
END;                                                                    07665000
                                                                        07670000
                                                                        07675000
                                                                        07680000
   ERRORON;                                                             07685000
                                                               <<01878>>07690000
   PARMS1:=0;                                                           07695000
   PARMS2:=[8/0,2/0,2/2,2/2,2/2];                                       07700000
   IF (MODE <> 0) AND (MODE <> 1) THEN                                  07705000
   BEGIN                                                                07710000
      STAT:=MODEERR;                                                    07715000
                                                               <<01878>>07720000
      ERROREXIT(INTRINEXIT,0,0);                                        07725000
   END;                                                                 07730000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                                    07735000
   IF CARRY THEN                                                        07740000
   BEGIN                                                                07745000
      <<NOT POINTING AT STACK>>                                         07750000
      BUFDST:=INDEX1(1);                                                07755000
      ENUM:=INDEX1;                                                     07760000
      STACK:=EXCHANGEDB(0);                                             07765000
   END                                                                  07770000
   ELSE                                                                 07775000
   BEGIN                                                                07780000
      BUFDST:=INDEX1(1);                                                07785000
      ENUM:=INDEX1;                                                     07790000
      STACK:=0;                                                         07795000
   END;                                                                 07800000
                                                               <<01878>>07805000
   << Make sure we have the proper capability >>               <<01878>>07810000
                                                               <<01878>>07815000
   IF NOT OKAY'UCAP THEN                                       <<01878>>07820000
   BEGIN                                                       <<01878>>07825000
      EXCHANGEDB(STACK);                                       <<01878>>07830000
      STAT := ILLEGALCAP;                                      <<01878>>07835000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>07840000
   END;                                                        <<01878>>07845000
                                                               <<01878>>07850000
                                                               <<01878>>07855000
   << Verify the validity of the INDEX parameter. >>           <<01878>>07860000
                                                               <<01878>>07865000
   CRSTATE := SETCRITICAL;                                     <<01878>>07870000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<01878>>07875000
   BEGIN        << Bad DST or bad entry offset >>              <<01878>>07880000
      EXCHANGEDB(STACK);                                       <<01878>>07885000
      RESETCRITICAL(CRSTATE);                                  <<01878>>07890000
      STAT := INDEXERR;                                        <<01878>>07895000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>07900000
   END;                                                        <<01878>>07905000
                                                               <<01878>>07910000
                                                                        07915000
   INDEX := 0;                                                 <<01878>>07920000
   WHO(,,,CNAME,CGROUP,CACCT);                                          07925000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<01878>>07930000
   IF BENTRY' = "        "  THEN                               <<01878>>07935000
   BEGIN                                                                07940000
   EXCHANGEDB(STACK);                                          <<01878>>07945000
      STAT:=INDEXERR;                                                   07950000
      RESETCRITICAL(CRSTATE);                                  <<01878>>07955000
      ERROREXIT(INTRINEXIT,0,0);                                        07960000
   END;                                                                 07965000
   IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <> CACCT,(8)          07970000
      OR BENTRY'(GROUP) <> CGROUP,(8) OR ENTRY'(UPIN) <> MYPIN <<01878>>07975000
    THEN                                                       <<01878>>07980000
   BEGIN                                                                07985000
      <<ILLEGAL CALL>>                                                  07990000
      EXCHANGEDB(STACK);                                       <<01878>>07995000
      STAT:=SECVIOL;                                                    08000000
      RESETCRITICAL(CRSTATE);                                  <<01878>>08005000
      ERROREXIT(INTRINEXIT,0,0);                                        08010000
   END;                                                                 08015000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    08020000
   DB:=EXCHANGEDB(BUFDST);                                              08025000
   CHECKMESSAGE;                                                        08030000
   OBTAIN(LOGBUFF(RESOURCE1),NULL);                            <<01884>>08035000
$IF X1=ON                                                      <<01883>>08040000
       WHAT'S'UP ( BC'OBTAIN,1 );                              <<01883>>08050000
$IF                                                            <<01883>>08055000
   IF NOWAIT THEN                                                       08060000
   BEGIN            <<MUST HAVE SPACE IN MEM BUFFER AND DISC>>          08065000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<01878>>08070000
      BEGIN                                                    <<01878>>08075000
         FLUSH(ENUM,FALSE);                                    <<01878>>08080000
         RELEASE(LOGBUFF(RESOURCE2),NULL,1);                   <<01884>>08085000
$if x1=on                                                               08085100
         WHAT'S'UP ( BC'RELEASE,2 );                                    08085200
$IF                                                                     08085300
         RELEASE(LOGBUFF(RESOURCE1),NULL,1);                   <<01884>>08086000
$IF X1=ON                                                      <<01883>>08090000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>08100000
$IF                                                            <<01883>>08105000
     EXCHANGEDB(STACK);                                        <<01878>>08110000
         STAT:=NWAITERR;                                                08115000
            RESETCRITICAL(CRSTATE);                            <<01878>>08120000
         ERROREXIT(INTRINEXIT,0,0);                                     08125000
      END;                                                              08130000
   END;                                                                 08135000
   INDEX:=ENUM;                                                         08140000
   FORIT:                                                               08145000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED)) THEN    <<01878>>08150000
      BEGIN                                                    <<01878>>08155000
         FLUSH(ENUM,FALSE);                                    <<01878>>08160000
         CHECKMESSAGE;                                         <<01878>>08165000
      END;                                                     <<01878>>08170000
   IF LOGBUFF(BSPACE) >= 1 THEN                                         08175000
   BEGIN                                                                08180000
      @BUF:=BUFBASE+(LOGBUFF(BUFUSED))*RECSIZE;                <<01878>>08185000
      @BBUF:=2*@BUF;                                                    08190000
      @DBUF:=@BUF;                                                      08195000
      BUF:="  ";                                               <<01878>>08200000
      MOVE BUF(1):=BUF, (LOGBUFF(BSPACE)*RECSIZE-1);           <<01878>>08205000
      MOVE BBUF(LID'):=BLOGBUFF(LOGID),(8);                    <<01878>>08210000
      BUF(LPIN) := MYPIN;                                      <<01878>>08215000
      MOVE BBUF(CREATOR):=BLOGBUFF(USER),(24);                          08220000
      BUF(LNUM):=LOGBUFF(LGNUM);                                        08225000
      BUF(CODE):=CLOSE;                                                 08230000
      BUF(CODE).(0:8):=LOGBUFF(SCODE).(0:8);                            08235000
      DBUF(RNUM):=DLOGBUFF(TRECS):=DLOGBUFF(TRECS)+1D;         <<01878>>08240000
      BUF(DATE):=CALENDAR;                                     <<01878>>08245000
      DBUF(TIME):=CLOCK;                                       <<01878>>08250000
      X := RECSIZEM1;                                          <<01878>>08255000
      TOS:=-1;                                                 <<01878>>08260000
      DO                                                       <<01878>>08265000
      BEGIN                                                    <<01878>>08270000
         IF X <> CKSUM THEN                                    <<01878>>08275000
         TOS:=TOS XOR BUF(X);                                  <<01878>>08280000
      END UNTIL (X:=X-1) < 0;                                  <<01878>>08285000
      BUF(CKSUM):=TOS;                                         <<01878>>08290000
      LOGBUFF(BSPACE):=LOGBUFF(BSPACE)-1;                      <<01878>>08295000
      LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                <<01878>>08300000
      FLUSH(ENUM,FALSE);                                       <<01878>>08305000
      CHECKMESSAGE;                                            <<01878>>08310000
   END  <<BSPACE >= 1>>                                                 08315000
   ELSE                                                                 08320000
   BEGIN                                                                08325000
      IF DLOGBUFF(FSPACE') >= DOUBLE(BLKFACTOR) THEN           <<01878>>08330000
      BEGIN                                                             08335000
         FLUSH(ENUM,FALSE);                                    <<01878>>08340000
         CHECKMESSAGE;                                         <<01878>>08345000
          GO FORIT;                                                     08350000
      END                                                               08355000
      ELSE GO FORIT;                                                    08360000
   END;                                                                 08365000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<01878>>08370000
   IF LOGBUFF(STATE)=INACT THEN AWAKE(LOGBUFF(LOGPIN),%20,0);  <<01878>>08375000
$IF X1=ON                                                      <<01883>>08380000
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>08390000
$IF                                                            <<01883>>08395000
                                                               <<01878>>08400000
   << Decrement OPENLOG count. When this hits zero, then     >><<01878>>08405000
   << release the entry.                                     >><<01878>>08410000
                                                               <<01878>>08415000
   LOGBUFF(OPENCNT) := LOGBUFF(OPENCNT) - 1;                   <<01878>>08420000
   IF LOGBUFF(OPENCNT) = 0  THEN                               <<01878>>08425000
   BEGIN                                                       <<01878>>08430000
      EXCHANGEDB(0);                                           <<01878>>08435000
      RELENTRY(ENUM,BUFDST);                                   <<01878>>08440000
      EXCHANGEDB(BUFDST);                                      <<01878>>08445000
   END;                                                        <<01878>>08450000
   EXCHANGEDB(STACK);                                          <<*2537>>08452000
   EXCHANGEDB(BUFDST);                                         <<*2537>>08453000
   PDISABLE;                                                   <<*2537>>08454000
                                                               <<01878>>08455000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>08460000
$IF X1=ON                                                               08460200
   WHAT'S'UP ( BC'RELEASE,2 );                                          08460300
$IF                                                                     08460400
   RELEASE(LOGBUFF(RESOURCE1),NULL,1);                         <<01884>>08461000
$IF X1=ON                                                      <<01883>>08465000
       WHAT'S'UP ( BC'RELEASE );                               <<01883>>08475000
$IF                                                            <<01883>>08480000
                                                               <<01878>>08485000
                                                               <<01878>>08490000
                                                               <<01878>>08495000
   EXCHANGEDB(STACK);                                          <<01878>>08500000
   PENABLE;                                                    <<*2537>>08501000
   STAT:=0;                                                             08505000
   RESETCRITICAL(CRSTATE);                                     <<01878>>08510000
   ERROREXIT(INTRINEXIT,0,0);                                           08515000
END;                                                                    08520000
$TITLE        "LOGGING INTRINSICS  --  FLUSHLOG"               <<01878>>08525000
$PAGE                                                          <<01878>>08530000
PROCEDURE FLUSHLOG(INDEX',STAT);                               <<01878>>08535000
DOUBLE INDEX';                                                 <<01878>>08540000
INTEGER STAT;                                                  <<01878>>08545000
OPTION PRIVILEGED;                                             <<01878>>08550000
                                                               <<01878>>08555000
                                                               <<01878>>08560000
COMMENT                                                        <<01878>>08565000
 Intrinsic used to flush the User Logging memory buffer to the <<01878>>08570000
disc logging file or the disc logging buffer. No special       <<01878>>08575000
records are written. (Performed via call to FLUSH).            <<01878>>08580000
                                                               <<01878>>08585000
 PARAMETERS:                                                   <<01878>>08590000
                                                               <<01878>>08595000
 INDEX' - Supplied by user to identify access to logging file. <<01878>>08600000
          (Originally from intrinsic OPENLOG).                 <<01878>>08605000
 STAT   - Status information returned to user. (0 = all O.K.)  <<01878>>08610000
;                                                              <<01878>>08615000
                                                               <<01878>>08620000
                                                               <<01878>>08625000
                                                               <<01878>>08630000
BEGIN                                                          <<01878>>08635000
                                                               <<01878>>08640000
   INTEGER BUFDST;                                             <<01878>>08645000
   INTEGER ENUM;                                               <<01878>>08650000
   INTEGER QSTAT;                                              <<01878>>08655000
   INTEGER  STACK;                                             <<01878>>08660000
   INTEGER DB;                                                 <<01878>>08665000
   DOUBLE PARMS;                                               <<01878>>08670000
   LOGICAL PARMS1 = PARMS;                                     <<01878>>08675000
   LOGICAL PARMS2 = PARMS + 1;                                 <<01878>>08680000
   LOGICAL CRSTATE;                                            <<01878>>08685000
  BYTE ARRAY CNAME(0:8) = Q;                                   <<01878>>08690000
  BYTE ARRAY CGROUP(0:8) = Q;                                  <<01878>>08695000
  BYTE ARRAY CACCT(0:8) = Q;                                   <<01878>>08700000
                                                               <<01878>>08705000
  ARRAY ENTRY'(0:BENTRYSIZE-1) = Q;                            <<01878>>08710000
  BYTE ARRAY BENTRY'(*) = ENTRY';                              <<01878>>08715000
                                                               <<01878>>08720000
  INTEGER INDEX;                                               <<01878>>08725000
                                                               <<01878>>08730000
   LOGICAL ARRAY INDEX1(*) = INDEX';                           <<01878>>08735000
   DEFINE INTRINEXIT = [10/213,6/2]#;                          <<01878>>08740000
   DEFINE FLAG = [1/1,8/0,7/2]#;                               <<01878>>08745000
                                                               <<01878>>08750000
   SUBROUTINE CHECKMESSAGE;                                    <<01878>>08755000
   BEGIN                                                       <<01878>>08760000
      IF LOGBUFF(LOGMSG) <> CONTINUE THEN                      <<01878>>08765000
      BEGIN                                                    <<01878>>08770000
         QSTAT := LOGBUFF(LOGMSG);                             <<01878>>08775000
         RELEASE(LOGBUFF(RESOURCE2),NULL,1);                   <<01884>>08780000
$IF X1=ON                                                               08780200
         WHAT'S'UP ( BC'RELEASE,2 );                                    08780300
$IF                                                                     08780400
         RELEASE(LOGBUFF(RESOURCE1),NULL,1);                   <<01884>>08781000
$IF X1=ON                                                      <<01883>>08785000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>08795000
$IF                                                            <<01883>>08800000
         EXCHANGEDB(STACK);                                    <<01878>>08805000
         STAT := QSTAT;                                        <<01878>>08810000
         RESETCRITICAL(CRSTATE);                               <<01878>>08815000
         ERROREXIT(INTRINEXIT,0,0);                            <<01878>>08820000
      END;                                                     <<01878>>08825000
   END;                                                        <<01878>>08830000
                                                               <<01878>>08835000
                                                               <<01878>>08840000
   ERRORON;                                                    <<01878>>08845000
   QSTAT:=0;                                                   <<01878>>08850000
   PARMS1:=0;                                                  <<01878>>08855000
   PARMS2:=[12/0,2/2,2/2];                                     <<01878>>08860000
                                                               <<01878>>08865000
   CHEK(INTRINEXIT,FLAG,PARMS);                                <<01878>>08870000
   IF CARRY THEN                                               <<01878>>08875000
   BEGIN        << DB not at stack >>                          <<01878>>08880000
      BUFDST := INDEX1(1);                                     <<01878>>08885000
      ENUM := INDEX1;                                          <<01878>>08890000
      STACK := EXCHANGEDB(0);                                  <<01878>>08895000
   END                                                         <<01878>>08900000
   ELSE                                                        <<01878>>08905000
   BEGIN                                                       <<01878>>08910000
      BUFDST := INDEX1(1);                                     <<01878>>08915000
      ENUM := INDEX1;                                          <<01878>>08920000
      STACK := 0;                                              <<01878>>08925000
   END;                                                        <<01878>>08930000
                                                               <<01878>>08935000
   << Make sure we have the proper capability >>               <<01878>>08940000
                                                               <<01878>>08945000
   IF NOT OKAY'UCAP THEN                                       <<01878>>08950000
   BEGIN                                                       <<01878>>08955000
      EXCHANGEDB(STACK);                                       <<01878>>08960000
      STAT := ILLEGALCAP;                                      <<01878>>08965000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>08970000
   END;                                                        <<01878>>08975000
                                                               <<01878>>08980000
   << Verify the validity of the INDEX parameter. >>           <<01878>>08985000
                                                               <<01878>>08990000
   CRSTATE := SETCRITICAL;                                     <<01878>>08995000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<01878>>09000000
   BEGIN       << Bad DST or bad entry offset >>               <<01878>>09005000
      EXCHANGEDB(STACK);                                       <<01878>>09010000
      RESETCRITICAL(CRSTATE);                                  <<01878>>09015000
      STAT := INDEXERR;                                        <<01878>>09020000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>09025000
   END;                                                        <<01878>>09030000
                                                               <<01878>>09035000
   CNAME := "  ";                  << Clear CNAME, CGROUP,  >> <<01878>>09040000
   MOVE CNAME(1) := CNAME, (26);   << and CACCT.            >> <<01878>>09045000
                                                               <<01878>>09050000
   INDEX := 0;                                                 <<01878>>09055000
                                                               <<01878>>09060000
   WHO(,,,CNAME,CGROUP,CACCT);                                 <<01878>>09065000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<01878>>09070000
   IF BENTRY' = "        " THEN                                <<01878>>09075000
   BEGIN                                                       <<01878>>09080000
      EXCHANGEDB(STACK);                                       <<01878>>09085000
      STAT := INDEXERR;                                        <<01878>>09090000
      RESETCRITICAL(CRSTATE);                                  <<01878>>09095000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>09100000
   END;                                                        <<01878>>09105000
                                                               <<01878>>09110000
   IF BENTRY'(USER) <> CNAME, (8) OR                           <<01878>>09115000
      BENTRY'(ACCT) <> CACCT, (8) OR                           <<01878>>09120000
      BENTRY'(GROUP) <> CGROUP, (8) OR                         <<01878>>09125000
      ENTRY'(UPIN) <> MYPIN  THEN                              <<01878>>09130000
   BEGIN                                                       <<01878>>09135000
      EXCHANGEDB(STACK);                                       <<01878>>09140000
      STAT := SECVIOL;                                         <<01878>>09145000
      RESETCRITICAL(CRSTATE);                                  <<01878>>09150000
      ERROREXIT(INTRINEXIT,0,0);                               <<01878>>09155000
   END;                                                        <<01878>>09160000
   DB := EXCHANGEDB(BUFDST);                                   <<01878>>09165000
   OBTAIN(LOGBUFF(RESOURCE1),NULL);                            <<01884>>09170000
$IF X1=ON                                                      <<01883>>09175000
       WHAT'S'UP ( BC'OBTAIN,1 );                              <<01883>>09185000
$IF                                                            <<01883>>09190000
   FLUSH(ENUM,TRUE);                                           <<01878>>09195000
   CHECKMESSAGE;                                               <<01878>>09200000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>09205000
$IF X1=ON                                                               09205200
   WHAT'S'UP ( BC'RELEASE,2 );                                          09205300
$IF                                                                     09205400
   RELEASE(LOGBUFF(RESOURCE1),NULL,1);                         <<01884>>09206000
$IF X1=ON                                                      <<01883>>09210000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>09220000
$IF                                                            <<01883>>09225000
   EXCHANGEDB(STACK);                                          <<01878>>09230000
   STAT:=QSTAT;                                                <<01878>>09235000
   RESETCRITICAL(CRSTATE);                                     <<01878>>09240000
   ERROREXIT(INTRINEXIT,0,0);                                  <<01878>>09245000
END;                                                           <<01878>>09250000
$TITLE        "USER LOGGING UTILITIES"                         <<01878>>09255000
$PAGE                                                          <<01878>>09260000
                                                               <<01878>>09265000
PROCEDURE FLUSH(INDEX,FORCE'POST'FLUSH);                       <<01878>>09270000
VALUE INDEX,FORCE'POST'FLUSH;                                  <<01878>>09275000
INTEGER INDEX;                                                 <<01878>>09280000
LOGICAL FORCE'POST'FLUSH;                                      <<01878>>09285000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01878>>09290000
                                                               <<01878>>09295000
COMMENT                                                        <<01878>>09300000
 Performs all I/O necessary to empty the buffer area to the    <<01878>>09305000
 disc logging file or disc buffer file. If not enough room     <<01878>>09310000
 in current extent, will awake the Logging Process to allocate <<01878>>09315000
 another extent.                                               <<01878>>09320000
                                                               <<01878>>09325000
ENTRY, EXIT :                                                  <<01878>>09330000
  DB is at the Logging Buffer.                                 <<01878>>09335000
  Process owns the Logging Resource.                           <<01878>>09340000
                                                               <<01878>>09345000
PARAMETER:                                                     <<01878>>09350000
 INDEX - Offset within the User Logging memory buffer for the  <<01878>>09355000
         user's entry.                                         <<01878>>09360000
         If it's NULL, then we were called by the user logging <<01878>>09365000
         process and we DO NOT want to try to awake the logging<<01878>>09370000
         process and then wait for it. (Obviously, we would    <<01878>>09375000
         be stuck waiting for ourselves).                      <<01878>>09380000
FORCE'POST'FLUSH - True if want to wait for the buffer post.   <<01878>>09385000
                   If caching is on, normally don't wait for   <<01878>>09390000
                   disc post on logical I/Os. However, if      <<01878>>09395000
                   doing FLUSHLOG or WRITELOG mode=2.          <<01878>>09400000
                                                               <<01878>>09405000
;                                                              <<01878>>09410000
                                                               <<01878>>09415000
                                                               <<01878>>09420000
BEGIN                                                          <<01878>>09425000
                                                               <<01878>>09430000
   EQUATE                                                      <<01878>>09435000
      NUMPARMS  = 2;   << Number of parameters to FLUSH >>     <<01878>>09440000
                                                               <<01878>>09445000
   DEFINE                                                      <<01878>>09450000
     CALLED'BY'USER   =  (INDEX <> NULL) #;                    <<01878>>09455000
                                                               <<01878>>09460000
   DOUBLE QADDRESS;                                            <<01878>>09465000
   LOGICAL LOGADDR1 = QADDRESS;                                <<01878>>09470000
   LOGICAL LOGADDR2 = QADDRESS+1;                              <<01878>>09475000
                                                               <<01878>>09480000
   LOGICAL                                                     <<01878>>09485000
      ATT'FLAGS,                                               <<01878>>09490000
      COUNT,      << Amount to be written from buffer >>       <<01878>>09495000
      LEFT'OVER;  << Amount left after the write      >>       <<01878>>09500000
                                                               <<01878>>09505000
                                                               <<01878>>09510000
   DOUBLE                                                      <<01878>>09515000
      ATT'STAT;             << Return from ATTACHIO >>         <<01878>>09520000
                                                               <<01878>>09525000
   INTEGER                                                     <<01878>>09530000
      ATT'STAT0  =  ATT'STAT + 0,                              <<01878>>09535000
      ERRCODE,                                                 <<01878>>09540000
      TYPE',                                                   <<01878>>09545000
      ENTRY'DB;                                                <<01878>>09550000
                                                               <<01878>>09555000
   ARRAY TLOGID(0:4) = Q;                                      <<01878>>09560000
   BYTE ARRAY BTLOGID(*) = TLOGID;                             <<01878>>09565000
                                                               <<01878>>09570000
                                                               <<01878>>09575000
SUBROUTINE CHECKMESSAGE;                                       <<01878>>09580000
BEGIN                                                          <<01878>>09585000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<01878>>09590000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>09591000
$IF X1=ON                                                               09591200
   WHAT'S'UP ( BC'RELEASE,2 );                                          09591300
$IF                                                                     09591400
   ASSEMBLE(EXIT NUMPARMS);                                    <<01878>>09595000
END;                                                           <<01878>>09600000
                                                               <<01878>>09605000
                                                               <<01878>>09610000
SUBROUTINE ERR'EXIT;                                           <<01878>>09615000
BEGIN                                                          <<01878>>09620000
                                                               <<01878>>09625000
<< Called when I/O error occurs. Will print F.S. error and   >><<01878>>09630000
<< U.L. error, set the logmsg word to indicate a write error,>><<01878>>09635000
<< and exit back to the calling procedure.                   >><<01878>>09640000
                                                               <<01878>>09645000
ERRCODE := IOSTAT(ATT'STAT0);  << Get the F.S. error         >><<01878>>09650000
TYPE'   := LOGBUFF(LOGTYPE);                                   <<01878>>09655000
MOVE BTLOGID := BLOGBUFF(LOGID), (8);                          <<01878>>09660000
BTLOGID(8) := 0;                                               <<01878>>09665000
                                                               <<01878>>09670000
LOGBUFF(LOGMSG) := WRITEERR;   << So everyone will know      >><<01878>>09675000
                                                               <<01878>>09680000
ENTRY'DB := EXCHANGEDB(0);     << Back to stack              >><<01878>>09685000
                                                               <<01878>>09690000
GENMSG(FSSETNO,ERRCODE,,,,,,,0);  << File System error first >><<01878>>09695000
                                                               <<01878>>09700000
<< Now U.L. error >>                                           <<01878>>09705000
                                                               <<01878>>09710000
IF TYPE' = DISC                                                <<01878>>09715000
    THEN GENMSG(SETNO,FWRITEERROR,0,@BTLOGID,,,,,0)            <<01878>>09720000
ELSE GENMSG(SETNO,BWRITEERROR,0,@BTLOGID,,,,,0);               <<01878>>09725000
                                                               <<01878>>09730000
EXCHANGEDB(ENTRY'DB);                                          <<01878>>09735000
                                                               <<01878>>09740000
ASSEMBLE (EXIT NUMPARMS);                                      <<01878>>09745000
                                                               <<01878>>09750000
END;       << Err'exit >>                                      <<01878>>09755000
                                                               <<01878>>09760000
                                                               <<01878>>09765000
                                                               <<01878>>09770000
SUBROUTINE CLEAR;                                              <<01878>>09775000
BEGIN                                                          <<01878>>09780000
   LOGBUFF(BUFBASE) := "  ";                                   <<01878>>09785000
   MOVE LOGBUFF(BUFBASE+1):=LOGBUFF(BUFBASE),(BLKSIZE-1);      <<01878>>09790000
   IF LOGBUFF(LOGTYPE) = DISC THEN                             <<01878>>09795000
   BEGIN                                                       <<01878>>09800000
      IF LOGBUFF(EXTENT) >= LOGBUFF(LASTEXT') AND              <<01878>>09805000
         DLOGBUFF(FSPACE') < DOUBLE(BLKFACTOR)                 <<01878>>09810000
                                                               <<01878>>09815000
        THEN ILOGBUFF(BSPACE) := INTEGER(DLOGBUFF(FSPACE'))    <<01878>>09820000
      ELSE LOGBUFF(BSPACE) := BLKFACTOR;                       <<01878>>09825000
   END                                                         <<01878>>09830000
   ELSE LOGBUFF(BSPACE) := BLKFACTOR;                          <<01878>>09835000
                                                               <<01878>>09840000
   LOGBUFF(BUFUSED) := 0;                                      <<01878>>09845000
END;                                                           <<01878>>09850000
<<***** End of Subroutines ***********>>                       <<01878>>09855000
                                                               <<01878>>09860000
                                                               <<01878>>09865000
                                                               <<01878>>09870000
   COUNT := 0;                                                 <<01878>>09875000
   LEFT'OVER := 0;                                             <<01878>>09880000
ATT'FLAGS := FLAGS;    << Normally serial write post >>        <<01878>>09885000
                                                               <<01878>>09890000
IF FORCE'POST'FLUSH THEN ATT'FLAGS.WAIT'FOR'POST := 1;         <<01878>>09895000
                                                               <<01878>>09900000
                                                               <<01878>>09905000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<01878>>09910000
   BEGIN                                                       <<01878>>09915000
                                                               <<01878>>09920000
CHECK'SPACE:                                                   <<01878>>09925000
                                                               <<01878>>09930000
      OBTAIN(LOGBUFF(RESOURCE2),NULL);                         <<01884>>09933000
$IF X1=ON                                                               09933200
      WHAT'S'UP ( BC'OBTAIN,2 );                                        09933300
$IF                                                                     09933400
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED)) THEN    <<01878>>09935000
      BEGIN                                                    <<01878>>09940000
                                                               <<01878>>09945000
         << We need the logging process to start emptying the>><<01878>>09950000
         << the disc buffer file before we post the buffer.  >><<01878>>09955000
         << However, if we were called by the logging process>><<01878>>09960000
         << we just want to set a flag and return. The log   >><<01878>>09965000
         << process will see the flag, empty the disc buffer,>><<01878>>09970000
         << and call us again later.                         >><<01878>>09975000
                                                               <<01878>>09980000
         IF NOT CALLED'BY'USER THEN                            <<01878>>09985000
         BEGIN                                                 <<01878>>09990000
            LOGBUFF(USERMSG) := DISCSPACE;                     <<01878>>09995000
            RETURN;                                            <<01878>>10000000
         END;                                                  <<01878>>10005000
                                                               <<01878>>10010000
         PDISABLE;                                             <<01878>>10015000
         LOGBUFF(SLPCT) := LOGBUFF(SLPCT) + 1;                 <<01884>>10016000
         LOGBUFF(WSTATE):= INACT;                              <<01884>>10017000
         RELEASE(LOGBUFF(RESOURCE2),NULL,1);                   <<01884>>10020000
$IF X1=ON                                                      <<01883>>10025000
       WHAT'S'UP ( BC'RELEASE, LOGBUFF(USERMSG));              <<01883>>10035000
$IF                                                            <<01883>>10040000
         AWAKE(LOGBUFF(LOGPIN),%20,0);                         <<01878>>10045000
$IF X1=ON                                                      <<01883>>10050000
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>10060000
$IF                                                            <<01883>>10065000
$EDIT VOID=10075000                                            <<01884>>10070000
$IF X1=ON                                                      <<01883>>10080000
       WHAT'S'UP ( BC'WAIT );                                  <<01883>>10090000
$IF                                                            <<01883>>10095000
         WAIT(%20,0);                                          <<01878>>10100000
                                                               <<01878>>10105000
         << First want to make sure that the logging process >><<01878>>10110000
         << was able to successfully complete this request.  >><<01878>>10115000
         << If all is okay, then we'll go back and try again.>><<01878>>10120000
         << If there was some problem, then CHECKMESSAGE will>><<01878>>10125000
         << return to the caller.                            >><<01878>>10130000
                                                               <<01878>>10135000
         OBTAIN(LOGBUFF(RESOURCE2),NULL);                      <<01884>>10140000
$IF X1=ON                                                      <<01883>>10145000
       WHAT'S'UP ( BC'OBTAIN,2 );                              <<01883>>10155000
$IF                                                            <<01883>>10160000
         CHECKMESSAGE;                                         <<01878>>10165000
         GO CHECK'SPACE;                                       <<01878>>10170000
      END;                                                     <<01878>>10175000
                                                               <<01878>>10180000
      << There is room in the disc buffer - start flushing.  >><<01878>>10185000
                                                               <<01878>>10190000
      QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);          <<01878>>10195000
      COUNT := LOGBUFF(BUFUSED) * RECSIZE;                     <<01878>>10200000
      IF DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE) >            <<01878>>10205000
      DLOGBUFF(FSIZE) THEN                                     <<01878>>10210000
      BEGIN                                                    <<01878>>10215000
                                                               <<01878>>10220000
         << We will need more than one write to flush the    >><<01878>>10225000
         << entire buffer. The disc buffer file is treated   >><<01878>>10230000
         << like a circular file, we may only have room for  >><<01878>>10235000
         << part of the buffer before we cycle back to the   >><<01878>>10240000
         << start of the buffer file.                        >><<01878>>10245000
                                                               <<01878>>10250000
                                                               <<01878>>10255000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>10260000
         @LOGBUFF(BUFBASE),WRITE,COUNT:=INTEGER(DLOGBUFF(FSIZE)-        10265000
         DLOGBUFF(INBUFREC))*RECSIZE,LOGADDR1,LOGADDR2,        <<01878>>10270000
         ATT'FLAGS);                                           <<01878>>10275000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN  ERR'EXIT;       <<01878>>10280000
                                                               <<01878>>10285000
         << Time to reset our pointer to the top of the disc >><<01878>>10290000
         << buffer file.                                     >><<01878>>10295000
                                                               <<01878>>10300000
         DLOGBUFF(INBUFREC):=0D;                               <<01878>>10305000
         COUNT := LOGBUFF(BUFUSED) * RECSIZE - COUNT;          <<01878>>10310000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01878>>10315000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>10320000
         @LOGBUFF(BUFBASE+BLKSIZE-LOGBUFF(BSPACE)*RECSIZE-COUNT),       10325000
         WRITE,COUNT,LOGADDR1,LOGADDR2,ATT'FLAGS);             <<01878>>10330000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN ERR'EXIT;        <<01878>>10335000
                                                               <<01878>>10340000
                                                               <<01878>>10345000
         << We have now successfully completed flushing the  >><<01878>>10350000
         << buffer. Now update the global info and clear the >><<01878>>10355000
         << buffer so we're ready for more stuff.            >><<01878>>10360000
                                                               <<01878>>10365000
         DLOGBUFF(FSPACE'):=DLOGBUFF(FSPACE')-DOUBLE(BLKFACTOR)<<01878>>10370000
                            + DOUBLE(LOGBUFF(BSPACE));         <<01878>>10375000
         LOGBUFF(BSPACE):=BLKFACTOR;                           <<01878>>10380000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  10385000
         IF DLOGBUFF(INBUFREC)>=DLOGBUFF(FSIZE) THEN           <<01878>>10390000
         DLOGBUFF(INBUFREC):=0D;                               <<01878>>10395000
         CLEAR;                                                <<01878>>10400000
          RETURN;                                              <<01878>>10405000
      END                                                      <<01878>>10410000
                                                               <<01878>>10415000
      ELSE                                                     <<01878>>10420000
      BEGIN                                                    <<01878>>10425000
                                                               <<01878>>10430000
         << Simple case, only one write will be necessary to>> <<01878>>10435000
         << flush the buffer to the disc buffer file.       >> <<01878>>10440000
                                                               <<01878>>10445000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01878>>10450000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>10455000
              @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2, <<01878>>10460000
              ATT'FLAGS);                                      <<01878>>10465000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN ERR'EXIT;        <<01878>>10470000
                                                               <<01878>>10475000
                                                               <<01878>>10480000
         << We have now successfully completed flushing the  >><<01878>>10485000
         << buffer. Now update the global info and clear the >><<01878>>10490000
         << buffer so we're ready for more stuff.            >><<01878>>10495000
                                                               <<01878>>10500000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  10505000
         IF DLOGBUFF(INBUFREC) >= DLOGBUFF(FSIZE) THEN         <<01878>>10510000
         DLOGBUFF(INBUFREC):=0D;                               <<01878>>10515000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<01878>>10520000
                              DOUBLE(COUNT/RECSIZE);           <<01878>>10525000
         CLEAR;                                                <<01878>>10530000
      END;                                                     <<01878>>10535000
                                                               <<01878>>10540000
      << The buffer is flushed, and ready for more use. If   >><<01878>>10545000
      << there is any stuff in the disc buffer file, we will >><<01878>>10550000
      << awake the logging process to take care of it.       >><<01878>>10555000
      << Of course, if we were called by the logging process >><<01878>>10560000
      << then we simply return.                              >><<01878>>10565000
                                                               <<01878>>10570000
      IF DLOGBUFF(FSIZE)-DLOGBUFF(FSPACE')>=DOUBLE(BLKFACTOR)  <<01878>>10575000
         AND  CALLED'BY'USER                                   <<01878>>10580000
        THEN  AWAKE(LOGBUFF(LOGPIN),%20,0);                    <<01878>>10585000
$IF X1=ON                                                      <<01883>>10590000
       WHAT'S'UP( BC'AWAKE );                                  <<01883>>10600000
$IF                                                            <<01883>>10605000
         RETURN;                                               <<01878>>10610000
   END;                                                        <<01878>>10615000
                                                               <<01878>>10620000
   << This is the case for a disc log file. >>                 <<01878>>10625000
                                                               <<01878>>10630000
OBTAIN(LOGBUFF(RESOURCE2),NULL);                               <<01884>>10633000
$IF X1=ON                                                               10633200
WHAT'S'UP (BC'OBTAIN,2 );                                               10633300
$IF                                                                     10633400
   IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN      <<01878>>10635000
   BEGIN                                                       <<01878>>10640000
                                                               <<01878>>10645000
      << There is either not enough room in this extent to  >> <<01878>>10650000
      << flush the entire buffer, or after the buffer is    >> <<01878>>10655000
      << flushed the buffer will be full. In this case we   >> <<01878>>10660000
      << will flush the buffer and ask for another extent.  >> <<01878>>10665000
                                                               <<01878>>10670000
      IF (LOGBUFF(EXTENT)>=LOGBUFF(LASTEXT')) THEN             <<01878>>10675000
      BEGIN                                                    <<01878>>10680000
                                                               <<01878>>10685000
         << Opps...there are no more extents available. We   >><<01878>>10690000
         << will only write out what we can.                 >><<01878>>10695000
                                                               <<01878>>10700000
         IF DLOGBUFF(FSPACE') > 0D  THEN                       <<01878>>10705000
         BEGIN                                                 <<01878>>10710000
            COUNT:=INTEGER(DLOGBUFF(FSPACE'))*RECSIZE;         <<01878>>10715000
                                                               <<01878>>10720000
            IF COUNT > BLKSIZE                                 <<01878>>10725000
               THEN COUNT := BLKSIZE-LOGBUFF(BSPACE)*RECSIZE;  <<01878>>10730000
                                                               <<01878>>10735000
            QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);    <<01878>>10740000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>10745000
            @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2,   <<01878>>10750000
            ATT'FLAGS);                                        <<01878>>10755000
            IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;      <<01878>>10760000
                                                               <<01878>>10765000
         END;                                                  <<01878>>10770000
                                                               <<01878>>10775000
         << Update the global info, tell the process that    >><<01878>>10780000
         << we're totally out of file space, and tell the    >><<01878>>10785000
         << user that we are out of file space.              >><<01878>>10790000
                                                               <<01878>>10795000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<01878>>10800000
                            DOUBLE(COUNT/RECSIZE);             <<01878>>10805000
         DLOGBUFF(INBUFREC) := DLOGBUFF(INBUFREC) +            <<01878>>10810000
                               DOUBLE(COUNT/RECSIZE);          <<01878>>10815000
         CLEAR;                                                <<01878>>10820000
                                                               <<01878>>10825000
         IF NOT CALLED'BY'USER THEN                            <<01878>>10830000
            BEGIN                                              <<01878>>10835000
            IF DLOGBUFF (FSPACE') = 0D THEN                    <<01878>>10840000
               BEGIN                                           <<01878>>10845000
               LOGBUFF(USERMSG):=CONTINUE;                     <<01878>>10850000
               LOGBUFF(LOGMSG):=CONTINUE;                      <<01878>>10855000
               END;                                            <<01878>>10860000
            END                                                <<01878>>10865000
         ELSE                                                  <<01878>>10870000
            BEGIN                                              <<01878>>10875000
                                                               <<01878>>10880000
            << ASK FOR AUTO CHANGELOG >>                       <<01878>>10885000
            IF LOGBUFF(AUTO) THEN                              <<01878>>10890000
               BEGIN                                           <<01878>>10895000
               PDISABLE;                                       <<01878>>10900000
               LOGBUFF(USERMSG):=DISCSPACE;                    <<01878>>10905000
              LOGBUFF(SLPCT) := LOGBUFF(SLPCT) + 1;            <<01884>>10906000
              LOGBUFF(WSTATE) := INACT;                        <<01884>>10907000
                RELEASE(LOGBUFF(RESOURCE2),NULL,1);            <<01884>>10910000
$IF X1=ON                                                      <<01883>>10915000
       WHAT'S'UP ( BC'RELEASE,2 );                             <<01883>>10925000
$IF                                                            <<01883>>10930000
               AWAKE(LOGBUFF(LOGPIN),%20,0);                   <<01878>>10935000
$IF X1=ON                                                      <<01883>>10940000
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>10950000
$IF                                                            <<01883>>10955000
$EDIT VOID=10965000                                            <<01884>>10960000
                                                               <<01878>>10970000
               << WAIT FOR LOG PROC TO DO THE CHANGE >>        <<01878>>10975000
                                                               <<01878>>10980000
$IF X1=ON                                                      <<01883>>10985000
       WHAT'S'UP ( BC'WAIT );                                  <<01883>>10995000
$IF                                                            <<01883>>11000000
               WAIT (%20,0);                                   <<01878>>11005000
             OBTAIN(LOGBUFF(RESOURCE2),NULL);                  <<01884>>11010000
$IF X1=ON                                                      <<01883>>11015000
       WHAT'S'UP ( BC'OBTAIN,2 );                              <<01883>>11025000
$IF                                                            <<01883>>11030000
               << MAKE SURE LOG PROCESS WAS ABLE TO >>         <<01878>>11035000
               << SUCCESSFULLY COMPLETE THE CHANGELOG >>       <<01878>>11040000
                                                               <<01878>>11045000
               CHECKMESSAGE;                                   <<01878>>11050000
               END                                             <<01878>>11055000
            ELSE          << EOF AND AUTO NOT ENABLED >>       <<01878>>11060000
               BEGIN                                           <<01878>>11065000
               LOGBUFF(USERMSG):=DISCSPACE;                    <<01878>>11070000
               LOGBUFF(LOGMSG):=EOFONLOGFILE;                  <<01878>>11075000
               AWAKE(LOGBUFF(LOGPIN),%20,0);                   <<01878>>11080000
$IF X1=ON                                                      <<01883>>11085000
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>11095000
$IF                                                            <<01883>>11100000
               END;                                            <<01878>>11105000
            END;                                               <<01878>>11110000
         RETURN;                                               <<01878>>11115000
      END                                                      <<01878>>11120000
                                                               <<01878>>11125000
      ELSE                                                     <<01878>>11130000
      BEGIN                                                    <<01878>>11135000
                                                               <<01878>>11140000
         << We have another extent available to us. Write out>><<01878>>11145000
         << enough to fill this extent. We will then ask the >><<01878>>11150000
         << log process to get us another extent so that we  >><<01878>>11155000
         << can then finish flushing the buffer.             >><<01878>>11160000
                                                               <<01878>>11165000
         COUNT:=INTEGER(DLOGBUFF(FSPACE'))*RECSIZE;            <<01878>>11170000
         LEFT'OVER := BLKSIZE-COUNT - LOGBUFF(BSPACE)*RECSIZE; <<01878>>11175000
         IF COUNT = 0 THEN LEFT'OVER := 0;                     <<01878>>11180000
                                                               <<01883>>11185000
$IF X1=ON                                                      <<01883>>11190000
       WHAT'S'UP ( BC'VALUES, COUNT,                           <<01883>>11200000
                       INTEGER(DLOGBUFF(FSPACE')),             <<01883>>11205000
                       LOGBUFF(BSPACE), LEFT'OVER );           <<01883>>11210000
$IF                                                            <<01883>>11215000
                                                               <<01883>>11220000
                                                               <<01878>>11225000
         IF COUNT > 0 THEN                                     <<01878>>11230000
         BEGIN  << Something to write >>                       <<01878>>11235000
                                                               <<01878>>11240000
$IF X1=ON                                                      <<01883>>11245000
       WHAT'S'UP ( BC'VALUES );                                <<01883>>11265000
$IF                                                            <<01883>>11275000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01878>>11280000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>11285000
         @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2,      <<01878>>11290000
         ATT'FLAGS);                                           <<01878>>11295000
         IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;         <<01878>>11300000
                                                               <<01878>>11305000
                                                               <<01878>>11310000
         << Now update the global info to reflect what>>       <<01878>>11315000
         << has just happened.                        >>       <<01878>>11320000
                                                               <<01878>>11325000
         LOGBUFF(BSPACE) := LOGBUFF(BSPACE) + COUNT/RECSIZE;   <<01878>>11330000
         LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) - COUNT/RECSIZE; <<01878>>11335000
         DLOGBUFF(INBUFREC) := DLOGBUFF(INBUFREC) +            <<01878>>11340000
                               DOUBLE(COUNT/RECSIZE);          <<01878>>11345000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<01878>>11350000
                             DOUBLE(COUNT/RECSIZE);            <<01878>>11355000
                                                               <<01878>>11360000
$IF X1=ON                                                      <<01883>>11365000
       WHAT'S'UP ( BC'VALUES,                                  <<01883>>11385000
                          LOGBUFF(BSPACE), LOGBUFF(BUFUSED));  <<01883>>11390000
$IF                                                            <<01883>>11405000
         << If there is any info left in the buffer, then   >> <<01878>>11410000
         << must shift it to the top to prepare for the next>> <<01878>>11415000
         << write.                                          >> <<01878>>11420000
                                                               <<01878>>11425000
         IF LEFT'OVER > 0 THEN                                 <<01878>>11430000
           MOVE LOGBUFF(BUFBASE):=LOGBUFF(BUFBASE+COUNT),      <<01878>>11435000
                                  (LEFT'OVER);                 <<01878>>11440000
                                                               <<01878>>11445000
         << Now clear the remaider of the buffer >>            <<01878>>11450000
                                                               <<01878>>11455000
         LOGBUFF(BUFBASE+LEFT'OVER) := "  ";                   <<01878>>11460000
         MOVE LOGBUFF(BUFBASE+LEFT'OVER+1) :=                  <<01878>>11465000
              LOGBUFF(BUFBASE+LEFT'OVER), (COUNT-1);           <<01878>>11470000
                                                               <<01878>>11475000
         END;      << Something to write >>                    <<01878>>11480000
                                                               <<01878>>11485000
         << We need another extent. Only wake up the logging >><<01878>>11490000
         << process if we have been called by a user.        >><<01878>>11495000
                                                               <<01878>>11500000
         IF NOT CALLED'BY'USER THEN                            <<01878>>11505000
         BEGIN                                                 <<01878>>11510000
                                                               <<01878>>11515000
            IF LEFT'OVER > 0  OR                               <<01878>>11520000
               (COUNT = 0 LAND LOGBUFF(BUFUSED) > 0)           <<01878>>11525000
              THEN LOGBUFF(USERMSG) := DISCSPACE               <<01878>>11530000
            ELSE LOGBUFF(LOGMSG) := CONTINUE;                  <<01878>>11535000
            RETURN;                                            <<01878>>11540000
         END;                                                  <<01878>>11545000
                                                               <<01878>>11550000
      IF NOT LOGBUFF(AUTO) THEN DLOGBUFF(INBUFREC):=0D;        <<01878>>11555000
         PDISABLE;                                             <<01878>>11560000
         LOGBUFF(USERMSG):=DISCSPACE;                          <<01878>>11565000
         LOGBUFF(SLPCT) := LOGBUFF(SLPCT) +1;                  <<01884>>11566000
         LOGBUFF(WSTATE) := INACT;                             <<01884>>11567000
         RELEASE(LOGBUFF(RESOURCE2),NULL,1);                   <<01884>>11570000
$IF X1=ON                                                      <<01883>>11575000
       WHAT'S'UP ( BC'RELEASE );                               <<01883>>11595000
$IF                                                            <<01883>>11610000
         AWAKE(LOGBUFF(LOGPIN),%20,0);                         <<01878>>11615000
$IF X1=ON                                                      <<01883>>11620000
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>11630000
$IF                                                            <<01883>>11635000
$EDIT VOID=11645000                                            <<01884>>11640000
                                                               <<01878>>11650000
         << Wait for LOG PROC to allocate the next extent >>   <<01878>>11655000
                                                               <<01878>>11660000
$IF X1=ON                                                      <<01883>>11665000
       WHAT'S'UP ( BC'WAIT );                                  <<01883>>11675000
$IF                                                            <<01883>>11680000
         WAIT(%20,0);                                          <<01878>>11685000
         OBTAIN(LOGBUFF(RESOURCE2),NULL);                      <<01884>>11690000
$IF X1=ON                                                      <<01883>>11695000
       WHAT'S'UP ( BC'OBTAIN );                                <<01883>>11705000
$IF                                                            <<01883>>11710000
         << Make sure that the log process was able to       >><<01878>>11715000
         << successfully complete this request. If not,      >><<01878>>11720000
         << CHECKMESSAGE will return to the caller.          >><<01878>>11725000
                                                               <<01878>>11730000
         CHECKMESSAGE;                                         <<01878>>11735000
                                                               <<01878>>11740000
         << Now check to see if there is any more to flush.  >><<01878>>11745000
                                                               <<01878>>11750000
         COUNT := LOGBUFF(BUFUSED) * RECSIZE;                  <<01878>>11755000
         IF COUNT > 0 THEN                                     <<01878>>11760000
         BEGIN                                                 <<01878>>11765000
                                                               <<01878>>11770000
            << Now we can finish writing to the new extent.  >><<01878>>11775000
                                                               <<01878>>11780000
            QADDRESS := DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);  <<01878>>11785000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<01878>>11790000
                          @LOGBUFF(BUFBASE),WRITE,COUNT,       <<01878>>11795000
                          LOGADDR1,LOGADDR2,ATT'FLAGS);        <<01878>>11800000
         IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;         <<01878>>11805000
                                                               <<01878>>11810000
                                                               <<01878>>11815000
         END;    << Complete the write into new extent >>      <<01878>>11820000
                                                               <<01878>>11825000
                                                               <<01878>>11830000
         << The buffer has been successfully flushed, clear  >><<01878>>11835000
         << it out, and update the global info - i.e. the    >><<01878>>11840000
         << number of records now available in the buffer.   >><<01878>>11845000
                                                               <<01878>>11850000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  11855000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<01878>>11860000
                              DOUBLE(COUNT/RECSIZE);           <<01878>>11865000
         CLEAR;                                                <<01878>>11870000
         LOGBUFF(LOGMSG):=CONTINUE;                            <<01878>>11875000
         RETURN;                                               <<01878>>11880000
      END;                                                     <<01878>>11885000
                                                               <<01878>>11890000
   END                                                         <<01878>>11895000
   ELSE                                                        <<01878>>11900000
   BEGIN                                                       <<01878>>11905000
      << Simple case, there is plenty of room in the current >><<01878>>11910000
      << extent - just write it out and return.              >><<01878>>11915000
                                                               <<01878>>11920000
      QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);          <<01878>>11925000
      COUNT := LOGBUFF(BUFUSED) * RECSIZE;                     <<01878>>11930000
      ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),  <<01878>>11935000
      @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,                  <<01878>>11940000
      LOGADDR2,ATT'FLAGS);                                     <<01878>>11945000
      IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;            <<01878>>11950000
                                                               <<01878>>11955000
                                                               <<01878>>11960000
      DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -                 <<01878>>11965000
                           DOUBLE(COUNT/RECSIZE);              <<01878>>11970000
      DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);     11975000
      CLEAR;                                                   <<01878>>11980000
      LOGBUFF(LOGMSG):=CONTINUE;                               <<01878>>11985000
   END;                                                        <<01878>>11990000
                                                               <<01878>>11995000
END;       << Procedure FLUSH >>                               <<01878>>12000000
                                                               <<01878>>12005000
                                                                        12010000
                                                                        12015000
$PAGE                                                          <<01878>>12020000
PROCEDURE UPSHIFT'(PTR);                                                12025000
VALUE PTR;                                                              12030000
BYTE POINTER PTR;                                                       12035000
OPTION INTERNAL,UNCALLABLE;                                    <<01878>>12040000
BEGIN                                                                   12045000
   BYTE POINTER BPS0 = S-0;                                             12050000
   TOS:=@PTR;                                                           12055000
   DO                                                                   12060000
   BEGIN                                                                12065000
      ASSEMBLE(DUP);                                                    12070000
      MOVE *:=* WHILE ANS,1;                                            12075000
      TOS:=TOS+1;                                                       12080000
   END UNTIL BPS0(-1) = 0;                                              12085000
END;                                                                    12090000
                                                                        12095000
                                                                        12100000
$PAGE  "TABLE ACCESS UTILITIES"                                <<01878>>12105000
                                                                        12110000
PROCEDURE FENTRY(LOGID',PASS,LFNAME',CUSER,CACCT,TYPE');       <<01878>>12115000
BYTE ARRAY LOGID',LFNAME',CUSER,CACCT,PASS;                    <<01878>>12120000
LOGICAL TYPE';                                                          12125000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                                  12130000
                                                               <<01878>>12135000
COMMENT                                                        <<01878>>12140000
ENTRY IN THE LOGGING IDENTIFIER TABLE (LIDTAB).                         12145000
                                                                        12150000
THE SEARCH USES THE "LOGID" PARAMETER TO FIND THE ENTRY AND             12155000
RETURNS INFORMATION ON THE LOGGING IDENTIFIER IN THE OTHER              12160000
PARAMETERS.                                                             12165000
                                                                        12170000
LOGID'   =   Logging identifer.                                <<01878>>12175000
PASS     =   Password associated with the logid.               <<01878>>12180000
LFNAME'  =   Name of the current log file (36 bytes)           <<01878>>12185000
CUSER    =  Name of the user who created the logging id.       <<01878>>12190000
CACCT    =  Account the creator resides in.                    <<01878>>12195000
TYPE'    =  The type of the logging file :                     <<01878>>12200000
               -1 = NULL (not in use)                          <<01878>>12205000
            (0:1) - 1 = :Chanelog allowed                      <<01878>>12210000
            (1:1) - 1 = Auto changelog allowed                 <<01878>>12215000
            (2:7) - Previous log file type                     <<01878>>12220000
            (9:7) - Current log file type                      <<01878>>12225000
                                                               <<01878>>12230000
              The type fields are as follows:                  <<01878>>12235000
                      0 = DISC                                 <<01878>>12240000
                      1 = TAPE                                 <<01878>>12245000
                      2 = SDISC                                <<01878>>12250000
                      3 = CTAPE                                <<01878>>12255000
                                                               <<01878>>12260000
    DB must be at stack.                                       <<01878>>12265000
                                                               <<01878>>12270000
RETURNS:                                                       <<01878>>12275000
   CCG If not found.                                           <<01878>>12280000
   CCE If found.                                               <<01878>>12285000
;                                                              <<01878>>12290000
                                                                        12295000
BEGIN                                                                   12300000
   ENTRY FENTRY'SWITCH;                                        <<01878>>12305000
   INTEGER STATUS' = Q-1;                                               12310000
   INTEGER MAX,I,J,K;                                          <<01878>>12315000
   LOGICAL SWITCH'FLAG;                                        <<01878>>12320000
   LOGICAL MASK = Q-4;                                                  12325000
   BYTE ARRAY BLANKS(0:7);                                     <<01878>>12330000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<01878>>12335000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      12340000
   SWITCH'FLAG := FALSE;                                       <<01878>>12345000
   GO OVER;                                                    <<01878>>12350000
FENTRY'SWITCH:                                                 <<01878>>12355000
                                                               <<01878>>12360000
   SWITCH'FLAG := TRUE;                                        <<01878>>12365000
                                                                        12370000
   <<GET MAX NUMBER OF ENTRIES>>                                        12375000
                                                                        12380000
                                                                        12385000
<<GET MAX NUMBER OF ENTRIES>>                                           12390000
                                                                        12395000
OVER:                                                          <<01878>>12400000
   BLANKS := " ";                                              <<01878>>12405000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<01878>>12410000
   MOVE LOGID':=LOGID' WHILE ANS,0;                                     12415000
   K:=TOS-@LOGID';                                                      12420000
                                                               <<01878>>12425000
   IF  K <= 0 THEN                                             <<01878>>12430000
   BEGIN        << Logid does not start with alpha char. >>    <<01878>>12435000
      CC := CCG;                                               <<01878>>12440000
      RETURN;                                                  <<01878>>12445000
   END;                                                        <<01878>>12450000
                                                               <<01878>>12455000
   IF K > 8 THEN K:=8;                                                  12460000
   I := 1;                                                     <<01878>>12465000
   DO                                                                   12470000
   BEGIN                     <<SEARCH FOR LOGGING IDENTIFIER>>          12475000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);      <<01878>>12480000
      IF BENTRY'(LID+7) <> " " THEN J:=8                                12485000
      ELSE                                                              12490000
      BEGIN                                                             12495000
         MOVE BENTRY'(LID):=BENTRY'(LID) WHILE AN,0;                    12500000
         J:=TOS-@BENTRY'(LID);                                          12505000
      END;                                                              12510000
   END UNTIL (BENTRY'(LID) = LOGID',(J)) AND (ENTRY'(TYP) <> NULL) AND  12515000
   (K = J) OR (I:=I+1) > MAX;                                           12520000
   IF I <= MAX THEN                                                     12525000
   BEGIN                                                                12530000
      <<FOUND IT>>                                                      12535000
      IF MASK.(12:1) THEN                                               12540000
      BEGIN   << File name specified >>                        <<01878>>12545000
      IF ENTRY'(TYP).TYP'CURRENT = DISC OR SWITCH'FLAG THEN    <<01878>>12550000
         EXTRACT'FILENAME(LFNAME',BENTRY'(FNAME'),BENTRY'(LW), <<01878>>12555000
                          BENTRY'(FGROUP),BENTRY'(FACCT))      <<01878>>12560000
      ELSE                                                     <<01878>>12565000
         EXTRACT'FILENAME(LFNAME',BENTRY'(FNAME'),BLANKS,      <<01878>>12570000
                          BLANKS,BLANKS);                      <<01878>>12575000
                                                               <<01878>>12580000
      END;                                                              12585000
      IF MASK.(13:1) THEN MOVE CUSER:=BENTRY'(UNAME),(8);               12590000
      IF MASK.(11:1) THEN MOVE PASS:=BENTRY'(PW),(8);                   12595000
      IF MASK.(14:1) THEN MOVE CACCT:=BENTRY'(UACCT),(8);               12600000
      IF MASK.(15:1) THEN TYPE':=ENTRY'(TYP);                           12605000
   END                                                                  12610000
   ELSE                                                                 12615000
   BEGIN                                   <<DID NOT FIND IT>>          12620000
      CC:=CCG;                                                          12625000
      RETURN;                                                           12630000
   END;                                                                 12635000
   CC:=CCE;                                                             12640000
END;                                                                    12645000
                                                                        12650000
$PAGE                                                          <<01878>>12655000
PROCEDURE DENTRY(LOGID',LEN);                                  <<01878>>12660000
   VALUE LEN;                                                  <<01878>>12665000
   INTEGER LEN;                                                <<01878>>12670000
   BYTE ARRAY LOGID';                                          <<01878>>12675000
   OPTION INTERNAL,UNCALLABLE;                                 <<01878>>12680000
                                                                        12685000
                                                                        12690000
<< This procedure deletes entries from the Logging Identifier>><<01878>>12695000
<< Table (LIDTAB).                                           >><<01878>>12700000
<< The parameter LOGID' is used as the search key and if the >><<01878>>12705000
<< user calling this procedure is the creator, then the entry>><<01878>>12710000
<< will be deleted.                                          >><<01878>>12715000
<<                                                           >><<01878>>12720000
<<    DB must be at stack.                                   >><<01878>>12725000
<< RETURNS:                                                  >><<01878>>12730000
<<     CCE - entry for the specified entry was deleted.      >><<01878>>12735000
<<     CCL - entry not found.ed.                             >><<01878>>12740000
<<     CCG - user is not the creator, entry not deleted.     >><<01878>>12745000
<<                                                           >><<01878>>12750000
                                                                        12755000
BEGIN                                                                   12760000
   INTEGER STATUS' = Q-1;                                               12765000
   INTEGER I,MAX;                                                       12770000
   INTEGER LIDLENGTH;      << Length of logid from the table >><<01878>>12775000
                                                               <<01878>>12780000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<01878>>12785000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      12790000
   BYTE ARRAY CUSER(0:7) = Q;                                           12795000
   BYTE ARRAY CACCT (0:7) = Q;                                          12800000
                                                               <<01878>>12805000
   << Get the maximum number of entries in the LID.   >>       <<01878>>12810000
                                                               <<01878>>12815000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<01878>>12820000
                                                               <<01878>>12825000
   I := 1;                                                     <<01878>>12830000
   DO                                                          <<01878>>12835000
     BEGIN                                                     <<01878>>12840000
        << Get next entry from LID. >>                         <<01878>>12845000
                                                               <<01878>>12850000
        MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);    <<01878>>12855000
                                                               <<01878>>12860000
        << Need length of the logid as found in the table >>   <<01878>>12865000
                                                               <<01878>>12870000
        IF BENTRY'(LID+7) <> " " THEN LIDLENGTH := 8           <<01878>>12875000
        ELSE                                                   <<01878>>12880000
        BEGIN                                                  <<01878>>12885000
           MOVE BENTRY'(LID) := BENTRY'(LID) WHILE AN, 1;      <<01878>>12890000
           LIDLENGTH := TOS - @BENTRY';                        <<01878>>12895000
        END;                                                   <<01878>>12900000
                                                               <<01878>>12905000
        IF BENTRY'(LID) = LOGID', (LEN)  AND                   <<01878>>12910000
           LIDLENGTH = LEN    THEN                             <<01878>>12915000
        BEGIN       << We've found the specified logid >>      <<01878>>12920000
           WHO(,,,CUSER,,CACCT);                               <<01878>>12925000
           IF BENTRY'(UNAME) <> CUSER, (8)  OR                 <<01878>>12930000
              BENTRY'(UACCT) <> CACCT, (8)  THEN               <<01878>>12935000
           BEGIN                                               <<01878>>12940000
              CC := CCG;    << Not the creator >>              <<01878>>12945000
              RETURN;                                          <<01878>>12950000
           END;                                                <<01878>>12955000
                                                               <<01878>>12960000
           << At this point we've found the match and are the>><<01878>>12965000
           << creator. Blank out the entry.                  >><<01878>>12970000
                                                               <<01878>>12975000
           ENTRY' := "  ";                                     <<01878>>12980000
           MOVE ENTRY'(1) := ENTRY', (LIDESIZE-1);             <<01878>>12985000
           ENTRY'(TYP) := NULL;                                <<01878>>12990000
           MOVE'TO'DSEG(LIDDST,I*LIDESIZE,@ENTRY',LIDESIZE);   <<01878>>12995000
           WRITEDSEG(LIDDST);                                  <<01878>>13000000
                                                               <<01878>>13005000
           CC := CCE;                                          <<01878>>13010000
           RETURN;                                             <<01878>>13015000
        END;       << Found a match >>                         <<01878>>13020000
     END                                                       <<01878>>13025000
   UNTIL (I := I + 1) > MAX;                                   <<01878>>13030000
                                                               <<01878>>13035000
   << If we fall thru here, the logid was not found >>         <<01878>>13040000
                                                               <<01878>>13045000
   CC := CCL;                                                  <<01878>>13050000
                                                               <<01878>>13055000
END;              << Procedure DENTRY >>                       <<01878>>13060000
                                                                        13065000
                                                                        13070000
                                                                        13075000
$PAGE                                                          <<01878>>13080000
PROCEDURE AENTRY(NEWENTRY');                                   <<01878>>13085000
   ARRAY NEWENTRY';                                            <<01878>>13090000
   OPTION INTERNAL,UNCALLABLE;                                 <<01878>>13095000
                                                               <<01878>>13100000
   << NEWENTRY' is in the format of an entry for the LIDTAB. >><<01878>>13105000
                                                               <<01878>>13110000
                                                                        13115000
<< This procedure adds entries to the Logging Identifier     >><<01878>>13120000
<< Table (LIDTAB).                                           >><<01878>>13125000
<<                                                           >><<01878>>13130000
<<    DB must be at stack.                                   >><<01878>>13135000
<< RETURNS:                                                  >><<01878>>13140000
<<     CCL if entry not added (no room).                     >><<01878>>13145000
<<     CCE if entry added to LIDTAB.                         >><<01878>>13150000
<<     CCG if entry already in LIDTAB.                       >><<01878>>13155000
<<                                                           >><<01878>>13160000
<<                                                           >><<01878>>13165000
BEGIN                                                                   13170000
   BYTE ARRAY NEWENTRY(*) = NEWENTRY';                         <<01878>>13175000
                                                                        13180000
   INTEGER STATUS' = Q-1;                                               13185000
   INTEGER I,MAX;                                                       13190000
                                                               <<01878>>13195000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<01878>>13200000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      13205000
                                                               <<01878>>13210000
   << Get the max # entries in the LIDTAB. >>                  <<01878>>13215000
                                                               <<01878>>13220000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<01878>>13225000
                                                                        13230000
   I:=0;                                                                13235000
   DO                                                                   13240000
   BEGIN                     <<SEARCH FOR LOGGING IDENTIFIER>>          13245000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,EBASE+I*LIDESIZE,LIDESIZE);<<01878>>13250000
  END                                                          <<01878>>13255000
     UNTIL ( (BENTRY'(LID) = NEWENTRY(LID), (8))  LAND         <<01878>>13260000
          (0<=INTEGER(ENTRY'(TYP).TYP'CURRENT)<=MAX'TYP'FIELD))<<01878>>13265000
           OR (I := I + 1) >= MAX;                             <<01878>>13270000
   IF I >= MAX THEN                                            <<01878>>13275000
   BEGIN                                   <<NOT THERE, GOOD>>          13280000
      <<FIND A FREE ENTRY>>                                             13285000
      I:=0;                                                             13290000
      DO                                                                13295000
      BEGIN                                                             13300000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,EBASE+I*LIDESIZE,LIDESIZE);<<01878>>13305000
      END UNTIL ENTRY'(TYP) = NULL OR (I:=I+1) >= MAX;         <<01878>>13310000
      IF I >= MAX THEN                                         <<01878>>13315000
      BEGIN                                      <<NONE FREE>>          13320000
         CC:=CCL;                                                       13325000
         RETURN;                                                        13330000
      END;                                                              13335000
      << OK -- build entry and add to table >>                 <<01878>>13340000
      WHO(,,,NEWENTRY(UNAME),,NEWENTRY(UACCT));                <<01878>>13345000
     MOVE'TO'DSEG(LIDDST,EBASE+I*LIDESIZE,@NEWENTRY',LIDESIZE);<<01878>>13350000
   END                                                                  13355000
   ELSE                                                                 13360000
   BEGIN     << Opps...entry already there >>                  <<01878>>13365000
      CC:=CCG;                                                          13370000
      RETURN;                                                           13375000
   END;                                                                 13380000
   WRITEDSEG(LIDDST);                                                   13385000
   CC:=CCE;                                                             13390000
END;                                                                    13395000
$PAGE "Table Utilities"                                        <<01878>>13400000
PROCEDURE DEPOSIT'FILENAME(STRING,NAME,LOCK,GROUP',ACCT');     <<01878>>13405000
   BYTE ARRAY STRING,NAME,LOCK,GROUP',ACCT';                   <<01878>>13410000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01878>>13415000
                                                               <<01878>>13420000
BEGIN                                                          <<01878>>13425000
<<                                                           >><<01878>>13430000
<< Will take the fully qualified filename found in STRING,   >><<01878>>13435000
<< and deposit it's subparts into the four component strings.>><<01878>>13440000
<< If the subpart is not found, the component string will be >><<01878>>13445000
<< blanked out.                                              >><<01878>>13450000
<< DB must be at stack.                                      >><<01878>>13455000
                                                               <<01878>>13460000
                                                               <<01878>>13465000
BYTE POINTER                                                   <<01878>>13470000
   BPS0    =  S-0,                                             <<01878>>13475000
   PTR;                                                        <<01878>>13480000
                                                               <<01878>>13485000
                                                               <<01878>>13490000
MOVE NAME := "        ";                                       <<01878>>13495000
MOVE LOCK := "        ";                                       <<01878>>13500000
MOVE GROUP' := "        ";                                     <<01878>>13505000
MOVE ACCT' := "        ";                                      <<01878>>13510000
                                                               <<01878>>13515000
MOVE NAME := STRING WHILE AN,0;                                <<01878>>13520000
IF BPS0 = "/" THEN                                             <<01878>>13525000
   BEGIN           << Lockword >>                              <<01878>>13530000
   @PTR := @BPS0 + 1;                                          <<01878>>13535000
   DDEL;                                                       <<01878>>13540000
   MOVE LOCK := PTR WHILE AN,0;                                <<01878>>13545000
   END;                                                        <<01878>>13550000
                                                               <<01878>>13555000
IF BPS0 = "." THEN                                             <<01878>>13560000
   BEGIN           << Group >>                                 <<01878>>13565000
   @PTR := @BPS0 + 1;                                          <<01878>>13570000
   DDEL;                                                       <<01878>>13575000
   MOVE GROUP' := PTR WHILE AN,0;                              <<01878>>13580000
                                                               <<01878>>13585000
   IF BPS0 = "." THEN                                          <<01878>>13590000
      BEGIN        << Account >>                               <<01878>>13595000
      @PTR := @BPS0 + 1;                                       <<01878>>13600000
      DDEL;                                                    <<01878>>13605000
      MOVE ACCT' := PTR WHILE AN,0;                            <<01878>>13610000
      END;                                                     <<01878>>13615000
   END;                                                        <<01878>>13620000
                                                               <<01878>>13625000
DDEL;                                                          <<01878>>13630000
END;         << Procedure DEPOSIT'FILENAME >>                  <<01878>>13635000
$PAGE                                                          <<01878>>13640000
PROCEDURE EXTRACT'FILENAME(FILENAME,NAME,LOCK,GROUP',ACCT');   <<01878>>13645000
   BYTE ARRAY FILENAME,NAME,LOCK,GROUP',ACCT';                 <<01878>>13650000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01878>>13655000
                                                               <<01878>>13660000
BEGIN                                                          <<01878>>13665000
<<                                                           >><<01878>>13670000
<< Will extract the subparts of a file name and create the   >><<01878>>13675000
<< fully qualified filename. If any of the subparts are blank>><<01878>>13680000
<< then, that subpart will be missing from the filename.     >><<01878>>13685000
<< DB must be at stack.                                      >><<01878>>13690000
<<                                                           >><<01878>>13695000
                                                               <<01878>>13700000
                                                               <<01878>>13705000
FILENAME := " ";                                               <<01878>>13710000
MOVE FILENAME(1) := FILENAME, (35);                            <<01878>>13715000
                                                               <<01878>>13720000
IF NAME = " " THEN RETURN;                                     <<01878>>13725000
                                                               <<01878>>13730000
IF NAME(7) <> " "                                              <<01878>>13735000
   THEN MOVE FILENAME := NAME, (8), 2                          <<01878>>13740000
ELSE MOVE FILENAME := NAME WHILE AN, 1;                        <<01878>>13745000
                                                               <<01878>>13750000
IF LOCK <> " " THEN                                            <<01878>>13755000
   BEGIN       << Lockword was specified >>                    <<01878>>13760000
   MOVE * := "/", 2;                                           <<01878>>13765000
   IF LOCK(7) <> " "                                           <<01878>>13770000
      THEN MOVE * := LOCK, (8), 2                              <<01878>>13775000
   ELSE MOVE * := LOCK WHILE AN,1;                             <<01878>>13780000
   END;                                                        <<01878>>13785000
                                                               <<01878>>13790000
IF GROUP' = " " THEN RETURN;                                   <<01878>>13795000
                                                               <<01878>>13800000
MOVE * := ".", 2;                                              <<01878>>13805000
IF GROUP'(7) <> " "                                            <<01878>>13810000
   THEN MOVE * := GROUP', (8), 2                               <<01878>>13815000
ELSE MOVE * := GROUP' WHILE AN, 1;                             <<01878>>13820000
                                                               <<01878>>13825000
IF ACCT' = " " THEN RETURN;                                    <<01878>>13830000
                                                               <<01878>>13835000
MOVE * := ".", 2;                                              <<01878>>13840000
IF ACCT'(7) <> " "                                             <<01878>>13845000
   THEN MOVE * := ACCT', (8), 2                                <<01878>>13850000
ELSE MOVE * := ACCT' WHILE AN;                                 <<01878>>13855000
                                                               <<01878>>13860000
END;           << Procedure EXTRACT'FILENAME >>                <<01878>>13865000
$PAGE                                                          <<01878>>13870000
LOGICAL PROCEDURE ALTER'LID'ENTRY(LOGID',PASS',FILENAME,TYPE');<<01878>>13875000
   VALUE TYPE';                                                <<01878>>13880000
   BYTE ARRAY LOGID',PASS',FILENAME;                           <<01878>>13885000
   INTEGER TYPE';                                              <<01878>>13890000
   OPTION VARIABLE,UNCALLABLE;                                 <<01878>>13895000
                                                               <<01878>>13900000
BEGIN                                                          <<01878>>13905000
<<                                                           >><<01878>>13910000
<< Will find the specified entry in the LIDTAB and alter any >><<01878>>13915000
<< of the specified fields.                                  >><<01878>>13920000
<< DB must be at stack.                                      >><<01878>>13925000
<<                                                           >><<01878>>13930000
                                                               <<01878>>13935000
INTEGER                                                        <<01878>>13940000
   MAX,            << Max # entries in the LIDTAB            >><<01878>>13945000
   I;              << Current entry # in the LIDTAB          >><<01878>>13950000
                                                               <<01878>>13955000
LOGICAL                                                        <<01878>>13960000
   PMAP  = Q-4,    << Parameter mask                         >><<01878>>13965000
   FOUND;          << TRUE if logid found in LIDTAB          >><<01878>>13970000
                                                               <<01878>>13975000
ARRAY ENTRY'(0:LIDESIZE-1) = Q;                                <<01878>>13980000
BYTE ARRAY BENTRY'(*) = ENTRY';                                <<01878>>13985000
                                                               <<01878>>13990000
                                                               <<01878>>13995000
ALTER'LID'ENTRY := FALSE;                                      <<01878>>14000000
                                                               <<01878>>14005000
<< Get the max # entries in the LIDTAB >>                      <<01878>>14010000
                                                               <<01878>>14015000
MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                        <<01878>>14020000
                                                               <<01878>>14025000
FOUND := FALSE;                                                <<01878>>14030000
I := 1;                                                        <<01878>>14035000
                                                               <<01878>>14040000
<< Now search the LIDTAB for the specified logid >>            <<01878>>14045000
                                                               <<01878>>14050000
DO                                                             <<01878>>14055000
   BEGIN                                                       <<01878>>14060000
   MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);         <<01878>>14065000
   FOUND := COMPSTRING(BENTRY'(LID),LOGID',8);                 <<01878>>14070000
   IF ENTRY'(TYP) = NULL  THEN FOUND := FALSE;                 <<01878>>14075000
   END                                                         <<01878>>14080000
UNTIL  FOUND OR (I := I+1) > MAX;                              <<01878>>14085000
                                                               <<01878>>14090000
IF NOT FOUND THEN RETURN;                                      <<01878>>14095000
                                                               <<01878>>14100000
<< We have now found the entry, now update the proper fields.>><<01878>>14105000
                                                               <<01878>>14110000
IF PMAP.(13:1)         << Password field >>                    <<01878>>14115000
   THEN MOVE BENTRY'(PW) := PASS', (8);                        <<01878>>14120000
                                                               <<01878>>14125000
IF PMAP.(14:1)         << File name fields >>                  <<01878>>14130000
   THEN BEGIN                                                  <<01882>>14135000
      << only stuff full filename into LID entry if the >>     <<01882>>14135500
      << type is DISC, so as not to blank out GRP and ACCT. >> <<01882>>14136000
      IF PMAP.(15:1)=1 AND TYPE'=DISC THEN                     <<01882>>14136500
         DEPOSIT'FILENAME(FILENAME,BENTRY'(FNAME'),            <<01882>>14137000
            BENTRY'(LW),BENTRY'(FGROUP),BENTRY'(FACCT))        <<01882>>14137500
      ELSE BEGIN  << for non-DISC, just stuff file name >>     <<01882>>14138000
         MOVE BENTRY'(FNAME'):="        ";                     <<01882>>14138500
         MOVE BENTRY'(FNAME'):= FILENAME WHILE AN;             <<01882>>14139000
         END;                                                  <<01882>>14139500
   END;                                                        <<01882>>14140000
                                                               <<01878>>14145000
IF PMAP.(15:1)         << Type field >>                        <<01878>>14150000
   THEN                                                        <<01878>>14155000
      BEGIN                                                             14160000
      ENTRY'(TYP):=TYPE'; << TYPE' must already be set up>>    <<01878>>14165000
      END;                << as a full word.            >>     <<01878>>14170000
                                                               <<01878>>14175000
                                                               <<01878>>14180000
                                                               <<01878>>14185000
<< Now update the LIDTAB - and it's disc copy.           >>    <<01878>>14190000
                                                               <<01878>>14195000
MOVE'TO'DSEG(LIDDST,I*LIDESIZE,@ENTRY',LIDESIZE);              <<01878>>14200000
WRITEDSEG(LIDDST);                                             <<01878>>14205000
ALTER'LID'ENTRY := TRUE;                                       <<01878>>14210000
                                                               <<01878>>14215000
END;           << Procedure ALTER'LID'ENTRY >>                 <<01878>>14220000
LOGICAL PROCEDURE COMPSTRING(STRING1,STRING2,MAXLEN);          <<01878>>14225000
VALUE MAXLEN;                                                  <<01878>>14230000
INTEGER MAXLEN;                                                <<01878>>14235000
BYTE ARRAY STRING1;                                            <<01878>>14240000
BYTE ARRAY STRING2;                                            <<01878>>14245000
OPTION INTERNAL;                                               <<01878>>14250000
                                                               <<01878>>14255000
BEGIN                                                          <<01878>>14260000
   BYTE BYTE1,BYTE2;                                           <<01878>>14265000
   INTEGER LEN1,LEN2;                                          <<01878>>14270000
   BYTE POINTER BPS0 = S-0;                                    <<01878>>14275000
                                                               <<01878>>14280000
                                                               <<01878>>14285000
   BYTE1:=STRING1(MAXLEN);                                     <<01878>>14290000
   BYTE2:=STRING2(MAXLEN);                                     <<01878>>14295000
   STRING1(MAXLEN) := " ";                                     <<01878>>14300000
   STRING2(MAXLEN) := " ";                                    <<<01878>>14305000
   MOVE STRING1:=STRING1 WHILE AN,0;                           <<01878>>14310000
   LEN1:=@BPS0-@STRING1;                                       <<01878>>14315000
   MOVE STRING2:=STRING2 WHILE AN,0;                           <<01878>>14320000
   LEN2:=@BPS0-@STRING2;                                       <<01878>>14325000
   STRING1(MAXLEN):=BYTE1;                                     <<01878>>14330000
   STRING2(MAXLEN):=BYTE2;                                     <<01878>>14335000
   IF (STRING1 <> STRING2,(LEN1) ) OR (LEN1 <> LEN2) THEN      <<01878>>14340000
   COMPSTRING:=FALSE ELSE COMPSTRING:=TRUE;                    <<01878>>14345000
END;                                                           <<01878>>14350000
$TITLE        "USER LOGGING CI INTERFACE"                               14355000
$PAGE                                                          <<01878>>14360000
                                                                        14365000
PROCEDURE CXGETLOG(PARMSP,ERRNUM,PARMNUM);                              14370000
BYTE ARRAY PARMSP;                                                      14375000
INTEGER ERRNUM;                                                         14380000
INTEGER PARMNUM;                                                        14385000
OPTION PRIVILEGED,UNCALLABLE;                                           14390000
                                                                        14395000
                                                               <<01878>>14400000
<<    This procedure is the command executor for the         >><<01878>>14405000
<<    :GETLOG command.                                       >><<01878>>14410000
<<    Syntax is:                                             >><<01878>>14415000
<<        :GETLOG logid;LOG=logfile,{DISC/TAPE/SDISC/CTAPE}  >><<01878>>14420000
<<                [;PASS=password] [;{AUTO/NOAUTO}]          >><<01878>>14425000
<<                                                           >><<01878>>14430000
<< In order to allow the :CHANGELOG command on this logid,   >><<01878>>14435000
<< the file name must end in "001". If the AUTO/NOAUTO       >><<01878>>14440000
<< parameter is not specified, then NOAUTO will default. If  >><<01878>>14445000
<< AUTO is specified on a serial log file, this fact will be >><<01878>>14450000
<< saved in case the log file is changed to DISC (serial log >><<01878>>14455000
<< files do not need AUTO since they have the ability to     >><<01878>>14460000
<< have a reel switch performed on their behalf). If the     >><<01878>>14465000
<< file name does not end in "001" then AUTO will not be     >><<01878>>14470000
<< allowed, since the logid will be denied the changelog     >><<01878>>14475000
<< capability.                                               >><<01878>>14480000
                                                               <<01878>>14485000
                                                               <<01878>>14490000
                                                                        14495000
BEGIN                                                                   14500000
DEFINE                                                         <<01878>>14505000
   SEMI  = ";" #;                                              <<01878>>14510000
                                                                        14515000
   BYTE POINTER  PARMPTR,DELIMPTR;                             <<01878>>14520000
   BYTE POINTER                                                <<01878>>14525000
      FNAMEPTR,       <<points to actual filename >>           <<01878>>14530000
      TDELIMPTR,      <<temporary delimeter pointer >>         <<01878>>14535000
      AUTOPTR,        << points to "AUTO"  parm     >>         <<01878>>14540000
      NOAUTOPTR;      << points to "NOAUTO" parm    >>         <<01878>>14545000
                                                               <<01878>>14550000
   LOGICAL                                                     <<01878>>14555000
      CHANGE'ALLOWED := FALSE;                                 <<01878>>14560000
   INTEGER LEN,I;                                                       14565000
   LOGICAL TYPE';                                              <<01878>>14570000
   LOGICAL CRLF;                                               <<01878>>14575000
   LOGICAL LOGF     := FALSE,  <<true if LOG keyword found>>   <<01878>>14580000
           PASSF     := FALSE, <<true if PASS keyword found>>  <<01878>>14585000
           AUTOF     := FALSE,                                 <<01878>>14590000
           NOAUTOF   := FALSE;                                 <<01878>>14595000
   BYTE ARRAY FILENAME(0:35);                                  <<01878>>14600000
   BYTE ARRAY BPASS(0:7);                                      <<01878>>14605000
   BYTE ARRAY STOPPER(0:1) = Q;                                         14610000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<01878>>14615000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      14620000
   EQUATE KEYLISTSIZE = 26;                                    <<01878>>14625000
                                                               <<01878>>14630000
   BYTE ARRAY KEYLISTP(*) = PB :=                              <<01878>>14635000
               5,3,"LOG",                                      <<01878>>14640000
               6,4,"PASS",                                     <<01878>>14645000
            6,4,"AUTO",                                                 14650000
            8,6,"NOAUTO",                                               14655000
            0;                                                          14660000
   BYTE ARRAY KEYLIST(0:KEYLISTSIZE -1);                       <<01878>>14665000
                                                               <<01878>>14670000
   PARMNUM := 0;                                               <<01878>>14675000
   CRLF := [8/%15,8/%12];<< CR,LF >>                           <<01878>>14680000
   STOPPER := 0;                                               <<01878>>14685000
   STOPPER(1) := 0;                                            <<01878>>14690000
   MOVE BPASS := "        ";                                   <<01878>>14695000
   ENTRY':="  ";                                                        14700000
   MOVE ENTRY'(1):=ENTRY',(LIDESIZE-1);                                 14705000
   MOVE KEYLIST := KEYLISTP, (KEYLISTSIZE);                    <<01878>>14710000
                                                               <<01878>>14715000
   SCAN PARMSP UNTIL CRLF,1;                                   <<01878>>14720000
   MOVE * := STOPPER ,(1);                                     <<01878>>14725000
   UPSHIFT'(PARMSP);                                                    14730000
                                                               <<01878>>14735000
   << PARMSP points to beginning of string, parmptr will >>    <<01878>>14740000
   << point to first character in the parm, delimptr     >>    <<01878>>14745000
   << points to delimeter after the parm.                >>    <<01878>>14750000
                                                               <<01878>>14755000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              14760000
   @PARMSP := @PARMPTR;     << Points to logid parameter >>    <<01878>>14765000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)                <<01878>>14770000
      THEN RETURN;                                             <<01878>>14775000
   PARMNUM := PARMNUM + 1;                                     <<01878>>14780000
   MOVE BENTRY'(LID) := PARMPTR, (LEN);                        <<01878>>14785000
                                                               <<01878>>14790000
   DO                                                          <<01878>>14795000
     BEGIN                                                     <<01878>>14800000
        IF DELIMPTR <> SEMI THEN                               <<01878>>14805000
        BEGIN                                                  <<01878>>14810000
           ERRNUM := EXPECTEDSEMI;                             <<01878>>14815000
           CIERR(ERRNUM,DELIMPTR);                             <<01878>>14820000
           RETURN;                                             <<01878>>14825000
        END;                                                   <<01878>>14830000
                                                               <<01878>>14835000
        LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);            <<01878>>14840000
        I := SEARCH(PARMPTR,LEN,KEYLIST);                      <<01878>>14845000
        CASE I  OF                                             <<01878>>14850000
        BEGIN                                                  <<01878>>14855000
           BEGIN             <<not found>>                     <<01878>>14860000
            IF PARMNUM >=4 THEN                                         14865000
              BEGIN          <<all parms found - error>>       <<01878>>14870000
                 ERRNUM := EXTRAPARM;                          <<01878>>14875000
                 CIERR(ERRNUM,PARMPTR);                        <<01878>>14880000
                 RETURN;                                       <<01878>>14885000
              END;                                             <<01878>>14890000
              ERRNUM := INVALIDPARM;  <<expected "LOG","PASS">><<01878>>14895000
              CIERR(ERRNUM,PARMPTR);  <<"AUTO" OR "NOAUTO" >>  <<01878>>14900000
              RETURN;                                          <<01878>>14905000
           END;              <<not found>>                     <<01878>>14910000
                                                               <<01878>>14915000
           BEGIN                  <<"LOG">>                    <<01878>>14920000
              IF LOGF THEN                                     <<01878>>14925000
                 BEGIN         << Already found >>             <<01878>>14930000
                 CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);            <<01878>>14935000
                 RETURN;                                       <<01878>>14940000
                 END;                                          <<01878>>14945000
                                                               <<01878>>14950000
              @TDELIMPTR := @DELIMPTR;                         <<01878>>14955000
              @FNAMEPTR := @PARMPTR;                           <<01878>>14960000
              LOGF := PARSELOG(PARMPTR,DELIMPTR,FILENAME,TYPE',<<01878>>14965000
                               CHANGE'ALLOWED,ERRNUM);         <<01878>>14970000
              IF NOT LOGF THEN RETURN;                         <<01878>>14975000
              PARMNUM := PARMNUM + 1;                          <<01878>>14980000
           END;                   <<"LOG">>                    <<01878>>14985000
                                                               <<01878>>14990000
           BEGIN                  <<"PASS">>                   <<01878>>14995000
              IF PASSF THEN                                    <<01878>>15000000
                 BEGIN         << Already found >>             <<01878>>15005000
                 CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);            <<01878>>15010000
                 RETURN;                                       <<01878>>15015000
                 END;                                          <<01878>>15020000
                                                               <<01878>>15025000
              PASSF :=PARSEPASS(PARMPTR,DELIMPTR,BPASS,ERRNUM);<<01878>>15030000
              IF NOT PASSF THEN RETURN;                        <<01878>>15035000
              PARMNUM := PARMNUM + 1;                          <<01878>>15040000
           END;                   <<"PASS">>                   <<01878>>15045000
            BEGIN       <<AUTO>>                                        15050000
            IF AUTOF THEN                                               15055000
               BEGIN                                                    15060000
               CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);                       15065000
               RETURN;                                                  15070000
               END;                                                     15075000
            @AUTOPTR := @PARMPTR;                              <<01878>>15080000
            AUTOF:=TRUE;                                                15085000
            PARMNUM:=PARMNUM+1;                                         15090000
            END;                                                        15095000
                                                                        15100000
            BEGIN      <<NOAUTO>>                                       15105000
            IF NOAUTOF THEN                                             15110000
               BEGIN                                                    15115000
               CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);                       15120000
               RETURN;                                                  15125000
               END;                                                     15130000
            @NOAUTOPTR := @PARMPTR;                            <<01878>>15135000
            NOAUTOF:=TRUE;                                              15140000
            END;                                                        15145000
                                                               <<01878>>15150000
        END;                 <<case>>                          <<01878>>15155000
                                                               <<01878>>15160000
     END                                                       <<01878>>15165000
   UNTIL DELIMPTR = STOPPER;                                   <<01878>>15170000
                                                               <<01878>>15175000
   IF NOAUTOF AND AUTOF THEN                                   <<01878>>15180000
      BEGIN                                                    <<01878>>15185000
         CIERR(ERRNUM := -AUTONOAUTOSPEC,NOAUTOPTR);           <<01878>>15190000
      END;                                                     <<01878>>15195000
   IF NOT CHANGE'ALLOWED AND AUTOF THEN                        <<01878>>15200000
      BEGIN                                                    <<01878>>15205000
         CIERR (ERRNUM:= CANTBEAUTOAND001,AUTOPTR);            <<01878>>15210000
         RETURN;                                               <<01878>>15215000
      END;                                                     <<01878>>15220000
                                                                        15225000
   IF LOGF THEN                                                         15230000
   BEGIN                                                                15235000
      DEPOSIT'FILENAME(FILENAME,BENTRY'(FNAME'),BENTRY'(LW),   <<01878>>15240000
                       BENTRY'(FGROUP),BENTRY'(FACCT));        <<01878>>15245000
      ENTRY'(TYP) := TYPE';                                    <<01878>>15250000
      IF CHANGE'ALLOWED THEN                                   <<01878>>15255000
         ENTRY'(TYP).TYP'ALLOW'CHANGELOG := TRUE               <<01878>>15260000
      ELSE                                                     <<01878>>15265000
         BEGIN                                                 <<01878>>15270000
         ENTRY'(TYP).TYP'ALLOW'CHANGE := FALSE;                <<01878>>15275000
         IF NOAUTOF THEN                                       <<01878>>15280000
            CIERR(ERRNUM := -ONLY1MEMBERINSET,FNAMEPTR)       <<<01878>>15285000
         ELSE                                                  <<01878>>15290000
            CIERR(ERRNUM := -ONLY1MEMBERINSET,FNAMEPTR);       <<01878>>15295000
         END;                                                  <<01878>>15300000
                                                               <<01878>>15305000
      IF PASSF THEN MOVE BENTRY'(PW) := BPASS, (8);            <<01878>>15310000
                                                               <<01878>>15315000
      IF AUTOF THEN                                            <<01878>>15320000
         ENTRY'(TYP).TYP'ALLOW'AUTO := TRUE                    <<01878>>15325000
      ELSE                                                     <<01878>>15330000
         ENTRY'(TYP).TYP'ALLOW'AUTO := FALSE;                  <<01878>>15335000
                                                               <<01878>>15340000
      AENTRY(ENTRY');                                          <<01878>>15345000
      IF > THEN                                                         15350000
      BEGIN                                                             15355000
         ERRNUM:=DUPLICATE;                      <<DUP ENTRY>>          15360000
         CIERR(ERRNUM,PARMSP);                                          15365000
         RETURN;                                                        15370000
      END;                                                              15375000
      IF < THEN                                                         15380000
      BEGIN      <<MAX NUMBER LOGID'S EXCEEDED>>                        15385000
         ERRNUM:=MAXEXCEEDED;                                           15390000
         CIERR(ERRNUM,PARMSP);                                          15395000
         RETURN;                                                        15400000
      END;                                                              15405000
   END                                                                  15410000
   ELSE CIERR(ERRNUM:=EXPECTEDLNAME,DELIMPTR);                 <<01878>>15415000
END;                                                                    15420000
                                                                        15425000
                                                                        15430000
$PAGE                                                          <<01878>>15435000
PROCEDURE CXRELLOG(PARMSP,ERRNUM,PARMNUM);                              15440000
BYTE ARRAY PARMSP;                                                      15445000
INTEGER ERRNUM;                                                         15450000
INTEGER PARMNUM;                                                        15455000
OPTION PRIVILEGED,UNCALLABLE;                                           15460000
                                                                        15465000
                                                               <<01878>>15470000
<<    This procedure is the command executor for the         >><<01878>>15475000
<<    :RELLOG command.                                       >><<01878>>15480000
<<    Syntax is:                                             >><<01878>>15485000
<<        :RELLOG logid                                      >><<01878>>15490000
                                                                        15495000
                                                                        15500000
BEGIN                                                                   15505000
                                                               <<01878>>15510000
                                                                        15515000
                                                                        15520000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>15525000
   INTEGER LEN,DUMMY;                                          <<01878>>15530000
   BYTE ARRAY STOPPER(0:1) = Q;  LOGICAL TEST;                          15535000
                                                               <<01878>>15540000
                                                               <<01878>>15545000
   TEST.(0:8):=%15;  TEST.(8:8):=%15; STOPPER:=0; STOPPER(1):=0;        15550000
   SCAN PARMSP UNTIL TEST,1;                                            15555000
   MOVE * := STOPPER, (1);                                     <<01878>>15560000
   UPSHIFT'(PARMSP);                                                    15565000
   PARMNUM:=0;                                                          15570000
                                                               <<01878>>15575000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              15580000
   @PARMSP := @PARMPTR;     << Points to logid parameter >>    <<01878>>15585000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)                <<01878>>15590000
      THEN RETURN;                                             <<01878>>15595000
                                                               <<01878>>15600000
   PARMNUM := PARMNUM + 1;                                     <<01878>>15605000
   IF DELIMPTR <> STOPPER THEN                                 <<01878>>15610000
   BEGIN                                                       <<01878>>15615000
      ERRNUM := ONEPARM;                                       <<01878>>15620000
      CIERR(ERRNUM,DELIMPTR);                                  <<01878>>15625000
      RETURN;                                                  <<01878>>15630000
   END;                                                        <<01878>>15635000
                                                               <<01878>>15640000
                                                               <<01878>>15645000
   << Check if there is an active process for this logid. >>   <<01878>>15650000
                                                               <<01878>>15655000
   IF FINDLOG(PARMPTR,DUMMY)  THEN                             <<01878>>15660000
   BEGIN         << Active process >>                          <<01878>>15665000
      ERRNUM := -BUSY;                                         <<01878>>15670000
      CIERR(ERRNUM,PARMSP);                                    <<01878>>15675000
      RETURN;                                                  <<01878>>15680000
   END;                                                        <<01878>>15685000
                                                               <<01878>>15690000
   << Try to delete the entry from the LID table >>            <<01878>>15695000
                                                               <<01878>>15700000
   DENTRY(PARMPTR,LEN);                                        <<01878>>15705000
   IF > THEN                                                   <<01878>>15710000
   BEGIN        << Not the creator >>                          <<01878>>15715000
      ERRNUM := SECURITYVIOL;                                  <<01878>>15720000
      CIERR(ERRNUM,PARMSP);                                    <<01878>>15725000
      RETURN;                                                  <<01878>>15730000
   END                                                         <<01878>>15735000
   ELSE                                                        <<01878>>15740000
      IF < THEN                                                <<01878>>15745000
      BEGIN     << Logid not found in LID table >>             <<01878>>15750000
         ERRNUM := -NIXLOGID;                                  <<01878>>15755000
         CIERR(ERRNUM,PARMSP);                                 <<01878>>15760000
         RETURN;                                               <<01878>>15765000
      END;                                                     <<01878>>15770000
                                                               <<01878>>15775000
   << If we get this far, the entry has been released  >>      <<01878>>15780000
                                                               <<01878>>15785000
END;         << CXRELLOG >>                                    <<01878>>15790000
                                                                        15795000
                                                                        15800000
                                                                        15805000
                                                                        15810000
                                                                        15815000
$PAGE                                                          <<01878>>15820000
PROCEDURE CXALTLOG(PARMSP,ERRNUM,PARMNUM);                              15825000
BYTE ARRAY PARMSP;                                                      15830000
INTEGER ERRNUM;                                                         15835000
INTEGER PARMNUM;                                                        15840000
OPTION PRIVILEGED,UNCALLABLE;                                           15845000
                                                                        15850000
                                                                        15855000
                                                               <<01878>>15860000
<<     This procedure is the command executor for the        >><<01878>>15865000
<<     :ALTLOG command.                                      >><<01878>>15870000
<<     Syntax is:                                            >><<01878>>15875000
<<      :ALTLOG logid [;LOG=logfile,{DISC/TAPE/SDISC/CTAPE}] >><<01878>>15880000
<<        [;PASS=password] [;{AUTO/NOAUTO}]                  >><<01878>>15885000
<<                                                           >><<01878>>15890000
<< In order to allow the :CHANGELOG command on this logid,   >><<01878>>15895000
<< the file name must end in "001". If the AUTO/NOAUTO       >><<01878>>15900000
<< parameter is not specified, then NOAUTO will default. If  >><<01878>>15905000
<< AUTO is specified on a serial log file, this fact will be >><<01878>>15910000
<< save in case the log file is changed to DISC (serial log  >><<01878>>15915000
<< files do not need AUTO since they have the ability to     >><<01878>>15920000
<< have a reel switch performed on their behalf). If the     >><<01878>>15925000
<< file name does not end in "001" then AUTO will not be     >><<01878>>15930000
<< allowed, since the logid will be denied the changelog     >><<01878>>15935000
<< capability.                                               >><<01878>>15940000
                                                                        15945000
BEGIN                                                                   15950000
   DEFINE                                                      <<01878>>15955000
      SEMI  =  ";"#;                                           <<01878>>15960000
                                                                        15965000
                                                                        15970000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>15975000
   LOGICAL                                                     <<01878>>15980000
      LOGF      := FALSE,       <<true if ;LOG= found>>        <<01878>>15985000
      PASSF     := FALSE,            <<true if ;PASS= found>>  <<01878>>15990000
      CHANGE'ALLOWED := FALSE,                                 <<01878>>15995000
      NOAUTOF   := FALSE,                                      <<01878>>16000000
      AUTOF     := FALSE;                                      <<01878>>16005000
   INTEGER I,LEN,DUMMY;                                        <<01878>>16010000
   LOGICAL TYPE',OLDTYPE';                                     <<01878>>16015000
   BYTE POINTER                                                <<01878>>16020000
      FNAMEPTR,   <<points to beginning of file name >>        <<01878>>16025000
      AUTOPTR,    <<points to beginning of "AUTO" parm >>      <<01878>>16030000
      NOAUTOPTR,  <<points to beginning of "NOAUTO"    >>      <<01878>>16035000
      TDELIMPTR;  <<temporary delimeter pointer        >>      <<01878>>16040000
                                                               <<01878>>16045000
   BYTE ARRAY STOPPER(0:1) = Q; LOGICAL CRCR;                  <<01878>>16050000
   BYTE ARRAY FILENAME(0:35);                                  <<01878>>16055000
   BYTE ARRAY LOGID'(0:8);                                     <<01878>>16060000
   BYTE ARRAY BPASS(0:7);                                      <<01878>>16065000
   BYTE ARRAY USER'NAME(0:7);                                  <<01878>>16070000
   BYTE ARRAY USER'ACCT(0:7);                                  <<01878>>16075000
   BYTE ARRAY CACCT(0:7) = Q;                                           16080000
   BYTE ARRAY CGROUP(0:7) = Q;                                 <<01878>>16085000
   BYTE ARRAY CUSER(0:7) = Q;                                           16090000
                                                               <<01878>>16095000
   BYTE ARRAY KEYLISTP(*) = PB :=                              <<01878>>16100000
            5,3,"LOG",                                         <<01878>>16105000
            6,4,"PASS",                                        <<01878>>16110000
            6,4,"AUTO",                                                 16115000
            8,6,"NOAUTO",                                               16120000
            0;                                                 <<01878>>16125000
   EQUATE DICTLEN = 26;                                                 16130000
   BYTE ARRAY KEYLIST(0:DICTLEN-1);                            <<01878>>16135000
                                                               <<01878>>16140000
                                                               <<01878>>16145000
   AUTOF:=NOAUTOF:=FALSE;                                               16150000
   MOVE KEYLIST := KEYLISTP, (DICTLEN);                        <<01878>>16155000
   LOGF := PASSF := FALSE;                                     <<01878>>16160000
   MOVE BPASS := "        ";                                   <<01878>>16165000
   MOVE LOGID' := "         ";                                 <<01878>>16170000
                                                               <<01878>>16175000
   CRCR := [8/%15,8/%15];  << 2 carriage returns >>            <<01878>>16180000
   STOPPER := 0;                                               <<01878>>16185000
   STOPPER(1) := 0;                                            <<01878>>16190000
   SCAN PARMSP UNTIL CRCR,1;                                   <<01878>>16195000
   MOVE * := STOPPER, (1);                                     <<01878>>16200000
   UPSHIFT'(PARMSP);                                                    16205000
   PARMNUM:=0;                                                          16210000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              16215000
   @PARMSP := @PARMPTR;     << Points to logid paramter >>     <<01878>>16220000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM) THEN RETURN;   <<01878>>16225000
                                                               <<01878>>16230000
   MOVE LOGID' := PARMPTR, (LEN);                              <<01878>>16235000
   PARMNUM:=PARMNUM+1;                                                  16240000
                                                               <<01878>>16245000
   FENTRY(LOGID',,,USER'NAME,USER'ACCT,OLDTYPE');              <<01878>>16250000
   IF > THEN                                                   <<01878>>16255000
      BEGIN          << Not found >>                           <<01878>>16260000
      CIERR(ERRNUM:=NIXLOGID,PARMSP);                          <<01878>>16265000
      RETURN;                                                  <<01878>>16270000
      END;                                                     <<01878>>16275000
   IF FINDLOG(LOGID',DUMMY) THEN  <<active logid>>             <<01878>>16280000
      BEGIN                                                    <<01878>>16285000
      CIERR(ERRNUM := LOGIDACTIVE,PARMSP);                     <<01878>>16290000
      RETURN;                                                  <<01878>>16295000
      END;                                                     <<01878>>16300000
                                                               <<01878>>16305000
   MOVE CACCT:="  ";                                                    16310000
   MOVE CACCT(1):=CACCT,(23);                                  <<01878>>16315000
   WHO(,,,CUSER,CGROUP,CACCT);                                 <<01878>>16320000
IF USER'NAME <> CUSER,(8) OR USER'ACCT <> CACCT,(8) THEN       <<01878>>16325000
   BEGIN                                                                16330000
      ERRNUM:=SECURITYVIOL;             <<SECURITY VIOLATION>>          16335000
      CIERR(ERRNUM,PARMSP);                                    <<01878>>16340000
      RETURN;                                                           16345000
   END;                                                                 16350000
                                                               <<01878>>16355000
TYPE' := OLDTYPE'; <<initialize TYPE', then modify >>          <<01878>>16360000
   DO                                                                   16365000
   BEGIN                                                                16370000
      IF DELIMPTR <> SEMI THEN                                 <<01878>>16375000
      BEGIN                                                    <<01878>>16380000
         <<invalid delimiter between keywords>>                <<01878>>16385000
         ERRNUM := EXPECTEDSEMI;                               <<01878>>16390000
         CIERR(ERRNUM,DELIMPTR);                               <<01878>>16395000
         RETURN;                                               <<01878>>16400000
      END;                                                     <<01878>>16405000
                                                               <<01878>>16410000
      LEN:=NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                         16415000
      I := SEARCH(PARMPTR,LEN,KEYLIST);                        <<01878>>16420000
      CASE I OF                                                <<01878>>16425000
      BEGIN                                                    <<01878>>16430000
         BEGIN               <<not found>>                     <<01878>>16435000
            IF PARMNUM >=4 THEN                                         16440000
            BEGIN            <<all found - error>>             <<01878>>16445000
               ERRNUM := EXTRAPARM;                            <<01878>>16450000
               CIERR(ERRNUM,PARMPTR);                          <<01878>>16455000
               RETURN;                                         <<01878>>16460000
            END;                                               <<01878>>16465000
            ERRNUM := INVALIDPARM;  <<expected             >>  <<01878>>16470000
            CIERR(ERRNUM,PARMPTR);  <<  "PASS" OR "LOG"    >>  <<01878>>16475000
            RETURN;                                            <<01878>>16480000
         END;                <<not found>>                     <<01878>>16485000
                                                               <<01878>>16490000
         BEGIN                    <<"LOG">>                    <<01878>>16495000
           IF LOGF THEN                                        <<01878>>16500000
              BEGIN         << Already found >>                <<01878>>16505000
              CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);               <<01878>>16510000
              RETURN;                                          <<01878>>16515000
              END;                                             <<01878>>16520000
                                                               <<01878>>16525000
           @TDELIMPTR := @DELIMPTR; << points at " = " >>      <<01878>>16530000
           @FNAMEPTR := @PARMPTR;                              <<01878>>16535000
           LOGF := PARSELOG(PARMPTR,DELIMPTR,FILENAME,TYPE',   <<01878>>16540000
                            CHANGE'ALLOWED,ERRNUM);            <<01878>>16545000
           IF NOT LOGF THEN RETURN;                            <<01878>>16550000
           PARMNUM := PARMNUM + 1;                             <<01878>>16555000
         END;                     <<"LOG">>                    <<01878>>16560000
                                                               <<01878>>16565000
         BEGIN                    <<"PASS">>                   <<01878>>16570000
           IF PASSF THEN                                       <<01878>>16575000
              BEGIN         << Already found >>                <<01878>>16580000
              CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);               <<01878>>16585000
              RETURN;                                          <<01878>>16590000
              END;                                             <<01878>>16595000
                                                               <<01878>>16600000
           PASSF := PARSEPASS(PARMPTR,DELIMPTR,BPASS,ERRNUM);  <<01878>>16605000
           IF NOT PASSF THEN RETURN;                           <<01878>>16610000
         PARMNUM := PARMNUM + 1;                               <<01878>>16615000
         END;                     <<"PASS">>                   <<01878>>16620000
                                                               <<01878>>16625000
         BEGIN       << "AUTO" >>                              <<01878>>16630000
         @AUTOPTR := @PARMPTR;  <<point at AUTO parm >>        <<01878>>16635000
         IF AUTOF THEN                                         <<01878>>16640000
            BEGIN                                              <<01878>>16645000
            CIERR(ERRNUM:=DUPKEYWORD,AUTOPTR);                 <<01878>>16650000
            RETURN;                                            <<01878>>16655000
            END;                                               <<01878>>16660000
                                                               <<01878>>16665000
         << If a new log file was specified (LOGF) and this  >><<01878>>16670000
         << new log file name is not in the proper format to >><<01878>>16675000
         << allow a changelog, then AUTO param. is bad.      >><<01878>>16680000
         << If AUTO was specifed without specifying a new log>><<01878>>16685000
         << file to be in the proper format - error.         >><<01878>>16690000
                                                               <<01878>>16695000
         IF (NOT LOGF LAND NOT OLDTYPE'.TYP'ALLOW'CHANGE) OR   <<01878>>16700000
            (LOGF LAND NOT CHANGE'ALLOWED) THEN                <<01878>>16705000
            BEGIN                                              <<01878>>16710000
            CIERR(ERRNUM := AUTOONFILENOGOOD,AUTOPTR);         <<01878>>16715000
            RETURN;                                            <<01878>>16720000
            END;                                               <<01878>>16725000
         AUTOF:=TRUE;                                          <<01878>>16730000
         PARMNUM:=PARMNUM+1;                                   <<01878>>16735000
         END;        << "AUTO" >>                              <<01878>>16740000
                                                                        16745000
         BEGIN      << "NOAUTO" >>                             <<01878>>16750000
         @NOAUTOPTR := @PARMPTR;                               <<01878>>16755000
         IF NOAUTOF THEN                                       <<01878>>16760000
            BEGIN                                              <<01878>>16765000
            CIERR(ERRNUM:=DUPKEYWORD,NOAUTOPTR);               <<01878>>16770000
            RETURN;                                            <<01878>>16775000
            END;                                               <<01878>>16780000
         NOAUTOF:=TRUE;                                        <<01878>>16785000
         END;       << "NOAUTO" >>                             <<01878>>16790000
                                                               <<01878>>16795000
      END;         << Case >>                                  <<01878>>16800000
                                                               <<01878>>16805000
   END                                                         <<01878>>16810000
  UNTIL DELIMPTR = STOPPER;                                    <<01878>>16815000
                                                               <<01878>>16820000
IF LOGF THEN  << specifying LOG= is like starting over with>>  <<01878>>16825000
              << a GETLOG because the links are broken now >>  <<01878>>16830000
BEGIN  << LOG= specified >>                                    <<01878>>16835000
  IF NOT CHANGE'ALLOWED AND AUTOF THEN                         <<01878>>16840000
     BEGIN                                                     <<01878>>16845000
        CIERR(ERRNUM := CANTBEAUTOAND001,AUTOPTR);             <<01878>>16850000
        RETURN;                                                <<01878>>16855000
     END;                                                      <<01878>>16860000
  IF NOT CHANGE'ALLOWED THEN                                   <<01878>>16865000
     BEGIN                                                     <<01878>>16870000
     CIERR(ERRNUM := -ONLY1MEMBERINSET,FNAMEPTR);              <<01878>>16875000
     TYPE'.TYP'ALLOW'CHANGE := FALSE;                          <<01878>>16880000
     TYPE'.TYP'ALLOW'AUTO := FALSE;                            <<01878>>16885000
      END                                                      <<01878>>16890000
  ELSE                                                         <<01878>>16895000
     TYPE'.TYP'ALLOW'CHANGE := TRUE;                           <<01878>>16900000
                                                               <<01878>>16905000
END;  << LOG= specified  >>                                    <<01878>>16910000
  IF NOAUTOF AND AUTOF THEN                                    <<01878>>16915000
     BEGIN                                                     <<01878>>16920000
     TYPE'.TYP'ALLOW'AUTO := FALSE;                            <<01878>>16925000
     CIERR(ERRNUM := -AUTONOAUTOSPEC,AUTOPTR);                 <<01878>>16930000
     END                                                       <<01878>>16935000
  ELSE                                                         <<01878>>16940000
     IF AUTOF THEN TYPE'.TYP'ALLOW'AUTO := TRUE                <<01878>>16945000
  ELSE  << Allow change must have been set in OLDTYPE' >>      <<01878>>16950000
        << and LOG= was not specified or log file     >>       <<01878>>16955000
        << ends with "001" (i.e. allow auto).         >>       <<01878>>16960000
     IF NOAUTOF THEN TYPE'.TYP'ALLOW'AUTO := FALSE;            <<01878>>16965000
                                                               <<01878>>16970000
IF PASSF AND LOGF                                              <<01878>>16975000
   THEN ALTER'LID'ENTRY(LOGID',BPASS,FILENAME,TYPE')           <<01878>>16980000
ELSE                                                           <<01878>>16985000
  IF PASSF AND NOT LOGF                                        <<01878>>16990000
     THEN ALTER'LID'ENTRY(LOGID',BPASS)                        <<01878>>16995000
  ELSE                                                         <<01878>>17000000
    IF NOT PASSF AND LOGF                                      <<01878>>17005000
       THEN ALTER'LID'ENTRY(LOGID',,FILENAME,TYPE');           <<01878>>17010000
                                                               <<01878>>17015000
                                                               <<01878>>17020000
                                                               <<01878>>17025000
IF AUTOF OR NOAUTOF                                            <<01878>>17030000
   THEN ALTER'LID'ENTRY(LOGID',,,TYPE');                       <<01878>>17035000
                                                               <<01878>>17040000
END;                                                                    17045000
                                                                        17050000
                                                                        17055000
                                                                        17060000
                                                                        17065000
$PAGE                                                          <<01878>>17070000
PROCEDURE CXLISTLOG(PARMSP,ERRNUM,PARMNUM);                             17075000
BYTE ARRAY PARMSP;                                                      17080000
INTEGER ERRNUM;                                                         17085000
INTEGER PARMNUM;                                                        17090000
OPTION PRIVILEGED,UNCALLABLE;                                           17095000
                                                                        17100000
                                                                        17105000
                                                               <<01878>>17110000
<<    This procedure is the command executor for the         >><<01878>>17115000
<<    :LISTLOG command.                                      >><<01878>>17120000
<<    Syntax is :                                            >><<01878>>17125000
<<        :LISTLOG  [logid [;pass]]                          >><<01878>>17130000
                                                                        17135000
                                                                        17140000
BEGIN                                                                   17145000
   DEFINE                                                      <<01878>>17150000
      SEMI  =  ";"#;                                           <<01878>>17155000
                                                                        17160000
   BYTE ARRAY HEADER(*) = PB :=                                <<01878>>17165000
   "LOGID",15(" "),"CREATOR",12(" "),"CHANGE", 2(" "),         <<01878>>17170000
   "AUTO", 3(" "), "CURRENT LOG FILE";                         <<01878>>17175000
                                                               <<01878>>17180000
   EQUATE HEADER'LENGTH = 70;                                  <<01878>>17185000
                                                               <<01878>>17190000
   DEFINE                                                      <<01878>>17195000
      CLEAR'OUTREC = OUTREC := "  ";                           <<01878>>17200000
                     MOVE OUTREC(1) := OUTREC, (39)#,          <<01878>>17205000
      PRINT'OUTREC = PRINT(OUTREC,-79,0)#;                     <<01878>>17210000
                                                               <<01878>>17215000
                                                               <<01878>>17220000
   INTEGER I,MAX,LEN;                                                   17225000
  LOGICAL LID'TYP;                                             <<01878>>17230000
   LOGICAL TEST;  BYTE ARRAY STOPPER(0:1) = Q;                          17235000
   LOGICAL CREATOR;                                                     17240000
   LOGICAL PRINT'PASS;                                         <<01878>>17245000
   BYTE POINTER BPS0 = S;                                               17250000
   LOGICAL FIRST;                                                       17255000
BYTE POINTER  PARMPTR,DELIMPTR;                                <<01878>>17260000
   BYTE ARRAY CUSER(0:8);                                      <<01878>>17265000
   BYTE ARRAY CACCT(0:8);                                      <<01878>>17270000
                                                               <<01878>>17275000
   BYTE ARRAY FNAME(0:36);                                     <<01878>>17280000
   BYTE ARRAY CRE'USER(0:8);                                   <<01878>>17285000
   BYTE ARRAY CRE'ACCT(0:8);                                   <<01878>>17290000
   BYTE ARRAY LID'PASS(0:8);                                   <<01878>>17295000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<01878>>17300000
   INTEGER ARRAY IENTRY'(*) = ENTRY';                          <<01878>>17305000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      17310000
   LOGICAL ARRAY OUTREC(0:39);                                 <<01878>>17315000
   BYTE ARRAY BOUTREC(*) = OUTREC;                                      17320000
                                                               <<01878>>17325000
   EQUATE                                                               17330000
   ID    =   0,        << Logid field                     >>   <<01878>>17335000
   CRE   =  20,        << Creator's name field            >>   <<01878>>17340000
   AF    =  47,        << Auto change enabled field       >>   <<01878>>17345000
   CF    =  40,        << Changelog allowed field         >>   <<01878>>17350000
   FILE  =  54;        << Current log file name field     >>   <<01878>>17355000
                                                               <<01878>>17360000
                                                               <<01878>>17365000
                                                               <<01878>>17370000
LOGICAL SUBROUTINE VALID'ENTRY;                                <<01878>>17375000
BEGIN                                                          <<01878>>17380000
                                                               <<01878>>17385000
<< Checks the entry from the LIDTAB to see if valid info  >>   <<01878>>17390000
<< is really there before printing out.                   >>   <<01878>>17395000
                                                               <<01878>>17400000
   VALID'ENTRY := FALSE;                                       <<01878>>17405000
                                                               <<01878>>17410000
                                                               <<01878>>17415000
   IF BENTRY'(LID) <> ALPHA  OR  BENTRY'(FNAME') <> ALPHA  OR  <<01878>>17420000
      BENTRY'(UNAME) <> ALPHA  OR  BENTRY'(UACCT) <> ALPHA  OR <<01878>>17425000
      IENTRY'(TYP).TYP'CURRENT > MAX'TYP'FIELD THEN RETURN;    <<01878>>17430000
                                                               <<01878>>17435000
   MOVE BENTRY'(LID) := BENTRY'(LID)  WHILE AN,1;              <<01878>>17440000
   LEN := TOS - @BENTRY';                                      <<01878>>17445000
   IF  LEN < 8  AND  BENTRY'(LEN) <> " "   THEN RETURN;        <<01878>>17450000
                                                               <<01878>>17455000
   MOVE BENTRY'(UNAME) := BENTRY'(UNAME) WHILE AN,1;           <<01878>>17460000
   LEN := TOS - @BENTRY';                                      <<01878>>17465000
   IF LEN < TYP  AND  BENTRY'(LEN) <> " "  THEN RETURN;        <<01878>>17470000
                                                               <<01878>>17475000
   << We've found no special characters (except blank) that  >><<01878>>17480000
   << would indicate that this is a garbage entry.  So set   >><<01878>>17485000
   << flag - this one can be printed out.                    >><<01878>>17490000
                                                               <<01878>>17495000
   VALID'ENTRY := TRUE;                                        <<01878>>17500000
                                                               <<01878>>17505000
END;                                                           <<01878>>17510000
                                                               <<01878>>17515000
                                                               <<01878>>17520000
   PRINT'PASS := FALSE;                                        <<01878>>17525000
   TEST.(0:8):=%15;  TEST.(8:8):=%15;   STOPPER:=0;  STOPPER(1):= 0;    17530000
   SCAN PARMSP UNTIL TEST,1;                                            17535000
   MOVE * := STOPPER, (1);                                     <<01878>>17540000
   CUSER := " ";                                               <<01878>>17545000
   MOVE CUSER(1):=CUSER,(17);                                           17550000
   UPSHIFT'(PARMSP);                                                    17555000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<01878>>17560000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              17565000
   @PARMSP := @PARMPTR;      << Points to logid parm >>        <<01878>>17570000
   IF LEN = 0 THEN                                                      17575000
   BEGIN                                                                17580000
      IF DELIMPTR <> STOPPER THEN                              <<01878>>17585000
      BEGIN                  <<should be no more parms>>       <<01878>>17590000
         ERRNUM := EXPECTEDLOGID;                              <<01878>>17595000
         CIERR(ERRNUM,DELIMPTR);                               <<01878>>17600000
         RETURN;                                               <<01878>>17605000
      END;                                                     <<01878>>17610000
   FIRST:=TRUE;                                                         17615000
   I:=1;                                                                17620000
   DO                                                                   17625000
   BEGIN                                                                17630000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);      <<01878>>17635000
      IF ENTRY'(TYP) <> NULL THEN                                       17640000
      BEGIN                                                             17645000
      IF NOT VALID'ENTRY  THEN GO NEXT1;                       <<01878>>17650000
      IF FIRST THEN                                                     17655000
      BEGIN                                                             17660000
         CLEAR'OUTREC;                                         <<01878>>17665000
         PRINT'OUTREC;                                         <<01878>>17670000
         MOVE BOUTREC := HEADER, (HEADER'LENGTH);              <<01878>>17675000
         PRINT'OUTREC;                                         <<01878>>17680000
         CLEAR'OUTREC;                                         <<01878>>17685000
         PRINT'OUTREC;                                         <<01878>>17690000
         FIRST:=FALSE;                                                  17695000
      END;                                                              17700000
         MOVE BOUTREC(ID):=BENTRY'(LID),(8);                            17705000
         IF BENTRY'(UNAME+7) <> " " THEN                                17710000
         MOVE BOUTREC(CRE):=BENTRY'(UNAME),(8),2                        17715000
         ELSE                                                           17720000
         MOVE BOUTREC(CRE):=BENTRY'(UNAME) WHILE AN,1;                  17725000
         MOVE *:=".",2;                                                 17730000
         MOVE *:=BENTRY'(UACCT) WHILE AN,1;                             17735000
         IF BENTRY'(FNAME'+7) <> " "                           <<01878>>17740000
            THEN MOVE BOUTREC(FILE) := BENTRY'(FNAME'), (8), 2 <<01878>>17745000
         ELSE MOVE BOUTREC(FILE) := BENTRY'(FNAME') WHILE AN,1;<<01878>>17750000
                                                               <<01878>>17755000
         IF ENTRY'(TYP).TYP'CURRENT = DISC THEN                <<01878>>17760000
         BEGIN                                                 <<01878>>17765000
            << Get fully qualified disc file name >>           <<01878>>17770000
            MOVE BPS0 := ".",2;                                <<01878>>17775000
            IF BENTRY'(FGROUP+7) <> " "                        <<01878>>17780000
               THEN MOVE * := BENTRY'(FGROUP), (8), 2          <<01878>>17785000
            ELSE MOVE * := BENTRY'(FGROUP) WHILE AN,1;         <<01878>>17790000
                                                               <<01878>>17795000
            MOVE BPS0 := "." ,2;                               <<01878>>17800000
            IF BENTRY'(FACCT) <> " "                           <<01878>>17805000
               THEN MOVE * := BENTRY'(FACCT), (8), 2           <<01878>>17810000
            ELSE MOVE * := BENTRY'(FACCT) WHILE AN,1;          <<01878>>17815000
         IF ENTRY'(TYP).TYP'ALLOW'AUTO THEN                    <<01878>>17820000
            MOVE BOUTREC(AF) := "YES"                          <<01878>>17825000
         ELSE                                                  <<01878>>17830000
            MOVE BOUTREC(AF) := "NO";                          <<01878>>17835000
                                                               <<01878>>17840000
         END;   << Qualify the disc file name >>               <<01878>>17845000
         IF ENTRY'(TYP).TYP'ALLOW'CHANGE THEN                  <<01878>>17850000
            MOVE BOUTREC(CF) := "YES"                          <<01878>>17855000
         ELSE                                                  <<01878>>17860000
            MOVE BOUTREC(CF) := "NO";                          <<01878>>17865000
                                                               <<01878>>17870000
         PRINT'OUTREC;                                         <<01878>>17875000
         CLEAR'OUTREC;                                         <<01878>>17880000
NEXT1:                                                         <<01878>>17885000
      END;                                                              17890000
   END UNTIL (I:=I+1) > MAX;                                            17895000
                                                               <<01878>>17900000
   IF FIRST THEN                                                        17905000
   BEGIN                                                                17910000
      ERRNUM := -NOLOGID;                                      <<01878>>17915000
      CIERR(ERRNUM);                                                    17920000
      RETURN;                                                           17925000
   END;                                                                 17930000
   END                                                                  17935000
   ELSE                                                                 17940000
     <<Parameter specified - only print that entry>>           <<01878>>17945000
   BEGIN                                                                17950000
      IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)             <<01878>>17955000
        THEN RETURN;                                           <<01878>>17960000
      PARMNUM := PARMNUM + 1;                                  <<01878>>17965000
                                                               <<01878>>17970000
      FNAME := " ";                                            <<01878>>17975000
      MOVE FNAME(1) := FNAME, (36);                            <<01878>>17980000
      FENTRY(PARMSP,LID'PASS,FNAME,CRE'USER,CRE'ACCT,LID'TYP); <<01878>>17985000
      IF <> THEN                                               <<01878>>17990000
         BEGIN                                                 <<01878>>17995000
         CIERR(ERRNUM:=-NIXLOGID, PARMSP);                     <<01878>>18000000
         RETURN;                                               <<01878>>18005000
         END;                                                  <<01878>>18010000
          WHO(,,,CUSER,,CACCT);                                <<01878>>18015000
          IF CUSER <> CRE'USER,(8) OR CACCT <> CRE'ACCT,(8)    <<01878>>18020000
             THEN CREATOR:=FALSE ELSE CREATOR:=TRUE;           <<01878>>18025000
         LID'PASS(8) := 0;                                     <<01878>>18030000
         IF DELIMPTR <> STOPPER THEN                           <<01878>>18035000
         BEGIN                                                          18040000
            IF DELIMPTR <> SEMI THEN                           <<01878>>18045000
            BEGIN                                              <<01878>>18050000
               <<invalid delimiter between keywords>>          <<01878>>18055000
               ERRNUM := EXPECTEDSEMI;                         <<01878>>18060000
               CIERR(ERRNUM,DELIMPTR);                         <<01878>>18065000
               RETURN;                                         <<01878>>18070000
            END;                                               <<01878>>18075000
                                                               <<01878>>18080000
            LEN:=NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                   18085000
            IF LEN = 4 AND PARMPTR = "PASS" THEN                        18090000
            BEGIN                                                       18095000
               IF CREATOR THEN                                          18100000
               BEGIN                                                    18105000
               PRINT'PASS := TRUE;                             <<01878>>18110000
               END                                                      18115000
               ELSE                                                     18120000
               BEGIN                                                    18125000
                  ERRNUM:=CREPARM;                                      18130000
                  CIERR(ERRNUM,PARMPTR);                                18135000
               RETURN;                                         <<01878>>18140000
               END;                                                     18145000
            END                                                         18150000
            ELSE                                                        18155000
            BEGIN                                                       18160000
               <<only other valid keyword is PASS>>            <<01878>>18165000
               ERRNUM:=EXPASS;                                          18170000
               CIERR(ERRNUM,PARMPTR);                                   18175000
               RETURN;                                         <<01878>>18180000
            END;                                                        18185000
         IF DELIMPTR <> STOPPER THEN                           <<01878>>18190000
         BEGIN                                                 <<01878>>18195000
            <<there should be no more parms>>                  <<01878>>18200000
            ERRNUM := EXTRAPARM;                               <<01878>>18205000
            CIERR(ERRNUM,DELIMPTR);                            <<01878>>18210000
            RETURN;                                            <<01878>>18215000
         END;                                                  <<01878>>18220000
                                                               <<01878>>18225000
         END;                                                           18230000
      CLEAR'OUTREC;                                            <<01878>>18235000
      PRINT'OUTREC;      << Blank line >>                      <<01878>>18240000
      MOVE BOUTREC := HEADER, (HEADER'LENGTH);                 <<01878>>18245000
      PRINT'OUTREC;                                            <<01878>>18250000
      CLEAR'OUTREC;                                            <<01878>>18255000
      PRINT'OUTREC;     << Blank line >>                       <<01878>>18260000
                                                               <<01878>>18265000
      CRE'USER(8) := 0;                                        <<01878>>18270000
      CRE'ACCT(8) := 0;                                        <<01878>>18275000
      MOVE BOUTREC(ID) := PARMSP WHILE AN, 1;                  <<01878>>18280000
      IF PRINT'PASS THEN                                       <<01878>>18285000
         BEGIN                                                 <<01878>>18290000
         MOVE * := "/", 2;                                     <<01878>>18295000
         MOVE * := LID'PASS WHILE AN;                          <<01878>>18300000
         END                                                   <<01878>>18305000
      ELSE                                                     <<01878>>18310000
         DEL;                                                  <<01878>>18315000
                                                               <<01878>>18320000
      MOVE BOUTREC(CRE) := CRE'USER WHILE AN, 1;               <<01878>>18325000
      MOVE * := ".", 2;                                        <<01878>>18330000
      MOVE * := CRE'ACCT WHILE AN;                             <<01878>>18335000
                                                               <<01878>>18340000
      DEL'LOCKWORD(FNAME);                                     <<01878>>18345000
                                                               <<01878>>18350000
     << Max filename length is now 26 - lockword is gone.  >>  <<01878>>18355000
                                                               <<01878>>18360000
      MOVE BOUTREC(FILE) := FNAME, (26);                       <<01878>>18365000
                                                               <<01878>>18370000
      IF LID'TYP.TYP'CURRENT = DISC THEN                       <<01878>>18375000
         BEGIN                                                 <<01878>>18380000
         IF LID'TYP.TYP'ALLOW'AUTO THEN                        <<01878>>18385000
            MOVE BOUTREC(AF) := "YES"                          <<01878>>18390000
         ELSE                                                  <<01878>>18395000
            MOVE BOUTREC(AF) := "NO";                          <<01878>>18400000
         END;                                                  <<01878>>18405000
                                                               <<01878>>18410000
      IF LID'TYP.TYP'ALLOW'CHANGE THEN                         <<01878>>18415000
         MOVE BOUTREC(CF) := "YES"                             <<01878>>18420000
      ELSE                                                     <<01878>>18425000
         MOVE BOUTREC(CF) := "NO";                             <<01878>>18430000
                                                               <<01878>>18435000
                                                               <<01878>>18440000
         PRINT'OUTREC;     << Print requested information >>   <<01878>>18445000
         CLEAR'OUTREC;                                         <<01878>>18450000
   END;                                                                 18455000
   PRINT(OUTREC,0,%60);     << Double space >>                <<<01878>>18460000
END;                                                                    18465000
                                                                        18470000
$PAGE                                                          <<01878>>18475000
PROCEDURE CXSHOWLOGSTATUS(PARMSP,ERRNUM,PARMNUM);                       18480000
BYTE ARRAY PARMSP;                                                      18485000
INTEGER ERRNUM;                                                         18490000
INTEGER PARMNUM;                                                        18495000
OPTION PRIVILEGED,UNCALLABLE;                                           18500000
                                                               <<01878>>18505000
<<    This procedure is the command executor for the         >><<01878>>18510000
<<    :SHOWLOGSTATUS command.                                >><<01878>>18515000
<<    Syntax is :                                            >><<01878>>18520000
<<        :SHOWLOGSTATUS  [logid]                            >><<01878>>18525000
                                                               <<01878>>18530000
                                                               <<01878>>18535000
BEGIN                                                                   18540000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>18545000
   EQUATE                                                               18550000
      ID      =   0,   << Logid name field                   >><<01878>>18555000
      CF      =  10,   << Changelog allowed field            >><<01878>>18560000
      AF      =  18,   << Auto change enabled flag           >><<01878>>18565000
      NUSER   =  24,   << Number of users accessing log file >><<01878>>18570000
      STAT    =  32,   << State field                        >><<01878>>18575000
      RECORDS =  42,   << # Records in the current log file  >><<01878>>18580000
      TRECORDS=  53,   << Total # records avail in current   >><<01878>>18585000
      PERCENT =  64,   << Current file utilization           >><<01878>>18590000
      FILE'SEQ=  72;   << Current file sequence number       >><<01878>>18595000
                                                               <<01878>>18600000
   BYTE ARRAY HEADER(*) =PB := "LOGID",5(" "),"CHANGE",2(" "), <<01878>>18605000
        "AUTO", 2(" "), "USERS", 3(" "), "STATE", 5(" "),      <<01878>>18610000
        "CUR REC", 3(" "), "MAX REC", 2(" "), "% USED",        <<01878>>18615000
        3(" "), "CUR FSET   ";                                 <<01878>>18620000
                                                               <<01878>>18625000
EQUATE  HEADER'LENGTH = 79;                                    <<01878>>18630000
                                                               <<01878>>18635000
DEFINE                                                         <<01878>>18640000
   CLEAR'WOUTREC =                                             <<01878>>18645000
         WOUTREC := "  ";                                      <<01878>>18650000
         MOVE WOUTREC(1) := WOUTREC, (39)#,                    <<01878>>18655000
   PRINT'WOUTREC = PRINT(WOUTREC,-79,0)#;                      <<01878>>18660000
                                                               <<01878>>18665000
   LOGICAL ARRAY WOUTREC(0:39) = Q;                            <<01878>>18670000
   BYTE ARRAY OUTREC(*) = WOUTREC;                             <<01878>>18675000
   BYTE ARRAY STOPPER(0:1) = Q;                                         18680000
   LOGICAL  TEST,CRSTATE;                                               18685000
   INTEGER TABINDEX,STAT',LEN,USERS,I;                         <<01878>>18690000
   INTEGER                                                     <<01878>>18695000
      FILE'SEQ'NUMBER,                                         <<01878>>18700000
      TYPE',                                                   <<01878>>18705000
      PERCENT'FULL;                                            <<01878>>18710000
   DOUBLE NUMREC,                                              <<01878>>18715000
          T'NUMREC,                                                     18720000
          MAXREC;                                              <<01878>>18725000
   LOGICAL A,FIRST,                                            <<01878>>18730000
   AUTO'FLAG,                                                           18735000
   C'FLAG,           <<CHANGE FLAGE>>                                   18740000
           SWITCHING;                                          <<01878>>18745000
                                                               <<01878>>18750000
                                                               <<01878>>18755000
   TEST.(0:8):=%15;  TEST.(8:8):=%15;                                   18760000
   STOPPER:=0;   STOPPER(1):=0;                                         18765000
   SCAN PARMSP UNTIL TEST,1;                                            18770000
   MOVE  * := STOPPER, (1);                                    <<01878>>18775000
   UPSHIFT'(PARMSP);                                                    18780000
   CRSTATE:=SETCRITICAL;                                                18785000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              18790000
   IF LEN = 0 THEN                                                      18795000
   BEGIN                                                                18800000
      IF DELIMPTR <> STOPPER THEN                              <<01878>>18805000
      BEGIN                                                    <<01878>>18810000
         RESETCRITICAL(CRSTATE);                               <<01878>>18815000
         ERRNUM := EXPECTEDLOGID;                              <<01878>>18820000
         CIERR(ERRNUM,PARMPTR);                                <<01878>>18825000
         RETURN;                                               <<01878>>18830000
      END;                                                     <<01878>>18835000
      AUTO'FLAG := FALSE;                                      <<01878>>18840000
      FIRST := TRUE;                                           <<01878>>18845000
      EXCHANGEDB(LOGDST);                                      <<01878>>18850000
      A:=GETSIR(LOGSIR);                                                18855000
      TABINDEX:=LOGTAB(INUSE);                                          18860000
      WHILE (TABINDEX <> NULL) AND (TABINDEX <> "  ") DO       <<01878>>18865000
      BEGIN                                                             18870000
         T'NUMREC := 0D;                                       <<01878>>18875000
         IF (BLOGTAB(LGNAME) <> ALPHA) OR (LOGTAB(DST) = NULL) <<01878>>18880000
           THEN GO AROUND;                                     <<01878>>18885000
         IF FIRST THEN                                                  18890000
         BEGIN                                                          18895000
            EXCHANGEDB(0);                                     <<01878>>18900000
            CLEAR'WOUTREC;                                     <<01878>>18905000
            PRINT'WOUTREC;                                     <<01878>>18910000
            MOVE OUTREC := HEADER, (HEADER'LENGTH);            <<01878>>18915000
            PRINT'WOUTREC;                                     <<01878>>18920000
            CLEAR'WOUTREC;                                     <<01878>>18925000
            PRINT'WOUTREC;                                     <<01878>>18930000
            FIRST:=FALSE;                                               18935000
            EXCHANGEDB(LOGDST);                                <<01878>>18940000
         END;                                                           18945000
         I:=0;                                                          18950000
         DO                                                             18955000
         BEGIN                                                          18960000
            OUTREC(ID+I):=BLOGTAB(LGNAME+I);                            18965000
         END UNTIL(I:=I+1) >=8;                                         18970000
                                                               <<01878>>18975000
         STAT' := LOGTAB(STATUS);                              <<01878>>18980000
         IF STAT' = RECOVERING  OR  STAT' = INITIALIZING  THEN <<01878>>18985000
         BEGIN                                                          18990000
            EXCHANGEDB(0);                                     <<01878>>18995000
            IF STAT' = RECOVERING                              <<01878>>19000000
               THEN MOVE OUTREC(STAT):= "RECOVER"              <<01878>>19005000
            ELSE MOVE OUTREC(STAT) := "INIT";                  <<01878>>19010000
                                                               <<01878>>19015000
            PRINT'WOUTREC;                                     <<01878>>19020000
            CLEAR'WOUTREC;                                     <<01878>>19025000
            EXCHANGEDB(LOGDST);                                <<01878>>19030000
         END                                                            19035000
         ELSE                                                           19040000
         BEGIN                                                          19045000
         IF LOGTAB(DST) = NULL  THEN GO AROUND;                <<01878>>19050000
         EXCHANGEDB(LOGTAB(DST));                              <<01878>>19055000
         T'NUMREC:=DLOGBUFF(TRECS);                                     19060000
         IF LOGBUFF(AUTO) THEN                                 <<01878>>19065000
            AUTO'FLAG := TRUE                                  <<01878>>19070000
         ELSE                                                  <<01878>>19075000
            AUTO'FLAG:=FALSE;                                  <<01878>>19080000
                                                               <<01878>>19085000
         IF LOGBUFF(CHANGE) THEN                               <<01878>>19090000
            C'FLAG := TRUE                                     <<01878>>19095000
         ELSE                                                  <<01878>>19100000
            C'FLAG:=FALSE;                                     <<01878>>19105000
                                                               <<01878>>19110000
         NUMREC:=DLOGBUFF(TRECS)-DLOGBUFF(RECS'IN'PREV);                19115000
         MAXREC := DLOGBUFF(MAXFSPACE) + 1D;                   <<01878>>19120000
         TYPE' := ILOGBUFF(LOGTYPE);                           <<01878>>19125000
         FILE'SEQ'NUMBER := ILOGBUFF(VSETNO);                  <<01878>>19130000
         SWITCHING := LOGBUFF(SWITCH');                        <<01878>>19135000
         USERS:=LOGBUFF(NUMUSER);                                       19140000
         STAT':=LOGBUFF(STATE);                                         19145000
                                                               <<01878>>19150000
         EXCHANGEDB(0);                                        <<01878>>19155000
         DASCII(NUMREC,10,OUTREC(RECORDS));                    <<01878>>19160000
         ASCII(USERS,10,OUTREC(NUSER));                                 19165000
         IF SWITCHING                                          <<01878>>19170000
            THEN MOVE OUTREC(STAT) := "CHANGING"               <<01878>>19175000
         ELSE                                                  <<01878>>19180000
            IF STAT' = ACT                                     <<01878>>19185000
               THEN MOVE OUTREC(STAT) := "ACTIVE"              <<01878>>19190000
            ELSE                                               <<01878>>19195000
               IF STAT' = INACT                                <<01878>>19200000
                  THEN MOVE OUTREC(STAT) := "INACTIVE";        <<01878>>19205000
                                                               <<01878>>19210000
         IF TYPE' = DISC THEN                                  <<01878>>19215000
            BEGIN         << Print file utilization >>         <<01878>>19220000
                                                               <<01878>>19225000
            DASCII(MAXREC,10,OUTREC(TRECORDS));                <<01878>>19230000
                                                               <<01878>>19235000
            PERCENT'FULL := INTEGER(FIXR((REAL(NUMREC)/        <<01878>>19240000
                            REAL(MAXREC))*REAL(100)));         <<01878>>19245000
            LEN := ASCII(PERCENT'FULL,10,OUTREC(PERCENT));     <<01878>>19250000
            OUTREC(PERCENT+LEN):= "%";                                  19255000
            IF AUTO'FLAG THEN                                           19260000
               MOVE OUTREC(AF) := "YES"                        <<01878>>19265000
            ELSE                                               <<01878>>19270000
               MOVE OUTREC(AF) := "NO";                        <<01878>>19275000
                                                               <<01878>>19280000
            END;                                               <<01878>>19285000
                                                               <<01878>>19290000
         IF C'FLAG THEN                                        <<01878>>19295000
            MOVE OUTREC(CF) := "YES"                           <<01878>>19300000
         ELSE                                                  <<01878>>19305000
            MOVE OUTREC(CF) := "NO";                           <<01878>>19310000
                                                               <<01878>>19315000
         ASCII(FILE'SEQ'NUMBER,10,OUTREC(FILE'SEQ));           <<01878>>19320000
                                                               <<01878>>19325000
         PRINT'WOUTREC;                                        <<01878>>19330000
         CLEAR'WOUTREC;                                        <<01878>>19335000
         EXCHANGEDB(LOGDST);                                   <<01878>>19340000
         END;                                                           19345000
AROUND:                                                        <<01878>>19350000
         TABINDEX:=LOGTAB(NEXT);                                        19355000
      END;                                                              19360000
                                                               <<01878>>19365000
                                                               <<01878>>19370000
      RELSIR(LOGSIR,A);                                                 19375000
      EXCHANGEDB(0);                                           <<01878>>19380000
      IF FIRST THEN                                                     19385000
      BEGIN                                                             19390000
         ERRNUM:=-NOLOGPROCRUN;                                         19395000
         CIERR(ERRNUM);                                                 19400000
         RESETCRITICAL(CRSTATE);                                        19405000
         RETURN;                                                        19410000
      END;                                                              19415000
   END                                                                  19420000
   ELSE                                                                 19425000
                                                                        19430000
   BEGIN                               <<ONLY ONE LOGGING ID>>          19435000
      IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM) THEN RETURN;<<01878>>19440000
                                                               <<01878>>19445000
      PARMNUM := PARMNUM + 1;                                  <<01878>>19450000
                                                               <<01878>>19455000
      IF DELIMPTR <> STOPPER THEN                              <<01878>>19460000
      BEGIN                                                    <<01878>>19465000
         RESETCRITICAL(CRSTATE);                               <<01878>>19470000
         ERRNUM := ONEPARM;                                    <<01878>>19475000
         CIERR(ERRNUM,DELIMPTR);                               <<01878>>19480000
         RETURN;                                               <<01878>>19485000
      END;                                                     <<01878>>19490000
                                                               <<01878>>19495000
      A := GETSIR(LOGSIR);                                     <<01878>>19500000
      IF FINDLOG(PARMPTR,TABINDEX) THEN                                 19505000
      BEGIN                                                             19510000
         CLEAR'WOUTREC;                                        <<01878>>19515000
         MOVE OUTREC := HEADER, (HEADER'LENGTH);               <<01878>>19520000
         PRINT'WOUTREC;                                        <<01878>>19525000
         CLEAR'WOUTREC;                                        <<01878>>19530000
         PRINT'WOUTREC;                                        <<01878>>19535000
         I:=0;                                                          19540000
         EXCHANGEDB(LOGDST);                                   <<01878>>19545000
         DO OUTREC(ID+I):=BLOGTAB(LGNAME+I) UNTIL (I:=I+1) >= 8;        19550000
                                                               <<01878>>19555000
         STAT' := LOGTAB(STATUS);                              <<01878>>19560000
         IF STAT' = RECOVERING  OR  STAT' = INITIALIZING  THEN <<01878>>19565000
         BEGIN                                                 <<01878>>19570000
            EXCHANGEDB(0);                                     <<01878>>19575000
            IF STAT' = RECOVERING THEN                         <<01878>>19580000
               MOVE OUTREC(STAT) := "RECOVER"                  <<01878>>19585000
            ELSE MOVE OUTREC(STAT) := "INIT";                  <<01878>>19590000
                                                               <<01878>>19595000
            PRINT'WOUTREC;                                     <<01878>>19600000
            RELSIR(LOGSIR,A);                                  <<01878>>19605000
            RESETCRITICAL(CRSTATE);                            <<01878>>19610000
            RETURN;                                            <<01878>>19615000
         END;                                                  <<01878>>19620000
                                                               <<01878>>19625000
         IF LOGTAB(DST) = NULL  THEN GO AROUND2;               <<01878>>19630000
         EXCHANGEDB(LOGTAB(DST));                              <<01878>>19635000
         T'NUMREC:=DLOGBUFF(TRECS);                                     19640000
         IF LOGBUFF(AUTO) THEN AUTO'FLAG:=TRUE                          19645000
         ELSE                                                  <<01878>>19650000
            AUTO'FLAG:=FALSE;                                  <<01878>>19655000
         NUMREC:=DLOGBUFF(TRECS)-DLOGBUFF(RECS'IN'PREV);                19660000
         IF LOGBUFF(CHANGE) THEN C'FLAG:=TRUE                           19665000
         ELSE                                                  <<01878>>19670000
            C'FLAG:=FALSE;                                     <<01878>>19675000
         MAXREC := DLOGBUFF(MAXFSPACE) + 1D;                   <<01878>>19680000
         TYPE' := ILOGBUFF(LOGTYPE);                           <<01878>>19685000
         FILE'SEQ'NUMBER := ILOGBUFF(VSETNO);                  <<01878>>19690000
         SWITCHING := LOGBUFF(SWITCH');                        <<01878>>19695000
         USERS:=LOGBUFF(NUMUSER);                                       19700000
         STAT':=LOGBUFF(STATE);                                         19705000
         RELSIR(LOGSIR,A);                                              19710000
         EXCHANGEDB(0);                                        <<01878>>19715000
         DASCII(NUMREC,10,OUTREC(RECORDS));                    <<01878>>19720000
         ASCII(USERS,10,OUTREC(NUSER));                                 19725000
         IF SWITCHING                                          <<01878>>19730000
            THEN MOVE OUTREC(STAT) := "CHANGING"               <<01878>>19735000
         ELSE                                                  <<01878>>19740000
            IF STAT' = ACT                                     <<01878>>19745000
               THEN MOVE OUTREC(STAT) := "ACTIVE"              <<01878>>19750000
            ELSE                                               <<01878>>19755000
               IF STAT' = INACT                                <<01878>>19760000
                  THEN MOVE OUTREC(STAT) := "INACTIVE";        <<01878>>19765000
                                                               <<01878>>19770000
         IF TYPE' = DISC THEN                                  <<01878>>19775000
            BEGIN           << Print file utilization >>       <<01878>>19780000
                                                               <<01878>>19785000
            DASCII(MAXREC,10,OUTREC(TRECORDS));                <<01878>>19790000
                                                               <<01878>>19795000
            PERCENT'FULL := INTEGER(FIXR((REAL(NUMREC)/        <<01878>>19800000
                             REAL(MAXREC))*REAL(100)));        <<01878>>19805000
            LEN := ASCII(PERCENT'FULL,10,OUTREC(PERCENT));     <<01878>>19810000
            OUTREC(PERCENT+LEN) := "%";                        <<01878>>19815000
            IF AUTO'FLAG THEN                                           19820000
               MOVE OUTREC(AF) := "YES"                        <<01878>>19825000
            ELSE                                               <<01878>>19830000
               MOVE OUTREC(AF) := "NO";                        <<01878>>19835000
                                                               <<01878>>19840000
            END;                                               <<01878>>19845000
                                                               <<01878>>19850000
            IF C'FLAG THEN                                     <<01878>>19855000
               MOVE OUTREC(CF) := "YES"                        <<01878>>19860000
            ELSE                                               <<01878>>19865000
               MOVE OUTREC(CF) := "NO";                        <<01878>>19870000
                                                               <<01878>>19875000
         ASCII(FILE'SEQ'NUMBER,10,OUTREC(FILE'SEQ));           <<01878>>19880000
         PRINT'WOUTREC;                                        <<01878>>19885000
      END                                                               19890000
      ELSE                                                              19895000
      BEGIN                                                             19900000
                                                               <<01878>>19905000
AROUND2:                                                       <<01878>>19910000
                                                               <<01878>>19915000
         << Logid not found >>                                 <<01878>>19920000
         RELSIR(LOGSIR,A);                                     <<01878>>19925000
         RESETCRITICAL(CRSTATE);                               <<01878>>19930000
         ERRNUM:=LOGPROCNORUN;                                          19935000
         CIERR(ERRNUM,PARMPTR);                                         19940000
         RETURN;                                                        19945000
      END;                                                              19950000
   END;                                                                 19955000
   RESETCRITICAL(CRSTATE);                                              19960000
   CLEAR'WOUTREC;                                              <<01878>>19965000
   PRINT(WOUTREC,0,%60);     << Double space >>                <<01878>>19970000
END;                                                                    19975000
$PAGE "CXCHANGELOG"                                            <<01878>>19980000
PROCEDURE CXCHANGELOG(PARMSP,ERRNUM,PARMNUM);                  <<01878>>19985000
   BYTE ARRAY PARMSP;                                          <<01878>>19990000
   INTEGER PARMNUM,ERRNUM;                                     <<01878>>19995000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01878>>20000000
                                                               <<01878>>20005000
BEGIN                                                          <<01878>>20010000
                                                               <<01878>>20015000
<< Command executor for the :CHANGELOG command.              >><<01878>>20020000
<<     :CHANGELOG logid  [;DEV={DISC/TAPE/SDISC/CTAPE}]      >><<01878>>20025000
<<                                                           >><<01878>>20030000
<<                                                           >><<01878>>20035000
<< Purpose of this command is to change the log file of an   >><<01878>>20040000
<< active logging process "on the fly" with no interruption  >><<01878>>20045000
<< in logging activity.                                      >><<01878>>20050000
<<                                                           >><<01878>>20055000
                                                               <<01878>>20060000
                                                               <<01878>>20065000
EQUATE                                                         <<01878>>20070000
   LF     =  %12,                                              <<01878>>20075000
   CR     =  %15,                                              <<01878>>20080000
   SEMI   =  ";",                                              <<01878>>20085000
   EQ     ="=",                                                         20090000
   STDLIST=  -2,        << GENMSG to print on $STDLIST >>      <<01878>>20095000
   DICTLEN = 6;                                                <<01878>>20100000
                                                               <<01878>>20105000
BYTE POINTER                                                   <<01878>>20110000
   PARMPTR,        << Ptr to current parm in command image >>  <<01878>>20115000
   DELIMPTR;       << Ptr to current delimiter             >>  <<01878>>20120000
                                                               <<01878>>20125000
BYTE ARRAY KEYLISTP(*) = PB :=                                 <<01878>>20130000
   5,3,"DEV",                                                  <<01878>>20135000
   0;                                                          <<01878>>20140000
                                                               <<01878>>20145000
BYTE ARRAY                                                     <<01878>>20150000
   OLDFILENAME(0:36),    << Name of current log file      >>   <<01878>>20155000
   NEWFILENAME(0:36),                                          <<01878>>20160000
   KEYLIST(0:DICTLEN-1), << Keywords allowed - for SEARCH >>   <<01878>>20165000
   STOPPER(0:1),         << Used to end the command image >>   <<01878>>20170000
   USER'(0:8)   = Q,     << User's  logon name            >>   <<01878>>20175000
   ACCT'(0:8)   = Q,     <<               and account     >>   <<01878>>20180000
   CUSER(0:8)   = Q,     << Creator's name                >>   <<01878>>20185000
   CACCT(0:8)   = Q,     <<            and account        >>   <<01878>>20190000
   LOGID'(0:8)  = Q;     << Logid specified               >>   <<01878>>20195000
                                                               <<01878>>20200000
INTEGER                                                        <<01878>>20205000
   LEN,                  << Length of logid               >>   <<01878>>20210000
   LOGTAB'ENTRY,         << Offset into LOGTAB entry      >>   <<01878>>20215000
   TABINDEX,                                                   <<01878>>20220000
   FSERRCODE,            << File System error number     >>    <<01878>>20225000
   ULERRCODE,            << User Logging error number    >>    <<01878>>20230000
   LOG'PIN,                                                    <<01878>>20235000
$EDIT VOID=20240000                                            <<01879>>20240000
   STACK,                << DST # of the stack            >>   <<01878>>20245000
   BUFDST;               << DST # of the LOGBUFF             >><<01878>>20250000
                                                               <<01878>>20255000
LOGICAL                                                        <<01878>>20260000
   CHANGE'ERROR,    << TRUE if error during changelog      >>  <<01878>>20265000
   CRSTATE,              << TRUE if critical              >>   <<01878>>20270000
   DEVF,                 << TRUE if "DEV=" parm specified >>   <<01878>>20275000
   NEWTYPE',                                                   <<01878>>20280000
   OLDTYPE',                                                   <<01878>>20285000
   CRLF,                 << Used for SCAN of command image>>   <<01878>>20290000
   A;                    << Used for GETSIR/RELSIR        >>   <<01878>>20295000
                                                               <<01878>>20300000
ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                              <<01878>>20305000
                                                               <<01878>>20310000
                                                               <<01878>>20315000
                                                               <<01878>>20320000
                                                               <<01878>>20325000
$EDIT VOID=20330000                                            <<01879>>20330000
ULERRCODE := 0;                                                <<01878>>20335000
FSERRCODE := 0;                                                <<01878>>20340000
TABINDEX := 0;                                                 <<01878>>20345000
MOVE KEYLIST := KEYLISTP, (DICTLEN);                           <<01878>>20350000
DEVF := FALSE;                                                 <<01878>>20355000
CHANGE'ERROR := FALSE;                                         <<01878>>20360000
MOVE LOGID' := "         ";                                    <<01878>>20365000
MOVE USER' := "         ";                                     <<01878>>20370000
MOVE ACCT' := "         ";                                     <<01878>>20375000
                                                               <<01878>>20380000
CRLF := [8/CR, 8/LF];   << Carriage return/line feed >>        <<01878>>20385000
                                                               <<01878>>20390000
STOPPER(0) := 0;                                               <<01878>>20395000
STOPPER(1) := 0;                                               <<01878>>20400000
                                                               <<01878>>20405000
SCAN PARMSP UNTIL CRLF,1;                                      <<01878>>20410000
MOVE * := STOPPER, (1);                                        <<01878>>20415000
                                                               <<01878>>20420000
UPSHIFT'(PARMSP);                                              <<01878>>20425000
PARMNUM := 1;                                                  <<01878>>20430000
                                                               <<01878>>20435000
LEN := FINDPARM(PARMSP,PARMPTR,DELIMPTR);                      <<01878>>20440000
IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM) THEN RETURN;      <<01878>>20445000
                                                               <<01878>>20450000
@PARMSP := @PARMPTR;    << Pointer to logid parm. >>           <<01878>>20455000
MOVE LOGID' := PARMPTR, (LEN);                                 <<01878>>20460000
LOGID'(8) := 0;      << Terminator for GENMSG >>               <<01878>>20465000
                                                               <<01878>>20470000
FENTRY(LOGID',,OLDFILENAME,CUSER,CACCT,OLDTYPE');              <<01878>>20475000
IF > THEN                                                      <<01878>>20480000
   BEGIN        << Logid not defined on system >>              <<01878>>20485000
   ERRNUM := NIXLOGID;                                         <<01878>>20490000
   CIERR(ERRNUM,PARMSP);                                       <<01878>>20495000
   RETURN;                                                     <<01878>>20500000
   END;                                                        <<01878>>20505000
                                                               <<01878>>20510000
WHO(,,,USER',,ACCT');                                          <<01878>>20515000
                                                               <<01878>>20520000
IF USER' <> CUSER,(8) OR ACCT' <> CACCT,(8) THEN               <<01878>>20525000
   BEGIN        << Must be the creator >>                      <<01878>>20530000
   IF NOT CHECK'FOR'SM'OP THEN                                 <<01878>>20535000
      BEGIN                                                    <<01878>>20540000
                                                               <<01878>>20545000
      << If not the creator, must have SM or OP capability >>  <<01878>>20550000
                                                               <<01878>>20555000
      ERRNUM := SECURITYVIOL;                                  <<01878>>20560000
      CIERR(ERRNUM,PARMSP);                                    <<01878>>20565000
      RETURN;                                                  <<01878>>20570000
      END;                                                     <<01878>>20575000
   END;                                                        <<01878>>20580000
NEWTYPE' := OLDTYPE'.TYP'CURRENT;                              <<01878>>20585000
                                                               <<01878>>20590000
IF NOT OLDTYPE'.TYP'ALLOW'CHANGE THEN                          <<01878>>20595000
   BEGIN                                                       <<01878>>20600000
   CIERR(ERRNUM := CANTCLOGONFILE,PARMSP);                     <<01878>>20605000
   RETURN;                                                     <<01878>>20610000
   END;                                                        <<01878>>20615000
                                                               <<01878>>20620000
DO                                                             <<01878>>20625000
   BEGIN                                                       <<01878>>20630000
                                                               <<01878>>20635000
   << Scan thru the command image until find the STOPPER >>    <<01878>>20640000
   << or an error.                                       >>    <<01878>>20645000
                                                               <<01878>>20650000
   IF DELIMPTR <> SEMI THEN                                    <<01878>>20655000
      BEGIN                                                    <<01878>>20660000
      IF DELIMPTR = STOPPER THEN GO DOWN;                               20665000
      ERRNUM := EXPECTEDSEMI;                                  <<01878>>20670000
      CIERR(ERRNUM,DELIMPTR);                                  <<01878>>20675000
      RETURN;                                                  <<01878>>20680000
      END;                                                     <<01878>>20685000
                                                               <<01878>>20690000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<01878>>20695000
                                                               <<01878>>20700000
   CASE SEARCH(PARMPTR,LEN,KEYLIST) OF                         <<01878>>20705000
      BEGIN                                                    <<01878>>20710000
                                                               <<01878>>20715000
      <<0>>  BEGIN       << Not found >>                       <<01878>>20720000
             IF PARMNUM > 2                                    <<01878>>20725000
               THEN ERRNUM := EXTRAPARM                        <<01878>>20730000
             ELSE ERRNUM := EXPECTDEVNAME;                     <<01878>>20735000
             CIERR(ERRNUM,PARMPTR);                            <<01878>>20740000
             RETURN;                                           <<01878>>20745000
             END;        << Not found >>                       <<01878>>20750000
                                                               <<01878>>20755000
             BEGIN      << "DEV" >>                            <<01878>>20760000
             IF DEVF THEN                                               20765000
                BEGIN                                                   20770000
                CIERR(ERRNUM:=DUPKEYWORD,PARMPTR);                      20775000
                RETURN;                                                 20780000
                END;                                                    20785000
             IF DELIMPTR <> EQ THEN                                     20790000
                BEGIN                                                   20795000
                CIERR(ERRNUM:=EXPECTEDEQ,PARMPTR);                      20800000
                RETURN;                                        <<01878>>20805000
                END;                                                    20810000
             PARMPTR:=PARMPTR+1;                                        20815000
             LEN:=NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                  20820000
             IF LEN = 4 AND PARMPTR = "DISC" THEN                       20825000
                NEWTYPE':=DISC                                 <<01878>>20830000
             ELSE IF LEN = 4 AND PARMPTR = "TAPE" THEN                  20835000
                NEWTYPE':=TAPE                                 <<01878>>20840000
             ELSE IF LEN = 5 AND PARMPTR = "SDISC" THEN                 20845000
                NEWTYPE':=SDISC                                <<01878>>20850000
             ELSE IF LEN = 5 AND PARMPTR = "CTAPE" THEN                 20855000
                NEWTYPE':=CTAPE                                <<01878>>20860000
             ELSE                                                       20865000
                BEGIN                                          <<01878>>20870000
                CIERR(ERRNUM:=ILLEGALTYPE,PARMPTR);            <<01878>>20875000
                RETURN;                                                 20880000
                END;                                                    20885000
             END; << DEV>>                                              20890000
                                                               <<01878>>20895000
      END;     << Case >>                                      <<01878>>20900000
                                                               <<01878>>20905000
   END                                                         <<01878>>20910000
UNTIL DELIMPTR = STOPPER;                                      <<01878>>20915000
                                                               <<01878>>20920000
DOWN:                                                          <<01878>>20925000
                                                               <<01878>>20930000
<< Command syntax checks out. Will now determine if a       >> <<01878>>20935000
<< CHANGELOG is valid for this particular log process.      >> <<01878>>20940000
                                                               <<01878>>20945000
CRSTATE := SETCRITICAL;                                        <<01878>>20950000
A := GETSIR(LOGSIR);                                           <<01878>>20955000
                                                               <<01878>>20960000
PARMNUM := 1;                                                  <<01878>>20965000
IF NOT FINDLOG(LOGID',LOGTAB'ENTRY) THEN                       <<01878>>20970000
   BEGIN     << Opps...process must be active >>               <<01878>>20975000
   RELSIR(LOGSIR,A);                                           <<01878>>20980000
   RESETCRITICAL(CRSTATE);                                     <<01878>>20985000
   CIERR(ERRNUM:=LOGNOTACTIVE,PARMSP);                         <<01878>>20990000
   RETURN;                                                     <<01878>>20995000
   END;                                                        <<01878>>21000000
                                                               <<01878>>21005000
MOVE'FROM'DSEG(@ENTRY',LOGDST,LOGTAB'ENTRY,TENTRYSIZE);        <<01878>>21010000
                                                               <<01878>>21015000
IF ENTRY'(STATUS) = INITIALIZING OR                            <<01878>>21020000
   ENTRY'(STATUS) = RECOVERING OR                              <<01878>>21025000
   ENTRY'(STATUS) = STOP THEN                                  <<01878>>21030000
   BEGIN     << Cannot perform CHANGELOG at this time >>       <<01878>>21035000
   RELSIR(LOGSIR,A);                                           <<01878>>21040000
   RESETCRITICAL(CRSTATE);                                     <<01878>>21045000
   CIERR(ERRNUM:=INVALID'STATE,PARMSP);                        <<01878>>21050000
   RETURN;                                                     <<01878>>21055000
   END;                                                        <<01878>>21060000
                                                               <<01878>>21065000
IF ENTRY'(LGSWITCH) THEN                                       <<01878>>21070000
   BEGIN     << CHANGELOG already pending >>                   <<01878>>21075000
   RELSIR(LOGSIR,A);                                           <<01878>>21080000
   RESETCRITICAL(CRSTATE);                                     <<01878>>21085000
   CIERR(ERRNUM:=CHANGELOG'PENDING,PARMSP);                    <<01878>>21090000
   RETURN;                                                     <<01878>>21095000
   END;                                                        <<01878>>21100000
                                                               <<01878>>21105000
<< Everything looks fine so far. Set up the ENTRY' to      >>  <<01878>>21110000
<< signify we are now performing a CHANGELOG. The log      >>  <<01878>>21115000
<< process will do all of the work involved in changing the>>  <<01878>>21120000
<< log file.                                               >>  <<01878>>21125000
                                                               <<01878>>21130000
ENTRY'(LGSWITCH) := TRUE;                                      <<01878>>21135000
ENTRY'(LGNEWTYPE) := NEWTYPE';                                 <<01878>>21140000
BUFDST := ENTRY'(DST);                                         <<01878>>21145000
                                                               <<01878>>21150000
MOVE'TO'DSEG(LOGDST,LOGTAB'ENTRY,@ENTRY',TENTRYSIZE);          <<01878>>21155000
                                                               <<01878>>21160000
STACK := EXCHANGEDB(BUFDST);                                   <<01878>>21165000
OBTAIN(LOGBUFF(RESOURCE2),NULL);                               <<01884>>21170000
$IF X1=ON                                                      <<01883>>21170100
        WHAT'S'UP ( BC'OBTAIN,2 );                             <<01883>>21170300
$IF                                                            <<01883>>21170400
IF LOGBUFF(MSG) = STOP THEN                                    <<01878>>21175000
   BEGIN                                                       <<01878>>21180000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>21185000
$IF X1=ON                                                      <<01883>>21186000
       WHAT'S'UP ( BC'RELEASE,2 );                             <<01883>>21188000
$IF                                                            <<01883>>21189000
   EXCHANGEDB(STACK);                                          <<01878>>21190000
   RELSIR(LOGSIR,A);                                           <<01878>>21195000
   RESETCRITICAL(CRSTATE);                                     <<01878>>21200000
   CIERR(ERRNUM:=INVALID'STATE,PARMSP);                        <<01878>>21205000
   RETURN;                                                     <<01878>>21210000
   END;                                                        <<01878>>21215000
                                                               <<01878>>21220000
LOGBUFF(SWITCH') := TRUE;                                      <<01878>>21225000
LOGBUFF(NEWTYPE) := NEWTYPE';                                  <<01878>>21230000
LOGBUFF(HEAD'CHANGE'PIN) := MYPIN;  << Wait for changelog >>   <<01878>>21235000
LOGBUFF(NOT'SAFE'TO'STOP) := TRUE;                             <<01885>>21235100
LOG'PIN := LOGBUFF(LOGPIN);                                    <<01885>>21235200
RELEASE(LOGBUFF(RESOURCE2),NULL,1);                            <<01884>>21240000
$IF X1=ON                                                      <<01883>>21240500
       WHAT'S'UP ( BC'RELEASE,2 );                             <<01883>>21240700
$IF                                                            <<01883>>21240800
RELSIR(LOGSIR,A);                                              <<01878>>21245000
$EDIT VOID=21250000                                            <<01885>>21250000
<< Now awake the log process to perform the changelog >>       <<01878>>21255000
$EDIT VOID=21260000                                            <<01879>>21260000
                                                                        21265000
                                                               <<01878>>21270000
<<*********************************************************>>  <<01885>>21271000
<<* DB is at the LOGBUF XDS and we are going to AWAKE the *>>  <<01885>>21272000
<<* logging process to do a :CHANGELOG. If the logging    *>>  <<01885>>21273000
<<* process discovers an error it will set LOGBUF(MSG) to *>>  <<01885>>21274000
<<* STOP.  We do NOT want the logging process carry out   *>>  <<01885>>21275000
<<* the STOP operation until we have retrieved any FS or  *>>  <<01885>>21276000
<<* UL error code from the LOGBUF and done an EXCHANGEDB  *>>  <<01885>>21277000
<<* back to the stack.                                    *>>  <<01885>>21278000
<<*                                                       *>>  <<01885>>21279000
<<* The flag LOGBUF(NOT'SAFE'TO'STOP) is used to prevent  *>>  <<01885>>21279100
<<* this from occuring.                                   *>>  <<01885>>21279200
<<*********************************************************>>  <<01885>>21279300
                                                                        21279400
PDISABLE;                                                      <<01885>>21279500
                                                                        21279600
AWAKE(LOG'PIN,%20,0);                                          <<01878>>21280000
$IF X1=ON                                                      <<01883>>21280500
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>21280700
$IF                                                            <<01883>>21280800
$IF X1=ON                                                      <<01883>>21284100
       WHAT'S'UP ( BC'WAIT );                                  <<01883>>21284300
$IF                                                            <<01883>>21284400
                                                                        21285000
WAIT(-%20,0);                                                  <<01885>>21285100
                                                               <<01878>>21290000
                                                                        21295000
$edit void=21380000                                            <<01879>>21300000
<< The log process has tries to perform for change,check     >>         21385000
<< for errors. DB is at the LOGBUFF.                         >>         21390000
                                                                        21395000
$EDIT VOID=21402000                                            <<01879>>21400000
OBTAIN(LOGBUFF(RESOURCE2),NULL);                               <<01884>>21405000
$IF X1=ON                                                      <<01883>>21405100
       WHAT'S'UP ( BC'OBTAIN,2 );                              <<01883>>21405300
$IF                                                            <<01883>>21405400
IF LOGBUFF(LOGERR) THEN                                        <<01878>>21410000
   BEGIN                                                       <<01878>>21415000
   CHANGE'ERROR := TRUE;                                       <<01878>>21420000
   ULERRCODE := LOGBUFF(ULERR'CODE);                           <<01878>>21425000
   FSERRCODE := LOGBUFF(FSERR'CODE);                           <<01878>>21430000
   END;                                                        <<01878>>21435000
                                                               <<01878>>21440000
LOGBUFF(NOT'SAFE'TO'STOP) := FALSE;                            <<01885>>21441000
RELEASE(LOGBUFF(RESOURCE2),NULL,1);                            <<01884>>21445000
$IF X1=ON                                                      <<01883>>21445100
       WHAT'S'UP ( BC'RELEASE,2 );                             <<01883>>21445300
$IF                                                            <<01883>>21445400
EXCHANGEDB(STACK);                                             <<01878>>21450000
IF CHANGE'ERROR THEN                                           <<01883>>21455000
   BEGIN                                                       <<01883>>21455010
   AWAKE (LOG'PIN,%20,0);                                      <<01883>>21455020
$IF X1=ON                                                      <<01883>>21455100
       WHAT'S'UP ( BC'AWAKE );                                 <<01883>>21455300
$IF                                                            <<01883>>21455400
   END;                                                        <<01883>>21455500
FENTRY(LOGID',,NEWFILENAME);                                   <<01878>>21460000
                                                               <<01878>>21465000
DEL'LOCKWORD(NEWFILENAME);                                     <<01878>>21470000
NEWFILENAME (26) := 0;                                         <<01878>>21475000
DEL'LOCKWORD(OLDFILENAME);                                     <<01878>>21480000
OLDFILENAME (26) := 0;                                         <<01878>>21485000
IF CHANGE'ERROR THEN                                           <<01878>>21490000
   BEGIN                                                       <<01878>>21495000
   IF FSERRCODE <> 0 THEN                                      <<01878>>21500000
      GENMSG(FSSETNO,FSERRCODE,,,,,,,STDLIST);                 <<01878>>21505000
   IF ULERRCODE <> 0 THEN                                      <<01878>>21510000
      BEGIN                                                    <<01878>>21515000
      IF ULERRCODE = PREVIOUS'ERROR THEN                       <<01878>>21520000
         GENMSG(SETNO,ULERRCODE,0,@LOGID',,,,,STDLIST)         <<01878>>21525000
      ELSE                                                     <<01878>>21530000
         GENMSG(SETNO,ULERRCODE,0,@OLDFILENAME,@LOGID',,,,     <<01878>>21535000
                STDLIST);                                      <<01878>>21540000
      END;                                                     <<01878>>21545000
                                                               <<01878>>21550000
      RESETCRITICAL(CRSTATE);                                  <<01878>>21555000
   CIERR(ERRNUM:=CHANGELOG'FAILED,PARMSP);                     <<01878>>21560000
   RETURN;                                                     <<01878>>21565000
   END;                                                        <<01878>>21570000
                                                               <<01878>>21575000
GENMSG(SETNO,CHANGELOG'OK,0,@LOGID',@OLDFILENAME,@NEWFILENAME, <<01878>>21580000
        ,,STDLIST);                                            <<01878>>21585000
                                                               <<01878>>21590000
RESETCRITICAL(CRSTATE);                                        <<01878>>21595000
                                                               <<01878>>21600000
END;      << Procedure CXCHANGELOG >>                          <<01878>>21605000
$TITLE "Parsing Utilities"                                     <<01878>>21610000
$PAGE                                                          <<01878>>21615000
LOGICAL PROCEDURE PARSELOGID(PARMSP,PARMPTR,LEN,ERR);          <<01878>>21620000
   VALUE LEN;                                                  <<01878>>21625000
   BYTE ARRAY PARMSP;                                          <<01878>>21630000
   BYTE POINTER PARMPTR;                                       <<01878>>21635000
   INTEGER LEN,ERR;                                            <<01878>>21640000
   OPTION INTERNAL,UNCALLABLE;                                 <<01878>>21645000
                                                               <<01878>>21650000
BEGIN                                                          <<01878>>21655000
                                                               <<01878>>21660000
<< Parses the LOGID parameter from the command image. On   >>  <<01878>>21665000
<< return:                                                 >>  <<01878>>21670000
<<     PARMPTR -> the logid                                >>  <<01878>>21675000
<<                                                         >>  <<01878>>21680000
                                                               <<01878>>21685000
   BYTE POINTER                                                <<01878>>21690000
     BPS0 = S-0,                                               <<01878>>21695000
     PT;                                                       <<01878>>21700000
                                                               <<01878>>21705000
                                                               <<01878>>21710000
   PARSELOGID := FALSE;                                        <<01878>>21715000
                                                               <<01878>>21720000
   IF LEN > 8 THEN                                             <<01878>>21725000
   BEGIN                     <<logid too long>>                <<01878>>21730000
      ERR := LOGIDLENGTH;                                      <<01878>>21735000
      CIERR(ERR,PARMPTR);                                      <<01878>>21740000
      RETURN;                                                  <<01878>>21745000
   END;                                                        <<01878>>21750000
                                                               <<01878>>21755000
   IF LEN < 1 THEN                                             <<01878>>21760000
   BEGIN                     <<logid not found>>               <<01878>>21765000
      ERR := EXPECTEDLOGID;                                    <<01878>>21770000
      CIERR(ERR,PARMPTR);                                      <<01878>>21775000
      RETURN;                                                  <<01878>>21780000
   END;                                                        <<01878>>21785000
                                                               <<01878>>21790000
   IF PARMPTR <> ALPHA THEN                                    <<01878>>21795000
   BEGIN                     <<must start with alpha. char.>>  <<01878>>21800000
      ERR := NOTALPHALOGID;                                    <<01878>>21805000
      CIERR(ERR,PARMPTR);                                      <<01878>>21810000
      RETURN;                                                  <<01878>>21815000
   END;                                                        <<01878>>21820000
                                                               <<01878>>21825000
   MOVE PARMPTR := PARMPTR WHILE AN, 0;                        <<01878>>21830000
   @PT := @BPS0;                                               <<01878>>21835000
   IF (@PT - @PARMPTR) <> LEN THEN                             <<01878>>21840000
   BEGIN                     <<special characters>>            <<01878>>21845000
      ERR := NOSPECHAR;                                        <<01878>>21850000
      CIERR(ERR,PT);                                           <<01878>>21855000
      RETURN;                                                  <<01878>>21860000
   END;                                                        <<01878>>21865000
                                                               <<01878>>21870000
   PARSELOGID := TRUE;                                         <<01878>>21875000
END;                                                           <<01878>>21880000
                                                               <<01878>>21885000
                                                               <<01878>>21890000
$PAGE                                                          <<01878>>21895000
LOGICAL PROCEDURE PARSELOG(PARMPTR,DELIMPTR,QUALNAME,TYPE',    <<01878>>21900000
                           ALLOW'CHANGE,ERR);                  <<01878>>21905000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<01878>>21910000
   BYTE ARRAY QUALNAME;                                        <<01878>>21915000
   LOGICAL TYPE', ALLOW'CHANGE;                                <<01878>>21920000
   INTEGER ERR;                                                <<01878>>21925000
   OPTION INTERNAL,UNCALLABLE;                                 <<01878>>21930000
                                                               <<01878>>21935000
<<Parses the "LOG" parameter. Will return:                   >><<01878>>21940000
<<  QUALNAME = fully qualified filename.                     >><<01878>>21945000
<<  TYPE'  = type of the log file (QUALNAME).                >><<01878>>21950000
<<  PARMPTR,DELIMPTR = ptrs to the parm and it's delimiter.  >><<01878>>21955000
                                                               <<01878>>21960000
BEGIN                                                          <<01878>>21965000
                                                               <<01878>>21970000
   DEFINE                                                      <<01878>>21975000
      CLEAR'LOGFNAME=                                          <<01878>>21980000
           QUALNAME := " ";                                    <<01878>>21985000
           MOVE QUALNAME(1) := QUALNAME, (35)#;                <<01878>>21990000
                                                               <<01878>>21995000
   EQUATE                                                      <<01878>>22000000
      EQ   = "=",                                              <<01878>>22005000
      COMMA = ",";                                             <<01878>>22010000
   BYTE POINTER                                                <<01878>>22015000
      FILEPTR,GPPT,ACCPT,BPS0 = S-0;                           <<01878>>22020000
   INTEGER LEN,I;                                              <<01878>>22025000
   DOUBLE PDEF;              << Parms for call      >>         <<01878>>22030000
   LOGICAL DUMMY,EPTR;       <<   to CHECKFILENAME' >>         <<01878>>22035000
   BYTE ARRAY USER'NAME(0:7);                                  <<01878>>22040000
   BYTE ARRAY USER'ACCT(0:7);                                  <<01878>>22045000
                                                               <<01878>>22050000
   LOGICAL ARRAY DEF(*) = PDEF;                                <<01878>>22055000
                                                               <<01878>>22060000
   << The value in EPTR (from CHECKFILENAME') is a byte     >> <<01878>>22065000
   << pointer to where the error was found.                 >> <<01878>>22070000
                                                               <<01878>>22075000
   BYTE POINTER ERRPTR = EPTR;                                 <<01878>>22080000
                                                               <<01878>>22085000
   BYTE ARRAY CGROUP(0:8);                                     <<01878>>22090000
   BYTE ARRAY TYPELISTP(*) = PB :=                             <<01878>>22095000
           6,4,"DISC",                                         <<01878>>22100000
           6,4,"TAPE",                                         <<01878>>22105000
           7,5,"SDISC",                                        <<01878>>22110000
           7,5,"CTAPE",                                        <<01878>>22115000
           0;                                                  <<01878>>22120000
EQUATE DICTLEN = 27;                                           <<01878>>22125000
   BYTE ARRAY TYPELIST(0:DICTLEN-1);                           <<01878>>22130000
                                                               <<01878>>22135000
   PARSELOG := FALSE;                                          <<01878>>22140000
   MOVE TYPELIST := TYPELISTP, (DICTLEN);                      <<01878>>22145000
   TYPE' := 0;     << initialize  to 0 >>                      <<01878>>22150000
                                                               <<01878>>22155000
                                                               <<01878>>22160000
   IF DELIMPTR <> EQ THEN                                      <<01878>>22165000
   BEGIN                                                       <<01878>>22170000
      ERR := EXPECTEDEQ;                                       <<01878>>22175000
      CIERR(ERR,DELIMPTR);                                     <<01878>>22180000
      RETURN;                                                  <<01878>>22185000
   END;                                                        <<01878>>22190000
                                                               <<01878>>22195000
 << look at the actual filename not to determine if it >>      <<01878>>22200000
 << is a valid name.                                   >>      <<01878>>22205000
                                                               <<01878>>22210000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<01878>>22215000
                                                               <<01878>>22220000
   DEF(0) := @PARMPTR;       << Make it look like parm >>      <<01878>>22225000
   DEF(1) := LEN;            <<  from MYCOMMAND        >>      <<01878>>22230000
                                                               <<01878>>22235000
   ERR := CHECKFILENAME'(PDEF,DUMMY,DUMMY,EPTR);               <<01878>>22240000
   IF < THEN                                                   <<01878>>22245000
   BEGIN                     << Syntax error >>                <<01878>>22250000
      CIERR(ERR,ERRPTR);                                       <<01878>>22255000
      RETURN;                                                  <<01878>>22260000
   END;                                                        <<01878>>22265000
   IF > THEN                                                   <<01878>>22270000
   BEGIN                << Back ref. file or sys file >>       <<01878>>22275000
      IF ERR = 0                                               <<01878>>22280000
         THEN  CIERR(ERR:=NOBACKREF,PARMPTR)                   <<01878>>22285000
      ELSE  CIERR(ERR:=NOSYSFILE,PARMPTR);                     <<01878>>22290000
      RETURN;                                                  <<01878>>22295000
   END;                                                        <<01878>>22300000
                                                               <<01878>>22305000
   @FILEPTR := @PARMPTR;                                       <<01878>>22310000
   IF DELIMPTR <> COMMA THEN                                   <<01878>>22315000
   BEGIN                                                       <<01878>>22320000
      ERR := EXPECTEDCOMMA;                                    <<01878>>22325000
      CIERR(ERR,DELIMPTR);                                     <<01878>>22330000
      RETURN;                                                  <<01878>>22335000
   END;                                                        <<01878>>22340000
                                                               <<01878>>22345000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<01878>>22350000
<< look at the DISC,TAPE, ... parm to get device type >>       <<01878>>22355000
   I := SEARCH(PARMPTR,LEN,TYPELIST);                          <<01878>>22360000
   IF  I = 0  THEN                                             <<01878>>22365000
   BEGIN                     <<not found>>                     <<01878>>22370000
      ERR := ILLEGALTYPE;                                      <<01878>>22375000
      CIERR(ERR,PARMPTR);                                      <<01878>>22380000
      RETURN;                                                  <<01878>>22385000
   END                       <<not found>>                     <<01878>>22390000
                                                               <<01878>>22395000
   ELSE                                                        <<01878>>22400000
     IF I = 1  THEN                                            <<01878>>22405000
      BEGIN                  <<"DISC">>                        <<01878>>22410000
         CLEAR'LOGFNAME;                                       <<01878>>22415000
         QUALIFYFILENAME(FILEPTR,QUALNAME);                    <<01878>>22420000
                                                               <<01878>>22425000
                                                               <<01878>>22430000
         << Now check and see if the filename ends with "001">><<01878>>22435000
         << If it does, then the :CHANGELOG command will be  >><<01878>>22440000
         << allowed with this logid.                         >><<01878>>22445000
                                                               <<01878>>22450000
         MOVE QUALNAME := QUALNAME WHILE AN, 0;                <<01878>>22455000
         LEN := @BPS0 - @QUALNAME;    << Length of filename >> <<01878>>22460000
         DDEL;                                                 <<01878>>22465000
         IF LEN > 3 AND QUALNAME(LEN-3) = "001" THEN           <<01878>>22470000
            ALLOW'CHANGE := TRUE                               <<01878>>22475000
         ELSE                                                  <<01878>>22480000
            ALLOW'CHANGE := FALSE;                             <<01878>>22485000
                                                               <<01878>>22490000
         SCAN QUALNAME UNTIL " .", 1;                          <<01878>>22495000
         @GPPT := @BPS0 + 1;                                   <<01878>>22500000
         @BPS0 := @BPS0 + 1;                                   <<01878>>22505000
                                                               <<01878>>22510000
         SCAN * UNTIL " .", 1;                                 <<01878>>22515000
         @ACCPT := TOS + 1;                                    <<01878>>22520000
                                                               <<01878>>22525000
         WHO(,,,USER'NAME,CGROUP,USER'ACCT);                   <<01878>>22530000
         IF NOT COMPSTRING(CGROUP,GPPT,8)  OR                  <<01878>>22535000
            NOT COMPSTRING(USER'ACCT,ACCPT,8)  THEN            <<01878>>22540000
         BEGIN                                                 <<01878>>22545000
            ERR := ILLEGALFILE;                                <<01878>>22550000
            CIERR(ERR,FILEPTR);                                <<01878>>22555000
            RETURN;                                            <<01878>>22560000
         END;                                                  <<01878>>22565000
         TYPE'.TYP'FIRST := DISC;                              <<01908>>22570000
         TYPE'.TYP'CURRENT := DISC;                            <<01878>>22575000
      END                    <<"DISC">>                        <<01878>>22580000
                                                               <<01878>>22585000
  ELSE                                                         <<01878>>22590000
      IF  I >= 2 AND I <= 4  THEN                              <<01878>>22595000
      BEGIN                  << Serial log file >>             <<01878>>22600000
         CLEAR'LOGFNAME;                                       <<01878>>22605000
         MOVE QUALNAME := FILEPTR WHILE AN,0;                  <<01878>>22610000
                                                               <<01878>>22615000
         << Now check and see if the filename ends with "001">><<01878>>22620000
         << If it does, then the :CHANGELOG command will be  >><<01878>>22625000
         << allowed with this logid.                         >><<01878>>22630000
                                                               <<01878>>22635000
         LEN := @BPS0 - @FILEPTR;    << Length of filename   >><<01878>>22640000
         IF LEN > 3 AND QUALNAME(LEN-3) = "001" THEN           <<01878>>22645000
            ALLOW'CHANGE := TRUE                               <<01878>>22650000
         ELSE                                                  <<01878>>22655000
            ALLOW'CHANGE := FALSE;                             <<01878>>22660000
                                                               <<01878>>22665000
         IF BPS0 = "/" THEN                                    <<01878>>22670000
         BEGIN                                                 <<01878>>22675000
            ASSEMBLE(DDEL);                                    <<01878>>22680000
            ERR := ILLEGALTAPEFILE;                            <<01878>>22685000
            CIERR(ERR,FILEPTR);                                <<01878>>22690000
            RETURN;                                            <<01878>>22695000
         END;                                                  <<01878>>22700000
                                                               <<01878>>22705000
         IF BPS0 = "."  THEN                                   <<01878>>22710000
         BEGIN                                                 <<01878>>22715000
            ASSEMBLE(DDEL);                                    <<01878>>22720000
            ERR := ILLEGALTAPEFILE;                            <<01878>>22725000
            CIERR(ERR,FILEPTR);                                <<01878>>22730000
            RETURN;                                            <<01878>>22735000
         END;                                                  <<01878>>22740000
                                                               <<01878>>22745000
         QUALIFYFILENAME(FILEPTR,QUALNAME);                             22750000
         CASE I OF                                             <<01878>>22755000
         BEGIN                                                 <<01878>>22760000
            <<0>>  ;    << Error clause - never get here >>    <<01878>>22765000
            <<1>>  ;    << "DISC" - never get here >>          <<01878>>22770000
            <<2>>  BEGIN                                       <<01878>>22775000
                   TYPE'.TYP'FIRST := TAPE;                    <<01908>>22780000
                   TYPE'.TYP'CURRENT := TAPE;                  <<01878>>22785000
                   END;                                        <<01878>>22790000
                                                               <<01878>>22795000
            <<3>>  BEGIN                                       <<01878>>22800000
                   TYPE'.TYP'FIRST := SDISC;                   <<01908>>22805000
                   TYPE'.TYP'CURRENT := SDISC;                 <<01878>>22810000
                   END;                                        <<01878>>22815000
                                                               <<01878>>22820000
            <<4>>  BEGIN                                       <<01878>>22825000
                   TYPE'.TYP'FIRST := CTAPE;                   <<01908>>22830000
                   TYPE'.TYP'CURRENT := CTAPE;                 <<01878>>22835000
                   END;                                        <<01878>>22840000
         END;                                                  <<01878>>22845000
                                                               <<01878>>22850000
      END;                   <<"TAPE">>                        <<01878>>22855000
                                                               <<01878>>22860000
                                                               <<01878>>22865000
   PARSELOG := TRUE;                                           <<01878>>22870000
END;                                                           <<01878>>22875000
                                                               <<01878>>22880000
                                                               <<01878>>22885000
                                                               <<01878>>22890000
$PAGE                                                          <<01878>>22895000
LOGICAL PROCEDURE PARSEPASS(PARMPTR,DELIMPTR,BPASS,ERR);       <<01878>>22900000
   BYTE POINTER  PARMPTR,DELIMPTR;                             <<01878>>22905000
   BYTE ARRAY BPASS;                                           <<01878>>22910000
   INTEGER ERR;                                                <<01878>>22915000
   OPTION INTERNAL,UNCALLABLE;                                 <<01878>>22920000
                                                               <<01878>>22925000
<<Parses the PASS parameter. Returns:                        >><<01878>>22930000
<<  TRUE if correct syntax found.                            >><<01878>>22935000
<<  BPASS   = the password.                                  >><<01878>>22940000
<<  PARMPTR,DELIMPTR = ptrs to the parm and it's delimeter.  >><<01878>>22945000
                                                               <<01878>>22950000
BEGIN                                                          <<01878>>22955000
   EQUATE   EQ  =  "=";                                        <<01878>>22960000
   INTEGER LEN;                                                <<01878>>22965000
   BYTE POINTER PT;                                            <<01878>>22970000
                                                               <<01878>>22975000
   PARSEPASS := FALSE;                                         <<01878>>22980000
                                                               <<01878>>22985000
   IF DELIMPTR <> EQ THEN                                      <<01878>>22990000
   BEGIN                                                       <<01878>>22995000
      ERR := EXPECTEDEQ;                                       <<01878>>23000000
      CIERR(ERR,PARMPTR);                                      <<01878>>23005000
      RETURN;                                                  <<01878>>23010000
   END;                                                        <<01878>>23015000
                                                               <<01878>>23020000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<01878>>23025000
   IF LEN > 8 THEN                                             <<01878>>23030000
   BEGIN                     <<password too long>>             <<01878>>23035000
      ERR := PWLEN;                                            <<01878>>23040000
      CIERR(ERR,PARMPTR);                                      <<01878>>23045000
      RETURN;                                                  <<01878>>23050000
   END;                      <<password too long>>             <<01878>>23055000
                                                               <<01878>>23060000
   IF LEN = 0  THEN                                            <<01878>>23065000
   BEGIN                     <<password not found>>            <<01878>>23070000
      MOVE BPASS := "        ";                                <<01878>>23075000
      PARSEPASS := TRUE;                                       <<01878>>23080000
      RETURN;                                                  <<01878>>23085000
   END;                      <<password not found>>            <<01878>>23090000
                                                               <<01878>>23095000
   MOVE PARMPTR := PARMPTR WHILE AN,0;                         <<01878>>23100000
   @PT := TOS;                                                 <<01878>>23105000
   ASSEMBlE(DEL);                                              <<01878>>23110000
                                                               <<01878>>23115000
   IF (@PT - @PARMPTR) <> LEN THEN                             <<01878>>23120000
   BEGIN                     <<special chars>>                 <<01878>>23125000
      ERR := NOSPECHAR;                                        <<01878>>23130000
      CIERR(ERR,PT);                                           <<01878>>23135000
      RETURN;                                                  <<01878>>23140000
   END;                      <<special chars>>                 <<01878>>23145000
                                                               <<01878>>23150000
   MOVE BPASS := PARMPTR, (LEN);                               <<01878>>23155000
   PARSEPASS := TRUE;                                          <<01878>>23160000
END;                                                           <<01878>>23165000
                                                               <<01878>>23170000
                                                               <<01878>>23175000
$PAGE  "ERROR CHECKING UTILITIES"                              <<01878>>23180000
                                                               <<01878>>23185000
PROCEDURE MOVE'FROM'DSEG(TARGET,SEGMENT,OFFSET,COUNT);         <<01878>>23190000
   VALUE TARGET,SEGMENT,OFFSET,COUNT;                          <<01878>>23195000
   INTEGER TARGET,SEGMENT,OFFSET,COUNT;                        <<01878>>23200000
   OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                      <<01878>>23205000
                                                               <<01878>>23210000
BEGIN                                                          <<01878>>23215000
                                                               <<01878>>23220000
                                                               <<01878>>23225000
   TOS := TARGET;                                              <<01878>>23230000
   TOS := SEGMENT;                                             <<01878>>23235000
   TOS := OFFSET;                                              <<01878>>23240000
   TOS := COUNT;                                               <<01878>>23245000
   ASSEMBLE (MFDS 4);                                          <<01878>>23250000
                                                               <<01878>>23255000
                                                               <<01878>>23260000
END;                                                           <<01878>>23265000
                                                               <<01878>>23270000
                                                               <<01878>>23275000
                                                               <<01878>>23280000
$PAGE                                                          <<01878>>23285000
PROCEDURE MOVE'TO'DSEG(SEGMENT,OFFSET,SOURCE,COUNT);           <<01878>>23290000
   VALUE SEGMENT,OFFSET,SOURCE,COUNT;                          <<01878>>23295000
   INTEGER SEGMENT,OFFSET,SOURCE,COUNT;                        <<01878>>23300000
   OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                      <<01878>>23305000
                                                               <<01878>>23310000
BEGIN                                                          <<01878>>23315000
                                                               <<01878>>23320000
   TOS := SEGMENT;                                             <<01878>>23325000
   TOS := OFFSET;                                              <<01878>>23330000
   TOS := SOURCE;                                              <<01878>>23335000
   TOS := COUNT;                                               <<01878>>23340000
   ASSEMBLE (MTDS 4);                                          <<01878>>23345000
                                                               <<01878>>23350000
                                                               <<01878>>23355000
END;                                                           <<01878>>23360000
$PAGE                                                          <<01881>>23364000
LOGICAL PROCEDURE BYTE'TO'WORD (BYTEADDR, WORDADDR);           <<01881>>23364300
   BYTE ARRAY BYTEADDR;                                        <<01881>>23364600
   INTEGER WORDADDR;                                           <<01881>>23364900
                                                               <<01878>>23365000
                                                               <<01881>>23365200
<< This procedure converts a byte address to a word address, >><<01881>>23365500
<< taking care to see if it is above or below DB.            >><<01881>>23365800
                                                               <<01881>>23366100
BEGIN                                                          <<01881>>23366400
                                                               <<01881>>23366700
   INTEGER                                                     <<01881>>23367000
      DB'TO'Z,                                                 <<01881>>23367300
      DB'TO'DL,                                                <<01881>>23367600
      DB'PLUS,                                                 <<01881>>23367900
      DB'MINUS;                                                <<01881>>23368200
                                                               <<01881>>23368500
BYTE'TO'WORD := FALSE;                                         <<01881>>23368800
PUSH (Z,DL);                                                   <<01881>>23369100
DB'TO'DL := TOS;                                               <<01881>>23369400
DB'TO'Z  := TOS;                                               <<01881>>23369700
DB'PLUS  := @BYTEADDR & LSR(1);                                <<01881>>23370000
DB'MINUS := @BYTEADDR & ASR(1);                                <<01881>>23370300
                                                               <<01881>>23370600
IF DB'PLUS < DB'TO'Z THEN     << must be DB+ relative >>       <<01881>>23370900
   WORDADDR := DB'PLUS                                         <<01881>>23371200
ELSE                          << it's DB- relative >>          <<01881>>23371500
   BEGIN                                                       <<01881>>23371800
   IF DB'MINUS > DB'TO'DL THEN                                 <<01881>>23372100
      WORDADDR := DB'MINUS                                     <<01881>>23372400
   ELSE                                                        <<01881>>23372700
      RETURN;                                                  <<01881>>23373000
   END;                                                        <<01881>>23373300
                                                               <<01881>>23373600
BYTE'TO'WORD := TRUE;                                          <<01881>>23373900
                                                               <<01881>>23374200
END;                                                           <<01881>>23374500
$PAGE                                                          <<01878>>23375000
LOGICAL PROCEDURE CHEKINDEX(BUFDST,ENUM);                      <<01878>>23380000
   VALUE ENUM;                                                 <<01878>>23385000
   INTEGER BUFDST,ENUM;                                        <<01878>>23390000
   OPTION PRIVILEGED,INTERNAL,UNCALLABLE;                      <<01878>>23395000
                                                               <<01878>>23400000
<< Checks value of the "INDEX" parameter for all intrinsics >> <<01878>>23405000
<< ENTRY:                                                   >> <<01878>>23410000
<<       BUFDST - offset into LOGTAB for the log process    >> <<01878>>23415000
<<       ENUM   - entry offset into LOGBUFF for the user    >> <<01878>>23420000
<<                                                          >> <<01878>>23425000
<< RETURNS:                                                 >> <<01878>>23430000
<<    FALSE - bad value of BUFDST or ENUM.                  >> <<01878>>23435000
<<     TRUE - all O.K.                                      >> <<01878>>23440000
<<     BUFDST - the dst# of the LOGBUFF                    >> <<<01878>>23445000
<<     ENUM   - unchanged.                                 >>  <<01878>>23450000
                                                               <<01878>>23455000
<< DB must be at stack.                                      >><<01878>>23460000
                                                               <<01878>>23465000
BEGIN                                                          <<01878>>23470000
                                                               <<01878>>23475000
   INTEGER                                                     <<01878>>23480000
      A,              << Used for GETSIR/RELSIR >>             <<01878>>23485000
      TABINDEX,       << Index into the LOGTAB >>              <<01878>>23490000
      MAX'USERS,      << Max # users per logging process >>    <<01878>>23495000
      MAX'PROCS,      << Max # user logging processes   >>     <<01878>>23500000
      TEMP;                                                    <<01878>>23505000
                                                               <<01878>>23510000
   ARRAY LOGTAB'LOGID(0:3) = Q;                                <<01878>>23515000
   BYTE ARRAY BLOGTAB'LOGID(*) = LOGTAB'LOGID;                 <<01878>>23520000
                                                               <<01878>>23525000
                                                               <<01878>>23530000
                                                               <<01878>>23535000
CHEKINDEX := FALSE;                                            <<01878>>23540000
                                                               <<01878>>23545000
<< Make sure that BUFDST is really a valid offset into the  >> <<01878>>23550000
<< LOGTAB.                                                  >> <<01878>>23555000
                                                               <<01878>>23560000
TABINDEX := BUFDST;                                            <<01878>>23565000
                                                               <<01878>>23570000
A := GETSIR(LOGSIR);                                           <<01878>>23575000
                                                               <<01878>>23580000
MOVE'FROM'DSEG(@MAX'PROCS,LOGDST,MAXLOGPROCS,1);               <<01878>>23585000
                                                               <<01878>>23590000
IF (TABINDEX < TENTRYSIZE) OR (TABINDEX>(TENTRYSIZE*MAX'PROCS))<<01878>>23595000
   OR  (TABINDEX MOD TENTRYSIZE <> 0)   THEN                   <<01878>>23600000
BEGIN                                                          <<01878>>23605000
   RELSIR(LOGSIR,A);                                           <<01878>>23610000
   RETURN;                                                     <<01878>>23615000
END;                                                           <<01878>>23620000
                                                               <<01878>>23625000
<< Make sure this entry is a valid entry. >>                   <<01878>>23630000
                                                               <<01878>>23635000
MOVE'FROM'DSEG(@LOGTAB'LOGID,LOGDST,LGNAME/2,4);               <<01878>>23640000
                                                               <<01878>>23645000
IF BLOGTAB'LOGID = "        " THEN                             <<01878>>23650000
BEGIN                                                          <<01878>>23655000
   RELSIR(LOGSIR,A);                                           <<01878>>23660000
   RETURN;                                                     <<01878>>23665000
END;                                                           <<01878>>23670000
                                                               <<01878>>23675000
<< Looks O.K. Now get the dst # of the LOGBUFF >>              <<01878>>23680000
                                                               <<01878>>23685000
MOVE'FROM'DSEG(@TEMP,LOGDST,DST,1);                            <<01878>>23690000
                                                               <<01878>>23695000
IF TEMP = NULL  THEN                                           <<01878>>23700000
BEGIN                                                          <<01878>>23705000
   RELSIR(LOGSIR,A);                                           <<01878>>23710000
   RETURN;                                                     <<01878>>23715000
END;                                                           <<01878>>23720000
                                                               <<01878>>23725000
                                                               <<01878>>23730000
<< We've got the dst # of the LOGBUFF...keep it! >>            <<01878>>23735000
                                                               <<01878>>23740000
BUFDST := TEMP;                                                <<01878>>23745000
                                                               <<01878>>23750000
<< See if ENUM is a valid offset within the Logging Buffer. >> <<01878>>23755000
<< Offset range based on # entries allowed (MAX'USERS) and  >> <<01878>>23760000
<< length of Global area (BENTRYBASE).                      >> <<01878>>23765000
                                                               <<01878>>23770000
MOVE'FROM'DSEG(@MAX'USERS,BUFDST,MAXUSER',1);                  <<01878>>23775000
                                                               <<01878>>23780000
RELSIR(LOGSIR,A);                                              <<01878>>23785000
                                                               <<01878>>23790000
                                                               <<01878>>23795000
IF (ENUM < BENTRYBASE) OR                                      <<01878>>23800000
   (ENUM MOD BENTRYSIZE <> 0) OR                               <<01878>>23805000
   (ENUM >= BENTRYBASE+(MAX'USERS*BENTRYSIZE))  THEN  RETURN;  <<01878>>23810000
                                                               <<01878>>23815000
                                                               <<01878>>23820000
<< All tests passed ! >>                                       <<01878>>23825000
                                                               <<01878>>23830000
CHEKINDEX := TRUE;                                             <<01878>>23835000
END;                                                           <<01878>>23840000
                                                               <<01878>>23845000
procedure currentlogfile(wlogid',wpass',wcurfname',            <<01878>>23850000
    curtype,stat);                                             <<01878>>23855000
logical array wlogid',wpass',wcurfname';                       <<01878>>23860000
integer curtype,stat;                                          <<01878>>23865000
option privileged;                                             <<01878>>23870000
                                                               <<01878>>23875000
                                                               <<01878>>23880000
begin                                                          <<01878>>23885000
  define intrinexit = [10/214,6/5]#,                           <<01878>>23890000
         flags      = [1/1,8/0,7/5]#;                          <<01878>>23895000
  byte array blogid'(*)=wlogid',                               <<01878>>23900000
             bpass'(*)=wpass',                                 <<01878>>23905000
             bcurfname'(*)=wcurfname';                         <<01878>>23910000
  array wcurrent'filename(0:18)=q;                             <<01878>>23915000
  byte array current'filename(*)=wcurrent'filename;            <<01878>>23920000
  logical array                                                <<01878>>23925000
    local'logid(0:4)=q,                                        <<01878>>23930000
    local'pass(0:4)=q;                                         <<01878>>23935000
  byte array                                                   <<01878>>23940000
    local'blogid (*)=local'logid,                              <<01878>>23945000
    local'bpass(*)=local'pass,                                 <<01878>>23950000
    lidtab'bpass(0:4)=q;                                       <<01878>>23955000
  integer                                                      <<01878>>23960000
    bufdst,tabindex,current'type,original'db;                  <<01878>>23965000
  integer                                                      <<01878>>23970000
    x=x;                                                       <<01878>>23975000
  logical                                                      <<01878>>23980000
    crstate,a;                                                 <<01878>>23985000
  double                                                       <<01878>>23990000
    parms,bounds;                                              <<01878>>23995000
  logical                                                      <<01878>>24000000
    parms1=parms,                                              <<01878>>24005000
    parms2=parms+1,                                            <<01878>>24010000
    lower'bound=bounds,                                        <<01878>>24015000
    upper'bound=bounds+1;                                      <<01878>>24020000
                                                               <<01878>>24025000
                                                               <<01878>>24030000
  erroron;                                                     <<01878>>24035000
                                                               <<01878>>24040000
                                                               <<01878>>24045000
  parms1:=0;                                                   <<01878>>24050000
  parms2:=[6/0,2/2,2/2,2/2,2/2,2/2];                           <<01878>>24055000
                                                               <<01878>>24060000
  <<check bound of parameters passed to this intrinsic>>       <<01878>>24065000
  <<check returns a double word - upper and lower     >>       <<01878>>24070000
  <<allowable bounds.                                 >>       <<01878>>24075000
                                                               <<01878>>24080000
  bounds:=chek(intrinexit,flags,parms);                        <<01878>>24085000
  if logical(@wlogid'+3) > upper'bound                         <<01878>>24090000
     or logical(@wpass'+3) > upper'bound                       <<01878>>24095000
     or logical(@wcurfname'+17) > upper'bound then             <<01878>>24100000
     begin                                                     <<01878>>24105000
       stat:=boundserr;                                        <<01878>>24110000
       errorexit(intrinexit,0,0);    <<return>>                <<01878>>24115000
     end;                                                      <<01878>>24120000
                                                               <<01878>>24125000
     <<get local copy of logid,password>>                      <<01878>>24130000
                                                               <<01878>>24135000
  x:=0;                                                        <<01878>>24140000
  do local'logid(x):="  " until (x:=x+1) >= 8;                 <<01878>>24145000
  x:=0;                                                        <<01878>>24150000
  do local'pass(x):="  " until (x:=x+1) >= 8;                  <<01878>>24155000
  x:=0;                                                        <<01878>>24160000
  while (blogid'(x)=alpha or blogid'(x)=numeric)               <<01878>>24165000
         and x <= 8 do                                         <<01878>>24170000
  begin                                                        <<01878>>24175000
    local'blogid(x):=blogid'(x);                               <<01878>>24180000
    x:=x+1;                                                    <<01878>>24185000
  end;                                                         <<01878>>24190000
  if x <= 0 then                                               <<01878>>24195000
     begin                                                     <<01878>>24200000
       stat:=invalidlogid;                                     <<01878>>24205000
       errorexit(intrinexit,0,0);                              <<01878>>24210000
     end;                                                      <<01878>>24215000
  x:=0;                                                        <<01878>>24220000
  while (bpass'(x)=alpha or bpass'(x)=numeric) and x <= 8 do   <<01878>>24225000
     begin                                                     <<01878>>24230000
       local'bpass(x):=bpass'(x);                              <<01878>>24235000
       x:=x+1;                                                 <<01878>>24240000
     end;                                                      <<01878>>24245000
                                                               <<01878>>24250000
 <<now put db at the stack>>                                   <<01878>>24255000
                                                               <<01878>>24260000
  original'db:=exchangedb(0);                                  <<01878>>24265000
                                                               <<01878>>24270000
  <<now check for proper capability>>                          <<01878>>24275000
                                                               <<01878>>24280000
  if not okay'ucap then                                        <<01878>>24285000
     begin                                                     <<01878>>24290000
       exchangedb(original'db);                                <<01878>>24295000
       stat:=illegalcap;                                       <<01878>>24300000
       errorexit(intrinexit,0,0);                              <<01878>>24305000
     end;                                                      <<01878>>24310000
                                                               <<01878>>24315000
  local'blogid(8):=" ";                                        <<01878>>24320000
  local'bpass(8):=" ";                                         <<01878>>24325000
                                                               <<01878>>24330000
  <<upshift>>                                                  <<01878>>24335000
                                                               <<01878>>24340000
                                                               <<01878>>24345000
  move local'blogid := local'blogid while ANS;                 <<01878>>24350000
  move local'bpass:=local'bpass while ANS;                     <<01878>>24355000
                                                               <<01878>>24360000
  crstate:=setcritical;                                        <<01878>>24365000
  a:=getsir(logsir);                                           <<01878>>24370000
                                                               <<01878>>24375000
  <<see if the logid (wlogid') is in the lid table,and need>>  <<01878>>24380000
  <<to get the password.                                   >>  <<01878>>24385000
                                                               <<01878>>24390000
  fentry(local'blogid,lidtab'bpass);                           <<01878>>24395000
  if > then                                                    <<01878>>24400000
     begin          <<logid not found in lidtable>>            <<01878>>24405000
       relsir(logsir,a);                                       <<01878>>24410000
       resetcritical(crstate);                                 <<01878>>24415000
       exchangedb(original'db);                                <<01878>>24420000
       stat:=invalidlogid;                                     <<01878>>24425000
       errorexit(intrinexit,0,0);       <<return>>             <<01878>>24430000
     end;                                                      <<01878>>24435000
                                                               <<01878>>24440000
  <<logid was found in lidtab. now check password>>            <<01878>>24445000
                                                               <<01878>>24450000
  if not compstring(local'bpass,lidtab'bpass,8) then           <<01878>>24455000
     begin                                                     <<01878>>24460000
       relsir(logsir,a);                                       <<01878>>24465000
       resetcritical(crstate);                                 <<01878>>24470000
       exchangedb(original'db);                                <<01878>>24475000
       stat:=passerr;                                          <<01878>>24480000
       errorexit(intrinexit,0,0);        <<<return>>           <<01878>>24485000
     end;                                                      <<01878>>24490000
  <<password ok logid in lidtab. now must be active log>>      <<01878>>24495000
  <<process (ie definred in logtab)                    >>      <<01878>>24500000
                                                               <<01878>>24505000
  if findlog (local'blogid,tabindex) then                      <<01878>>24510000
     begin           <<found it !!>>                           <<01878>>24515000
       move'from'dseg(@bufdst,logdst,dst,1);                   <<01878>>24520000
       exchangedb(bufdst);                                     <<01878>>24525000
                                                               <<01878>>24530000
       <<now lock the logbuff>>                                <<01878>>24535000
                                                               <<01878>>24540000
      obtain(logbuff(resource2),null);                         <<01884>>24545000
$IF X1=ON                                                      <<01883>>24545100
       WHAT'S'UP ( BC'OBTAIN,2 );                              <<01883>>24545300
$IF                                                            <<01883>>24545400
       exchangedb(0);                                          <<01878>>24550000
       move'from'dseg(@wcurrent'filename,bufdst,               <<01878>>24555000
            current'file/2,18);                                <<01878>>24560000
       exchangedb(bufdst);                                     <<01878>>24565000
       current'filename(35):=" ";                              <<01878>>24570000
       current'type:=logbuff(c'type);                          <<01878>>24575000
      release(logbuff(resource2),null,1);                      <<01884>>24580000
$IF X1=ON                                                      <<01883>>24580100
       WHAT'S'UP ( BC'RELEASE,2 );                             <<01883>>24580300
$IF                                                            <<01883>>24580400
       exchangedb(original'db);                                <<01878>>24585000
       relsir(logsir,a);                                       <<01878>>24590000
       resetcritical(crstate);                                 <<01878>>24595000
                                                               <<01878>>24600000
       <<copy local copy of return info into parameters>>      <<01878>>24605000
                                                               <<01878>>24610000
       curtype:=current'type;                                  <<01878>>24615000
       x:=0;                                                   <<01878>>24620000
       do bcurfname'(x):=current'filename(x) until             <<01878>>24625000
          (x:=x+1) >= 36;                                      <<01878>>24630000
       stat:=0;                                                <<01878>>24635000
       errorexit(intrinexit,0,0);        <<good, all done!>>   <<01878>>24640000
     end                                                       <<01878>>24645000
  else                                                         <<01878>>24650000
     begin                                                     <<01878>>24655000
     relsir(logsir,a);                                         <<01878>>24660000
     resetcritical(crstate);                                   <<01878>>24665000
     exchangedb(original'db);                                  <<01878>>24670000
     stat:=nologproc;                                          <<01878>>24675000
     errorexit(intrinexit,0,0);     <<return>>                 <<01878>>24680000
     end;                                                      <<01878>>24685000
end;                                                           <<01878>>24690000
$page      "LOGSEG1        LOGGING INTRINSICS -- LOGINFO"               24695000
PROCEDURE LOGINFO(ENTRY'INDEX,STATUS',ITEMNUM1,ITEMVAL1,                24700000
       ITEMNUM2,ITEMVAL2,ITEMNUM3,ITEMVAL3,ITEMNUM4,ITEMVAL4);          24705000
                                                                        24710000
VALUE ENTRY'INDEX,ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4;                  24715000
DOUBLE ENTRY'INDEX;                                                     24720000
INTEGER STATUS',ITEMNUM1,ITEMNUM2,ITEMNUM3,ITEMNUM4;                    24725000
BYTE ARRAY ITEMVAL1,ITEMVAL2,ITEMVAL3,ITEMVAL4;                         24730000
OPTION VARIABLE,PRIVILEGED;                                             24735000
                                                                        24740000
BEGIN                                                                   24745000
   INTEGER CRSTATE,STACK,INDEX,TABINDEX,W'ITEMVAL;             <<01881>>24750000
   INTEGER I,K;                                                         24755000
                                                                        24760000
   DOUBLE DTEMP;                                                        24765000
   BYTE ARRAY B'TEMP(*) = DTEMP;                                        24770000
                                                                        24775000
   INTEGER ARRAY INDEX'(*) = ENTRY'INDEX;                               24780000
   INTEGER ARRAY NUMTABLE(0:3) = Q;                                     24785000
   LOGICAL ARRAY ENTRY'(0:BENTRYSIZE-1) = Q;                            24790000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      24795000
                                                                        24800000
   BYTE ARRAY CNAME(0:8) = Q;                                           24805000
   BYTE ARRAY CGROUP(0:8) = Q;                                          24810000
   BYTE ARRAY CACCT(0:8) = Q;                                           24815000
   LOGICAL BUFDST,ENUM,ERROR';                                          24820000
   DOUBLE BOUNDS,PARMS;                                                 24825000
   INTEGER                                                     <<01880>>24830000
      LOWER'BOUND = BOUNDS,                                    <<01880>>24835000
      UPPER'BOUND = BOUNDS + 1;                                <<01880>>24840000
   LOGICAL PARMMASK = Q-4;                                              24845000
   LOGICAL PARMS1 = PARMS;                                              24850000
   LOGICAL PARMS2 = PARMS + 1;                                          24855000
                                                                        24860000
   DOUBLE ARRAY D'GLOBAL'AREA(0:BENTRYBASE/2) = Q;                      24865000
   LOGICAL ARRAY L'GLOBAL'AREA(*) = D'GLOBAL'AREA;                      24870000
   INTEGER ARRAY I'GLOBAL'AREA(*) = D'GLOBAL'AREA;                      24875000
   BYTE ARRAY B'GLOBAL'AREA(*) = D'GLOBAL'AREA;                         24880000
   EQUATE                                                               24885000
      MAXITEMNUM = 13,                                         <<01878>>24890000
      OPTV'MASK = %377;                                        <<01878>>24895000
                                                                        24900000
   DEFINE INTRINEXIT = [10/215,6/12]#,                         <<01880>>24905000
   FLAG = [1/1,8/0,7/10]#;                                              24910000
                                                                        24915000
                                                                        24920000
                                                                        24925000
LOGICAL SUBROUTINE GET'ITEMVAL( ITEMNUM,ITEMVAL );                      24930000
VALUE ITEMNUM;                                                          24935000
INTEGER ITEMNUM;                                                        24940000
BYTE ARRAY ITEMVAL;                                                     24945000
                                                                        24950000
BEGIN                                                                   24955000
   GET'ITEMVAL := TRUE;                                                 24960000
   CASE ITEMNUM OF                                                      24965000
       BEGIN                                                            24970000
       <<00>> ;<<NULL FOR ITEMNUM 0>>                                   24975000
                                                                        24980000
       <<01>> BEGIN       << RETURN A DOUBLE >>                         24985000
              DTEMP := D'GLOBAL'AREA(TRECS) -                           24990000
                       D'GLOBAL'AREA(RECS'IN'PREV);                     24995000
              K := 0;                                                   25000000
              DO                                                        25005000
                 ITEMVAL(K) := B'TEMP(K)                                25010000
              UNTIL ( K := K + 1 ) >= 4;                                25015000
              END;                                                      25020000
                                                                        25025000
       <<02>> BEGIN       << RETURN A DOUBLE >>                         25030000
              IF L'GLOBAL'AREA(LOGTYPE) <> DISC THEN                    25035000
                   BEGIN                                                25040000
                   K := 0;                                              25045000
                   DO                                                   25050000
                      ITEMVAL(K) := 0                                   25055000
                   UNTIL (K:=K+1) >= 4;                                 25060000
                   END                                                  25065000
              ELSE                                                      25070000
                 BEGIN                                                  25075000
                 K := 0;                                                25080000
                 DO                                                     25085000
                   ITEMVAL(K) := B'GLOBAL'AREA(MAXFSPACE*4+K)           25090000
                 UNTIL  (K:=K+1) >= 4;                                  25095000
                 END;                                                   25100000
              END;                                                      25105000
                                                                        25110000
       <<03>> BEGIN        << RETURN A DOUBLE >>                        25115000
              IF L'GLOBAL'AREA(LOGTYPE) <> DISC THEN                    25120000
                 BEGIN                                                  25125000
                 K := 0;                                                25130000
                 DO                                                     25135000
                    ITEMVAL(K) := 0                                     25140000
                 UNTIL (K:=K+1) >=4;                                    25145000
                 END                                                    25150000
              ELSE                                                      25155000
                BEGIN                                                   25160000
                DTEMP := D'GLOBAL'AREA(MAXFSPACE) -                     25165000
                         D'GLOBAL'AREA(TRECS);                          25170000
                K := 0;                                                 25175000
                DO                                                      25180000
                   ITEMVAL(K) := B'TEMP(K)                              25185000
                UNTIL (K:=K+1) >= 4;                                    25190000
                END;                                                    25195000
              END;                                                      25200000
                                                                        25205000
       <<04>> BEGIN        << RETURN A INTEGER >>                       25210000
              K := 0;                                                   25215000
              DO                                                        25220000
                ITEMVAL(K) := B'GLOBAL'AREA(NUMUSER*2+K)                25225000
              UNTIL (K:=K+1) >= 2;                                      25230000
              END;                                                      25235000
                                                                        25240000
       <<05>> BEGIN        << RETURN A DOUBLE >>                        25245000
                K := 0;                                                 25250000
                DO                                                      25255000
                ITEMVAL(K) := B'GLOBAL'AREA (TRECS*4 + K)               25260000
                UNTIL (K := K + 1 ) >= 4;                               25265000
              END;                                                      25270000
                                                                        25275000
       <<06>> BEGIN           << RETURN A BYTE ARRAY >>                 25280000
              IF NOT BYTE'TO'WORD (ITEMVAL, W'ITEMVAL) THEN    <<01881>>25280100
                 BEGIN                                         <<01881>>25280200
                 STATUS' := BOUNDSERR;                         <<01881>>25280300
                 GET'ITEMVAL := FALSE;                         <<01881>>25280400
                 END                                           <<01881>>25280500
              ELSE  << W'ITEMVAL is word address of ITEMVAL >> <<01881>>25280600
                 BEGIN                                         <<01881>>25280700
                 IF (W'ITEMVAL+18 > UPPER'BOUND) OR            <<01881>>25285000
                    (W'ITEMVAL < LOWER'BOUND) THEN             <<01881>>25290000
                    BEGIN                                      <<01881>>25295000
                    STATUS' := BOUNDSERR;                      <<01881>>25300000
                    GET'ITEMVAL := FALSE;                      <<01881>>25305000
                    END                                        <<01881>>25310000
                 ELSE                                          <<01881>>25315000
                    BEGIN                                      <<01881>>25320000
                    K := 0;                                             25325000
                    DO                                                  25330000
                    ITEMVAL(K) := B'GLOBAL'AREA(CURRENT'FILE+K)         25335000
                    UNTIL (K:=K+1) >= 35;                               25340000
                    END;                                       <<01881>>25345000
                 END;                                          <<01881>>25346000
              END;                                             <<01881>>25350000
                                                                        25355000
       <<07>> BEGIN        << RETURN A INTEGER >>                       25360000
              K := 0;                                                   25365000
              DO                                                        25370000
                ITEMVAL(K) := B'GLOBAL'AREA(C'TYPE*2+K)                 25375000
              UNTIL   (K:=K+1) >= 2;                                    25380000
              END;                                                      25385000
                                                                        25390000
       <<08>> BEGIN        << RETURN A BYTE ARRAY >>                    25395000
              IF NOT BYTE'TO'WORD (ITEMVAL, W'ITEMVAL) THEN    <<01881>>25396000
                 BEGIN                                         <<01881>>25396100
                 STATUS' := BOUNDSERR;                         <<01881>>25396200
                 GET'ITEMVAL := FALSE;                         <<01881>>25396300
                 END                                           <<01881>>25396400
              ELSE  << W'ITEMVAL is word address of ITEMVAL >> <<01881>>25396500
                 BEGIN                                         <<01881>>25396600
                 IF (W'ITEMVAL+18 > UPPER'BOUND) OR            <<01881>>25400000
                    (W'ITEMVAL < LOWER'BOUND) THEN             <<01881>>25405000
                    BEGIN                                      <<01881>>25410000
                    STATUS' := BOUNDSERR;                      <<01881>>25415000
                    GET'ITEMVAL := FALSE;                      <<01881>>25420000
                    END                                        <<01881>>25425000
                 ELSE                                          <<01881>>25430000
                    BEGIN                                      <<01881>>25435000
                    K := 0;                                    <<01881>>25440000
                    DO                                         <<01881>>25445000
                    ITEMVAL(K):=B'GLOBAL'AREA(PREVIOUS'FILE+K) <<01881>>25450000
                    UNTIL (K:=K+1) >= 35;                      <<01881>>25455000
                    END;                                       <<01881>>25460000
                 END;                                          <<01881>>25462000
              END;                                                      25465000
       <<09>> BEGIN        << RETURN A INTEGER >>                       25470000
                K := 0;                                                 25475000
                DO                                                      25480000
                  ITEMVAL(K) := B'GLOBAL'AREA(P'TYPE*2+K)               25485000
                UNTIL (K:=K+1) >= 2;                                    25490000
              END;                                                      25495000
       <<10>> BEGIN        << RETURN A LOGICAL >>                       25500000
                IF L'GLOBAL'AREA(CHANGE) THEN                           25505000
                   BEGIN                                                25510000
                     ITEMVAL := TRUE;                                   25515000
                     ITEMVAL(1) := TRUE;                                25520000
                   END                                                  25525000
                ELSE                                                    25530000
                   BEGIN                                                25535000
                     ITEMVAL := FALSE;                                  25540000
                     ITEMVAL(1) := FALSE;                               25545000
                   END;                                                 25550000
              END;                                                      25555000
                                                                        25560000
       <<11>> BEGIN        << RETURN A LOGICAL >>                       25565000
                IF L'GLOBAL'AREA(AUTO) THEN                             25570000
                   BEGIN                                                25575000
                     ITEMVAL := TRUE;                                   25580000
                     ITEMVAL(1) := TRUE;                                25585000
                   END                                                  25590000
                ELSE                                                    25595000
                  BEGIN                                                 25600000
                     ITEMVAL := FALSE;                                  25605000
                     ITEMVAL(1) := FALSE;                               25610000
                  END;                                                  25615000
              END;                                                      25620000
                                                                        25625000
                                                                        25630000
       <<12>> BEGIN       << RETURN A INTEGER >>                        25635000
              K := 0;                                                   25640000
              DO                                                        25645000
                ITEMVAL(K) := B'GLOBAL'AREA(VSETNO*2+K)                 25650000
              UNTIL (K:=K+1) >= 2;                                      25655000
              END;                                                      25660000
                                                                        25665000
       <<13>> BEGIN          << RETURN A INTEGER >>                     25670000
              ITEMVAL(0) := 0;                                          25675000
              IF L'GLOBAL'AREA(MSG) = STOP THEN                         25680000
                 ITEMVAL(1) := 3                                        25685000
               ELSE                                                     25690000
                IF L'GLOBAL'AREA(SWITCH') THEN                          25695000
                   ITEMVAL(1) := 2                                      25700000
                ELSE                                                    25705000
                  IF L'GLOBAL'AREA(STATE) = ACT THEN                    25710000
                     ITEMVAL(1) := 1                                    25715000
                  ELSE                                                  25720000
                    IF L'GLOBAL'AREA(STATE) = INACT THEN                25725000
                       ITEMVAL(1) := 0;                                 25730000
              END;                                                      25735000
       END;  << CASE >>                                                 25740000
END;     << END OF SUBROUTINE >>                                        25745000
                                                                        25750000
                                                                        25755000
   ERRORON;                                                             25760000
                                                                        25765000
   PARMS1 := [12/0,2/3,2/0];                                            25770000
   PARMS2 := [2/3,2/0,2/3,2/0,2/3,2/0,2/2,2/1];                         25775000
   BOUNDS := CHEK'NOABORT(INTRINEXIT,FLAG,PARMS,,OPTV'MASK);   <<01878>>25780000
                                                                        25785000
   IF CARRY THEN                                                        25790000
   BEGIN                  <<DB NOT AT STACK>>                           25795000
      BUFDST :=INDEX'(1);                                               25800000
      ENUM := INDEX';                                                   25805000
      STACK := EXCHANGEDB(0);                                           25810000
   END                                                                  25815000
   ELSE                                                                 25820000
   BEGIN                                                                25825000
      BUFDST := INDEX'(1);                                              25830000
      ENUM := INDEX';                                                   25835000
      STACK := 0;                                                       25840000
   END;                                                                 25845000
                                                                        25850000
  << MAKE SURE WE HAVE THE PROPER CAPABILITY >>                         25855000
                                                                        25860000
   IF NOT OKAY'UCAP THEN                                                25865000
   BEGIN                                                                25870000
      EXCHANGEDB(STACK);                                                25875000
      STATUS' := ILLEGALCAP;                                            25880000
      ERROREXIT(INTRINEXIT,0,0);                                        25885000
   END;                                                                 25890000
                                                                        25895000
   << VERIFY THE VALIDITY OF INDEX PARAMETER >>                         25900000
                                                                        25905000
                                                                        25910000
                                                                        25915000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                                   25920000
   BEGIN                <<BAD DST OR BAD ENTRY OFFSET>>                 25925000
      EXCHANGEDB(STACK);                                                25930000
      STATUS' := INDEXERR;                                              25935000
      ERROREXIT(INTRINEXIT,0,0);                                        25940000
   END;                                                                 25945000
                                                                        25950000
   << VERIFY INPUT PARAMETERS,SEE IF BOTH PARAMETERS PRESENT >>         25955000
                                                                        25960000
   ERROR' := FALSE;                                                     25965000
                                                                        25970000
   IF PARMMASK.(8:1) THEN                                               25975000
      IF PARMMASK.(9:1) THEN                                            25980000
         NUMTABLE(0) := ITEMNUM1                                        25985000
      ELSE                                                              25990000
         ERROR' := TRUE                                                 25995000
   ELSE                                                                 26000000
      IF PARMMASK.(9:1) THEN                                            26005000
         ERROR' := TRUE                                                 26010000
      ELSE                                                              26015000
         NUMTABLE(0) := 0;                                              26020000
                                                                        26025000
   IF PARMMASK.(10:1) THEN                                              26030000
      IF PARMMASK.(11:1) THEN                                           26035000
         NUMTABLE(1) := ITEMNUM2                                        26040000
      ELSE                                                              26045000
         ERROR' := TRUE                                                 26050000
   ELSE                                                                 26055000
      IF PARMMASK.(11:1) THEN                                           26060000
         ERROR' := TRUE                                                 26065000
      ELSE                                                              26070000
         NUMTABLE(1) := 0;                                              26075000
                                                                        26080000
   IF PARMMASK.(12:1) THEN                                              26085000
      IF PARMMASK.(13:1) THEN                                           26090000
         NUMTABLE(2) := ITEMNUM3                                        26095000
      ELSE                                                              26100000
         ERROR' := TRUE                                                 26105000
   ELSE                                                                 26110000
      IF PARMMASK.(13:1) THEN                                           26115000
         ERROR' := TRUE                                                 26120000
      ELSE                                                              26125000
         NUMTABLE(2) := 0;                                              26130000
                                                                        26135000
   IF PARMMASK.(14:1) THEN                                              26140000
     IF PARMMASK.(15:1) THEN                                            26145000
        NUMTABLE(3) := ITEMNUM4                                         26150000
     ELSE                                                               26155000
        ERROR' := TRUE                                                  26160000
   ELSE                                                                 26165000
      IF PARMMASK.(15:1) THEN                                           26170000
         ERROR' := TRUE                                                 26175000
      ELSE                                                              26180000
         NUMTABLE(3) := 0;                                              26185000
                                                                        26190000
   IF ERROR' THEN                                                       26195000
      BEGIN                                                             26200000
        EXCHANGEDB(STACK);                                              26205000
        STATUS' := PARAMMISS;                                           26210000
        ERROREXIT(INTRINEXIT,0,0);                                      26215000
      END;                                                              26220000
                                                                        26225000
   << VERIFY INPUT ITEMNUM IN RANGE >>                                  26230000
                                                                        26235000
   I := 0;                                                              26240000
   WHILE I < 4 DO                                                       26245000
      BEGIN                                                             26250000
      IF ( 0 <= NUMTABLE(I) <= MAXITEMNUM ) THEN                        26255000
         I := I + 1                                                     26260000
      ELSE                                                              26265000
        BEGIN                                                           26270000
          EXCHANGEDB(STACK);                                            26275000
          STATUS' := INVLDNUM;                                          26280000
          ERROREXIT(INTRINEXIT,0,0);                                    26285000
        END;                                                            26290000
      END;                                                              26295000
                                                                        26300000
     CRSTATE := SETCRITICAL;                                            26305000
     INDEX := TABINDEX := 0;                                            26310000
     WHO(,,,CNAME,CGROUP,CACCT);                                        26315000
     MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);                    26320000
     IF BENTRY' = "        " THEN                                       26325000
        BEGIN                                                           26330000
          EXCHANGEDB(STACK);                                            26335000
          RESETCRITICAL(CRSTATE);                                       26340000
          STATUS' := INDEXERR;                                          26345000
          ERROREXIT(INTRINEXIT,0,0);                                    26350000
        END;                                                            26355000
     IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <>                  26360000
        CACCT,(8) OR BENTRY'(GROUP) <> CGROUP,(8) OR                    26365000
        ENTRY'(UPIN) <> MYPIN  THEN                                     26370000
        BEGIN                                                           26375000
          EXCHANGEDB(STACK);                                            26380000
          RESETCRITICAL(CRSTATE);                                       26385000
          STATUS' := SECVIOL;                                           26390000
          ERROREXIT(INTRINEXIT,0,0);                                    26395000
        END;                                                            26400000
                                                                        26405000
<<COPY LOGBUFF TO I'GLOBAL'AREA>>                              <<01878>>26410000
   EXCHANGEDB(BUFDST);                                         <<01878>>26415000
   OBTAIN(LOGBUFF(RESOURCE1),NULL);                            <<01884>>26420000
   OBTAIN(LOGBUFF(RESOURCE2),NULL);                            <<01884>>26421000
   OBTAIN(LOGBUFF(RESOURCE3),NULL);                            <<01884>>26422000
$IF X1=ON                                                      <<01883>>26425000
       WHAT'S'UP ( BC'OBTAIN,3 );                              <<01883>>26435000
$IF                                                            <<01883>>26440000
   EXCHANGEDB(STACK);                                          <<01878>>26445000
   MOVE'FROM'DSEG(@I'GLOBAL'AREA,BUFDST,@ILOGBUFF,BENTRYBASE); <<01878>>26450000
   EXCHANGEDB(BUFDST);                                         <<01878>>26455000
   RELEASE(LOGBUFF(RESOURCE3),NULL,1);                         <<01884>>26460000
   RELEASE(LOGBUFF(RESOURCE2),NULL,1);                         <<01884>>26461000
   RELEASE(LOGBUFF(RESOURCE1),NULL,1);                         <<01884>>26462000
$IF X1=ON                                                      <<01883>>26465000
       WHAT'S'UP ( BC'RELEASE,1 );                             <<01883>>26475000
$IF                                                            <<01883>>26480000
   EXCHANGEDB(STACK);                                          <<01878>>26485000
   RESETCRITICAL(CRSTATE);                                              26490000
                                                                        26495000
   IF NUMTABLE(0) <> 0 THEN                                             26500000
      IF NOT GET'ITEMVAL(NUMTABLE(0),ITEMVAL1) THEN                     26505000
         ERROREXIT(INTRINEXIT,0,0);                                     26510000
                                                                        26515000
   IF NUMTABLE(1) <> 0 THEN                                             26520000
      IF NOT GET'ITEMVAL(NUMTABLE(1),ITEMVAL2) THEN                     26525000
         ERROREXIT(INTRINEXIT,0,0);                                     26530000
                                                                        26535000
   IF NUMTABLE(2) <> 0 THEN                                             26540000
      IF NOT GET'ITEMVAL(NUMTABLE(2),ITEMVAL3) THEN                     26545000
         ERROREXIT(INTRINEXIT,0,0);                                     26550000
                                                                        26555000
                                                                        26560000
   IF NUMTABLE(3) <> 0 THEN                                             26565000
       IF NOT GET'ITEMVAL(NUMTABLE(3),ITEMVAL4) THEN                    26570000
          ERROREXIT(INTRINEXIT,0,0);                                    26575000
   STATUS' := 0;      << ALL OK >>                                      26580000
   ERROREXIT (INTRINEXIT,0,0);                                          26585000
END;   << PROCEDURE >>                                                  26590000
                                                                        26595000
                                                                        26600000
$CONTROL SEGMENT=MAIN                                                   26605000
END.                                                                    26610000
