$CONTROL USLINIT,CODE,MAP,PRIVILEGED                                    00010000
<< LOGSEG1 - MODULE 91 >>                                               00012000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL ADR                                                   <<04162>>00028000
$CONTROL SEGMENT=LOGSEG1,MAIN=LOGSEG1                                   00030000
BEGIN                                                                   00032000
                                                                        00034000
<< Correct bad parsing - Store fully qual. filename correctly.><<03573>>00036000
<<Add error checking of DST# and offset for intrinsics.     >> <<03574>>00038000
<< Adds comments and makes use of equated values. >>           <<03575>>00040000
<< Resolves LISTLOG printing 20 lines of garbage.           >> <<03576>>00042000
<< Enhancement - Logging to labeled serial disc, LINUS  >>     <<03577>>00044000
<< SHOWLOGSTATUS check status of log process in all cases.   >><<04166>>00046000
<< Check for new process status INITIALIZING.               >> <<04164>>00048000
<< Remove any declarations of unused items. General clean up.>><<04162>>00050000
<< Problem with Log Process calling FLUSH and losing STOPS.  >><<04821>>00052000
<< Make use of include file for table definitions, etc.      >><<04889>>00054000
<< All intrinsics now check user capability mask for LG or OP>><<04890>>00056000
<< Remove all dependencies to the DST table.                 >><<04891>>00058000
<< Print out File System errors and U.L. errors.             >><<04892>>00060000
DEFINE                                                         <<04889>>00064000
  CC  =  STATUS'.(6:2)#;                                       <<04889>>00066000
                                                               <<04889>>00068000
$INCLUDE INCLLOG                                               <<04889>>00070000
$PAGE  "EXTERNAL PROCEDURES"                                   <<04162>>00092000
LOGICAL PROCEDURE PARSELOGID(PARMSP,PARMPTR,LEN,ERR);          <<04162>>00094000
   VALUE LEN;                                                  <<03573>>00096000
   BYTE ARRAY PARMSP;                                          <<03573>>00098000
   BYTE POINTER PARMPTR;                                       <<04162>>00100000
   INTEGER LEN,ERR;                                            <<03573>>00102000
   OPTION FORWARD,INTERNAL;                                    <<03573>>00104000
                                                               <<03573>>00106000
                                                               <<03573>>00108000
                                                               <<03573>>00110000
LOGICAL PROCEDURE PARSELOG(PARMPTR,DELIMPTR,ENTRY',LOGF,ERR);  <<03573>>00112000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>00114000
   ARRAY ENTRY';                                               <<03573>>00116000
   LOGICAL LOGF;                                               <<03573>>00118000
   INTEGER ERR;                                                <<03573>>00120000
   OPTION FORWARD,INTERNAL;                                    <<03573>>00122000
                                                               <<03573>>00124000
                                                               <<03573>>00126000
                                                               <<03573>>00128000
LOGICAL PROCEDURE PARSEPASS(PARMPTR,DELIMPTR,BENTRY',PASSF,    <<03573>>00130000
                            ERR);                              <<03573>>00132000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>00134000
   BYTE ARRAY BENTRY';                                         <<03573>>00136000
   LOGICAL PASSF;                                              <<03573>>00138000
   INTEGER ERR;                                                <<03573>>00140000
   OPTION FORWARD,INTERNAL;                                    <<03573>>00142000
                                                               <<03573>>00144000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<03573>>00146000
   VALUE PDEF;                                                 <<03573>>00148000
   DOUBLE PDEF;                                                <<03573>>00150000
   LOGICAL GPTR,APTR,ERRPTR;                                   <<03573>>00152000
   OPTION EXTERNAL;                                            <<03573>>00154000
                                                               <<03573>>00156000
                                                               <<03573>>00158000
                                                               <<03573>>00160000
                                                               <<03574>>00162000
                                                               <<03574>>00164000
                                                               <<03574>>00166000
INTEGER PROCEDURE IOSTAT(STAT);                                <<04892>>00172000
   VALUE STAT;                                                 <<04892>>00174000
   INTEGER STAT;                                               <<04892>>00176000
   OPTION EXTERNAL;                                            <<04892>>00178000
                                                               <<04892>>00180000
                                                               <<04892>>00182000
                                                               <<04892>>00184000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,   <<04892>>00186000
        PARM4,PARM5,DEST,REPLY,OFFSET,DST',CONTROL);           <<04892>>00188000
   VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,DEST,  <<04892>>00190000
         REPLY,OFFSET,DST',CONTROL;                            <<04892>>00192000
   INTEGER SETNO,MSGNO,DEST,DST';                              <<04892>>00194000
   LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,    <<04892>>00196000
           CONTROL;                                            <<04892>>00198000
   OPTION VARIABLE,EXTERNAL;                                   <<04892>>00200000
                                                               <<04892>>00202000
                                                               <<04892>>00204000
                                                               <<04892>>00206000
                                                                        00208000
PROCEDURE WRITEDSEG(EN);                                                00210000
VALUE EN;                                                               00212000
INTEGER EN;                                                             00214000
OPTION EXTERNAL;                                                        00216000
                                                                        00218000
DOUBLE PROCEDURE CHEK(INTRINEXIT,FLAGS,PARMS,CAPMASK,OPTVMSK);          00220000
VALUE INTRINEXIT,FLAGS,PARMS,CAPMASK,OPTVMSK;                           00222000
DOUBLE PARMS,CAPMASK;                                                   00224000
LOGICAL INTRINEXIT,FLAGS,OPTVMSK;                                       00226000
OPTION VARIABLE,UNCALLABLE,EXTERNAL;                                    00228000
                                                                        00230000
                                                                        00232000
                                                                        00236000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     00238000
VALUE DSTX;                                                             00240000
LOGICAL DSTX;                                                           00242000
OPTION EXTERNAL;                                                        00244000
                                                                        00246000
PROCEDURE MOVE'FROM'DSEG(TARGET,SEGMENT,OFFSET,COUNT);         <<03574>>00248000
   VALUE TARGET,SEGMENT,OFFSET,COUNT;                          <<03574>>00250000
   INTEGER TARGET,SEGMENT,OFFSET,COUNT;                        <<03574>>00252000
   OPTION FORWARD,INTERNAL;                                    <<03574>>00254000
                                                               <<03574>>00256000
                                                               <<03574>>00258000
                                                               <<03574>>00260000
PROCEDURE MOVE'TO'DSEG(SEGMENT,OFFSET,SOURCE,COUNT);           <<03574>>00262000
   VALUE SEGMENT,OFFSET,SOURCE,COUNT;                          <<03574>>00264000
   INTEGER SEGMENT,OFFSET,SOURCE,COUNT;                        <<03574>>00266000
   OPTION FORWARD,INTERNAL;                                    <<03574>>00268000
                                                               <<03574>>00270000
                                                               <<03574>>00272000
                                                               <<03574>>00274000
LOGICAL PROCEDURE CHEKINDEX(BUFDST,ENUM);                      <<04891>>00276000
   VALUE ENUM;                                                 <<04891>>00278000
   INTEGER BUFDST,ENUM;                                        <<03574>>00280000
   OPTION FORWARD,PRIVILEGED,INTERNAL;                         <<03574>>00282000
                                                               <<03574>>00284000
                                                               <<03574>>00286000
                                                               <<03574>>00288000
                                                                        00292000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         00294000
VALUE PCBPT,N,WAITF;                                                    00296000
INTEGER PCBPT,N,WAITF;                                                  00298000
OPTION PRIVILEGED UNCALLABLE,EXTERNAL;                                  00300000
                                                                        00302000
PROCEDURE WAIT(WAITC,JPCOUNTX);                                         00304000
VALUE WAITC,JPCOUNTX;                                                   00306000
INTEGER WAITC,JPCOUNTX;                                                 00308000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  00310000
                                                                        00312000
LOGICAL PROCEDURE GETSIR(SIRN);                                         00314000
VALUE SIRN;                                                             00316000
INTEGER SIRN;                                                           00318000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  00320000
                                                                        00322000
PROCEDURE RELSIR(SIRN,A);                                               00324000
VALUE SIRN,A;                                                           00326000
INTEGER SIRN;                                                           00328000
LOGICAL A;                                                              00330000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                                  00332000
                                                                        00334000
DOUBLE PROCEDURE ATTACHIO(LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);   00336000
VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                        00338000
INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                      00340000
OPTION EXTERNAL;                                                        00342000
                                                                        00344000
INTRINSIC WHO,CLOCK,CALENDAR,ASCII,DASCII,SEARCH,PRINT;        <<04162>>00348000
                                                                        00350000
                                                                        00354000
LOGICAL PROCEDURE FINDLOG(LOGNAME,INDEX);                               00356000
INTEGER INDEX;                                                          00358000
BYTE ARRAY LOGNAME;                                                     00360000
OPTION EXTERNAL;                                                        00362000
                                                                        00364000
LOGICAL PROCEDURE GENTRY(INDEX,TYPE);                                   00366000
VALUE TYPE;                                                             00368000
INTEGER INDEX,TYPE;                                                     00370000
OPTION EXTERNAL;                                                        00372000
                                                                        00374000
LOGICAL PROCEDURE RELENTRY(INDEX,TYPE);                                 00376000
VALUE INDEX,TYPE;                                                       00378000
INTEGER INDEX,TYPE;                                                     00380000
OPTION EXTERNAL;                                                        00382000
                                                                        00384000
PROCEDURE ERRORON;                                                      00386000
OPTION EXTERNAL;                                                        00388000
                                                                        00390000
PROCEDURE ERROREXIT(INTRINEXIT,ERRWORD,PARAM);                          00392000
VALUE INTRINEXIT,ERRWORD,PARAM;                                         00394000
LOGICAL INTRINEXIT,ERRWORD,PARAM;                                       00396000
OPTION EXTERNAL;                                                        00398000
                                                                        00400000
PROCEDURE RELEASE(RES,ALTRES,WAKEUP);                                   00402000
VALUE RES,ALTRES,WAKEUP;                                                00404000
LOGICAL WAKEUP;                                                         00406000
LOGICAL POINTER RES,ALTRES;                                             00408000
OPTION EXTERNAL;                                                        00410000
                                                                        00412000
INTEGER PROCEDURE OBTAIN(RES,ALTRES);                                   00414000
VALUE RES,ALTRES;                                                       00416000
LOGICAL POINTER RES,ALTRES;                                             00418000
OPTION EXTERNAL;                                                        00420000
                                                                        00422000
PROCEDURE FENTRY(LOGID',PASS,FNAME,UNAME,UACCT,TYPE);          <<04162>>00424000
BYTE ARRAY LOGID',PASS,FNAME,UNAME,UACCT;                      <<04162>>00426000
LOGICAL TYPE;                                                           00428000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE,FORWARD;                          00430000
                                                                        00432000
                                                                        00434000
                                                               <<00644>>00436000
LOGICAL PROCEDURE SETCRITICAL;                                 <<00644>>00438000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<00644>>00440000
                                                               <<00644>>00442000
PROCEDURE RESETCRITICAL(CRSTATE);                              <<00644>>00444000
VALUE CRSTATE;                                                 <<00644>>00446000
LOGICAL CRSTATE;                                               <<00644>>00448000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<00644>>00450000
                                                               <<00644>>00452000
                                                                        00456000
                                                                        00458000
PROCEDURE CIERR(ERRNUM,ERRADDR,PARMMASK,PARM);                          00460000
VALUE ERRNUM,PARMMASK,PARM;                                             00462000
INTEGER ERRNUM,PARMMASK,PARM;                                           00464000
BYTE ARRAY ERRADDR;                                                     00466000
OPTION VARIABLE,EXTERNAL;                                               00468000
                                                                        00470000
                                                                        00472000
                                                                        00474000
PROCEDURE QUALIFYFILENAME(OLDNAME,NEWNAME);                             00476000
BYTE ARRAY OLDNAME,NEWNAME;                                             00478000
OPTION EXTERNAL;                                                        00480000
                                                                        00482000
                                                                        00484000
INTEGER PROCEDURE FINDPARM(STRING,PARMPTR,DELIMPTR);                    00486000
BYTE ARRAY STRING;                                                      00488000
BYTE POINTER PARMPTR,DELIMPTR;                                          00490000
OPTION VARIABLE,EXTERNAL;                                               00492000
                                                                        00494000
INTEGER PROCEDURE NEXTPARM(STRING,PARMPTR,DELIMPTR);                    00496000
BYTE ARRAY STRING;                                                      00498000
BYTE POINTER PARMPTR,DELIMPTR;                                          00500000
OPTION VARIABLE,EXTERNAL;                                               00502000
                                                                        00504000
                                                               <<01389>>00506000
                                                               <<01389>>00508000
PROCEDURE FLUSH(INDEX);                                        <<01389>>00510000
VALUE INDEX;                                                   <<01389>>00512000
INTEGER INDEX;                                                 <<01389>>00514000
OPTION FORWARD;                                                <<01389>>00516000
                                                               <<01389>>00518000
$PAGE  "INTRINSIC CAPABILITY CHECKING"                         <<04890>>00520000
LOGICAL PROCEDURE OKAY'UCAP;                                   <<04890>>00522000
OPTION PRIVILEGED,INTERNAL;                                    <<04890>>00524000
                                                               <<04890>>00526000
BEGIN                                                          <<04890>>00528000
                                                               <<04890>>00530000
<< Called from all intrinsics to insure that the user has    >><<04890>>00532000
<< User logging (LG) or System Supervisor (OP) capability.   >><<04890>>00534000
<<                                                           >><<04890>>00536000
<< DB must be at stack!!                                     >><<04890>>00538000
<<                                                           >><<04890>>00540000
<< RETURNS:                                                  >><<04890>>00542000
<<    TRUE - user has proper capability.                     >><<04890>>00544000
<<    FALSE- illegal capability.                             >><<04890>>00546000
<<                                                           >><<04890>>00548000
                                                               <<04890>>00550000
DEFINE                                                         <<04890>>00552000
   PXJITDST    =  PCBX(6).(6:10)#,   << JIT dst # from PCBX  >><<04890>>00554000
   LG          =  (UCAP.(8:1) = 1)#, << User Logging capabil.>><<04890>>00556000
   OP          =  (UCAP.(5:1) = 1)#; << System Supervisor cap>><<04890>>00558000
                                                               <<04890>>00560000
                                                               <<04890>>00562000
EQUATE                                                         <<04890>>00564000
   JITUCAP  = 38;   << Offset into JIT for capability mask   >><<04890>>00566000
                                                               <<04890>>00568000
                                                               <<04890>>00570000
INTEGER POINTER                                                <<04890>>00572000
   PCBX,            << Pointer to PCBX >>                      <<04890>>00574000
   PS0  = S-0;                                                 <<04890>>00576000
                                                               <<04890>>00578000
                                                               <<04890>>00580000
LOGICAL                                                        <<04890>>00582000
   UCAP;            << User's capability mask (from JIT).    >><<04890>>00584000
                                                               <<04890>>00586000
                                                               <<04890>>00588000
                                                               <<04890>>00590000
                                                               <<04890>>00592000
                                                               <<04890>>00594000
PUSH(DL);              << Set up the                         >><<04890>>00596000
TOS := TOS - PS0(-1);  <<     pointer to                     >><<04890>>00598000
@PCBX := TOS;          <<         the PCBX                   >><<04890>>00600000
                                                               <<04890>>00602000
<< Now want to get the user capability mask from the JIT     >><<04890>>00604000
                                                               <<04890>>00606000
MOVE'FROM'DSEG(@UCAP,PXJITDST,JITUCAP,1);                      <<04890>>00608000
                                                               <<04890>>00610000
IF LG OR OP                                                    <<04890>>00612000
  THEN OKAY'UCAP := TRUE                                       <<04890>>00614000
ELSE OKAY'UCAP := FALSE;                                       <<04890>>00616000
                                                               <<04890>>00618000
                                                               <<04890>>00620000
END;        << Okay'ucap >>                                    <<04890>>00622000
                                                               <<04889>>00624000
                                                               <<04889>>00626000
LOGICAL PROCEDURE COMPSTRING(STRING1,STRING2,MAXLEN);          <<04889>>00628000
   VALUE MAXLEN;                                               <<04889>>00630000
   INTEGER MAXLEN;                                             <<04889>>00632000
   BYTE ARRAY STRING1;                                         <<04889>>00634000
   BYTE ARRAY STRING2;                                         <<04889>>00636000
   OPTION FORWARD;                                             <<04889>>00638000
                                                               <<04889>>00640000
$PAGE   "LOGGING INTRINSICS -- OPENLOG"                        <<04162>>00642000
PROCEDURE OPENLOG(INDEX',WLOGID',WPASS,MODE,STAT);                      00646000
DOUBLE INDEX';                                                          00648000
INTEGER MODE,STAT;                                                      00650000
LOGICAL ARRAY WPASS,WLOGID';                                            00652000
OPTION PRIVILEGED;                                                      00654000
                                                               <<03575>>00656000
COMMENT                                                        <<03575>>00658000
  Intrinsic to obtain access to a user logging file.           <<03575>>00660000
                                                               <<03575>>00662000
There must already be an entry in the LOGTAB for this logid    <<03575>>00664000
(i.e. LOG command to activate the process). If it's there, will<<03575>>00666000
try to get an entry in the Logging Buffer. Then sets bit in    <<03575>>00668000
PXFIXED to signify access to a User Logging file. Then output  <<03575>>00670000
an Open log record to the buffer area of the Logging Buffer.   <<03575>>00672000
                                                               <<03575>>00674000
PARAMETERS:                                                    <<03575>>00676000
 INDEX' - Returned to user. First word contains the entry      <<04891>>00678000
         offset into the LOGBUFF. Second word contains the     <<04891>>00680000
         offset to the LOGTAB entry for the given logid.       <<04891>>00682000
 WLOGID' - User supplied. Contains user logging identification.<<03575>>00684000
         (Up to 8 characters long).                            <<03575>>00686000
 WPASS - User supplied. Contains password associated with the  <<03575>>00688000
         logging identifier.  (Up to 8 characters long).       <<03575>>00690000
 MODE  - User supplied. Zero for wait. One for no wait.        <<03575>>00692000
 STAT  - Status information returned to the user.              <<03575>>00694000
;                                                              <<03575>>00696000
                                                               <<03575>>00698000
BEGIN                                                                   00700000
   BYTE ARRAY BLOGID'(*) = WLOGID';                            <<04889>>00702000
   BYTE ARRAY BPASS(*) = WPASS;                                <<04889>>00704000
                                                               <<04889>>00706000
   LOGICAL STATREG = Q-1;                                      <<01389>>00708000
   INTEGER S0 = S-0;                                                    00710000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<03575>>00714000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      00716000
   DOUBLE ARRAY DENTRY'(*) = ENTRY';                                    00718000
                                                                        00720000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    00722000
   INTEGER INDEX,TABINDEX;                                              00724000
   LOGICAL A,CRSTATE;                                          <<00644>>00726000
   INTEGER DB;                                                          00728000
   LOGICAL COND;                                                        00732000
   INTEGER LOGTABINDEX;                                        <<04891>>00734000
   INTEGER ENUM;                                                        00738000
   ARRAY WPASS'(0:4) = Q;     << Local copy of password >>     <<04889>>00740000
   BYTE ARRAY PASS'(*) = WPASS';                               <<04889>>00742000
   LOGICAL SPLIT'STACK;                                        <<04889>>00744000
                                                                        00748000
   DEFINE INTRINEXIT = [10/210,6/5]#,                                   00750000
   FLAG  = [1/1,8/0,7/5]#;                                              00752000
                                                                        00754000
   DOUBLE PARMS;                                                        00756000
   LOGICAL PARMS1 = PARMS;                                              00758000
   LOGICAL PARMS2 = PARMS+1;                                            00760000
   LOGICAL POINTER BUF,PXFIXED;                                         00762000
   LOGICAL POINTER S0' = S-0;                                           00764000
   DOUBLE POINTER DBUF;                                                 00766000
   BYTE POINTER BBUF;                                                   00768000
   INTEGER X = X;                                                       00770000
   INTEGER BUFDST;                                                      00774000
   LOGICAL NOWAIT;                                                      00776000
   INTEGER STACK,SCODE';                                                00778000
   LOGICAL ARRAY TLOGID(0:4) = Q;   << Local copy of logid >>  <<04889>>00780000
   BYTE ARRAY BTLOGID(*) = TLOGID;                             <<01389>>00782000
   LOGICAL ARRAY TPASS(0:4) = Q;    << Password from LIDTAB >> <<04889>>00784000
   BYTE ARRAY BTPASS(*) = TPASS;                               <<04889>>00786000
                                                                        00788000
                                                                        00792000
                                                                        00794000
                                                                        00796000
                                                                        00798000
SUBROUTINE CHECKMESSAGE;                                                00800000
BEGIN                                                                   00802000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<04889>>00804000
   BEGIN                                                                00806000
      TOS:=LOGBUFF(LOGMSG);                                    <<04889>>00808000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>00810000
      IF STACK <> 0 THEN DB:=EXCHANGEDB(STACK) ELSE                     00812000
      DB:=EXCHANGEDB(DB);                                               00814000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                00816000
      RESETCRITICAL(CRSTATE);                                  <<00644>>00818000
      ERROREXIT(INTRINEXIT,0,0);                                        00820000
   END;                                                                 00822000
END;                                                                    00824000
                                                                        00826000
                                                               <<03575>>00828000
                                                               <<03575>>00830000
   ERRORON;                                                             00832000
                                                               <<     >>00834000
   IF (MODE <> 0) AND (MODE <> 1) THEN                                  00836000
   BEGIN                                                                00838000
      STAT:=MODEERR;                                                    00840000
      ERROREXIT(INTRINEXIT,0,0);                                        00842000
   END;                                                                 00844000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    00846000
   PARMS1:=0; PARMS2:=[6/0,2/2,2/2,2/2,2/2,2/2];                        00848000
   SCODE':=INDEX1;                                                      00850000
   TOS := CHEK(INTRINEXIT,FLAG,PARMS);                         <<04889>>00852000
   IF CARRY                                                    <<04889>>00856000
     THEN SPLIT'STACK := TRUE                                  <<04889>>00858000
   ELSE SPLIT'STACK := FALSE;                                  <<04889>>00860000
                                                               <<04889>>00862000
   IF @WLOGID'+3 > S0  OR  @WPASS+3 > S0 THEN                  <<04889>>00864000
   BEGIN                                                       <<04889>>00866000
      STAT := BOUNDSERR;                                       <<04889>>00868000
      ERROREXIT(INTRINEXIT,0,0);                               <<04889>>00870000
   END;                                                        <<04889>>00872000
                                                               <<04889>>00874000
   << Now get a local copy of the logid and password. Use  >>  <<04889>>00876000
   << the WHILE loop in case we're in split stack mode.    >>  <<04889>>00878000
                                                               <<04889>>00880000
   X := 0;                                                     <<04889>>00882000
   DO  BTLOGID(X) := " "  UNTIL (X := X+1) > = 8;              <<04889>>00884000
                                                               <<04889>>00886000
   X := 0;                                                     <<04889>>00888000
   DO PASS'(X) := " " UNTIL (X := X+1) >= 8;                   <<04889>>00890000
                                                               <<04889>>00892000
   X := 0;                                                     <<04889>>00894000
   WHILE (BLOGID'(X) = ALPHA  OR  BLOGID'(X) = NUMERIC)        <<04889>>00896000
         AND  X <= 8  DO                                       <<04889>>00898000
   BEGIN                                                       <<04889>>00900000
      BTLOGID(X) := BLOGID'(X);                                <<04889>>00902000
      X := X + 1;                                              <<04889>>00904000
   END;                                                        <<04889>>00906000
                                                               <<04889>>00908000
   IF X <= 0 THEN                                              <<04889>>00910000
   BEGIN                                                       <<04889>>00912000
      STAT := INVALIDLOGID;                                    <<04889>>00914000
      ERROREXIT(INTRINEXIT,0,0);                               <<04889>>00916000
   END;                                                        <<04889>>00918000
                                                               <<04889>>00920000
   X := 0;                                                     <<04889>>00922000
   WHILE (BPASS(X) = ALPHA  OR  BPASS(X) = NUMERIC)            <<04889>>00924000
         AND  X <= 8  DO                                       <<04889>>00926000
   BEGIN                                                       <<04889>>00928000
      PASS'(X) := BPASS(X);                                    <<04889>>00930000
      X := X + 1;                                              <<04889>>00932000
   END;                                                        <<04889>>00934000
                                                               <<04889>>00936000
                                                               <<04889>>00938000
   << Set DB to the stack. >>                                  <<04889>>00940000
                                                               <<04889>>00942000
   IF SPLIT'STACK                                              <<04889>>00944000
     THEN STACK := EXCHANGEDB(0)                               <<04889>>00946000
   ELSE STACK := 0;                                            <<04889>>00948000
                                                               <<04889>>00950000
                                                               <<04890>>00952000
   << Make sure we have the proper capability >>               <<04890>>00954000
                                                               <<04890>>00956000
   IF NOT OKAY'UCAP THEN                                       <<04890>>00958000
   BEGIN                                                       <<04890>>00960000
      EXCHANGEDB(STACK);                                       <<04890>>00962000
      STAT := ILLEGALCAP;                                      <<04890>>00964000
      ERROREXIT(INTRINEXIT,0,0);                               <<04890>>00966000
   END;                                                        <<04890>>00968000
                                                               <<04890>>00970000
   CRSTATE:=SETCRITICAL;                                       <<     >>00972000
   COND:=TRUE;                                                          00974000
                                                               <<04889>>00976000
   << Upshift. Everything in the tables is in upper case. >>   <<04889>>00978000
                                                               <<04889>>00980000
   BTPASS(8) := " ";                                           <<04889>>00982000
   BTLOGID(8) := " ";                                          <<04889>>00984000
   PASS'(8) := " ";                                            <<04889>>00986000
   MOVE BTLOGID := BTLOGID WHILE ANS;                          <<04889>>00988000
   MOVE PASS' := PASS' WHILE ANS;                              <<04889>>00990000
                                                               <<04889>>00992000
   A := GETSIR(LOGSIR);                                        <<02058>>00994000
                                                               <<03575>>01006000
<< See if it's in the LIDTAB. Also get the password for  >>    <<04889>>01008000
<< the password check.                                   >>    <<04889>>01010000
                                                               <<03575>>01012000
      FENTRY(BTLOGID,BTPASS);                                  <<04889>>01014000
      IF > THEN                                                         01016000
      BEGIN                                                             01018000
         EXCHANGEDB(STACK);                                    <<04889>>01020000
         RELSIR(LOGSIR,A);                                     <<02058>>01022000
         INDEX' := 0D;                                         <<04889>>01024000
         STAT:=INVALIDLOGID;                                            01026000
         RESETCRITICAL(CRSTATE);                               <<00644>>01028000
         ERROREXIT(INTRINEXIT,0,0);                                     01030000
      END;                                                     <<04889>>01032000
      << Make sure the password found in the LIDTAB matches >> <<04889>>01036000
      << that passed in by the user.                        >> <<04889>>01038000
                                                               <<04889>>01040000
      IF NOT COMPSTRING(BTPASS,PASS',8) THEN                   <<04889>>01042000
      BEGIN                                                    <<04889>>01044000
         EXCHANGEDB(STACK);                                    <<04889>>01046000
         RELSIR(LOGSIR,A);                                     <<04889>>01048000
         STAT := PASSERR;                                      <<04889>>01050000
         INDEX' := 0D;                                         <<04889>>01052000
         RESETCRITICAL(CRSTATE);                               <<04889>>01054000
         ERROREXIT(INTRINEXIT,0,0);                            <<04889>>01056000
      END;                                                     <<04889>>01058000
                                                               <<04889>>01062000
<< See if there's an entry in the LOGTAB - an active process.>><<04889>>01064000
                                                               <<04889>>01066000
   IF FINDLOG(BTLOGID,TABINDEX) THEN                           <<04889>>01068000
   BEGIN                                                       <<04889>>01070000
      LOGTABINDEX := TABINDEX;                                 <<04891>>01072000
                                                               <<04889>>01074000
      << Get the entry >>                                      <<04889>>01076000
                                                               <<04889>>01078000
      MOVE'FROM'DSEG(@ENTRY',LOGDST,TABINDEX,TENTRYSIZE);      <<04889>>01080000
      IF BENTRY' = "        " THEN                             <<04889>>01082000
      BEGIN                                                    <<04889>>01084000
         RELSIR(LOGSIR,A);                                     <<04889>>01086000
         EXCHANGEDB(STACK);                                    <<04889>>01088000
         STAT := NOLOGPROC;                                    <<04889>>01090000
         INDEX' := 0D;                                         <<04889>>01092000
         RESETCRITICAL(CRSTATE);                               <<04889>>01094000
         ERROREXIT(INTRINEXIT,0,0);                            <<04889>>01096000
      END;                                                     <<04889>>01098000
      TABINDEX := 0;                                           <<04889>>01102000
      IF ENTRY'(STATUS) = RECOVERING OR                        <<04889>>01104000
         ENTRY'(STATUS) = INITIALIZING   THEN                  <<04889>>01106000
      BEGIN                                                    <<04889>>01108000
         RELSIR(LOGSIR,A);                                     <<04889>>01110000
         EXCHANGEDB(STACK);                                    <<04889>>01112000
         STAT := NOLOGPROC;                                    <<04889>>01114000
         INDEX' := 0D;                                         <<04889>>01116000
         RESETCRITICAL(CRSTATE);                               <<04889>>01118000
         ERROREXIT(INTRINEXIT,0,0);                            <<04889>>01120000
      END;                                                     <<04889>>01122000
                                                               <<04889>>01126000
      << Found in LOGTAB >>                                    <<04889>>01128000
   END                                                         <<04889>>01130000
   ELSE                                                        <<04889>>01132000
   BEGIN                                                       <<04889>>01134000
      << Entry not in LOGTAB >>                                <<04889>>01136000
                                                               <<04889>>01138000
      RELSIR(LOGSIR,A);                                        <<04889>>01140000
      EXCHANGEDB(STACK);                                       <<04889>>01142000
      STAT := NOLOGPROC;                                       <<04889>>01144000
      INDEX' := 0D;                                            <<04889>>01146000
      RESETCRITICAL(CRSTATE);                                  <<04889>>01148000
      ERROREXIT(INTRINEXIT,0,0);                               <<04889>>01150000
   END;                                                        <<04889>>01152000
                                                               <<04889>>01154000
   <<DB-reg = buffer dst; DB = Db-reg entry cond.>>            <<03575>>01158000
   DB:=EXCHANGEDB(ENTRY'(DST));                                <<00644>>01160000
                                                               <<03575>>01162000
<< Don't allow OPENLOG if the log process is suspended.  >>    <<03575>>01164000
                                                               <<03575>>01166000
      IF LOGBUFF(MSG) = STOP OR LOGBUFF(MSG) = SUSPEND THEN    <<04889>>01168000
      BEGIN                                                    <<     >>01170000
         RELSIR(LOGSIR,A);                                     <<00794>>01172000
         EXCHANGEDB(STACK);                                    <<04889>>01178000
         STAT:=SUSPENDED;                                      <<     >>01182000
         INDEX':=0D;                                           <<     >>01184000
         RESETCRITICAL(CRSTATE);                               <<     >>01186000
         ERROREXIT(INTRINEXIT,0,0);                            <<     >>01188000
      END;                                                     <<     >>01190000
                                                               <<04889>>01192000
   TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                       <<     >>01194000
   DEL;                                                        <<     >>01196000
   <<DB-reg = DB-reg entry cond.; DB = buffer dst # >>         <<03575>>01198000
   DB:=EXCHANGEDB(DB);                                         <<     >>01200000
                                                               <<03575>>01202000
<< Try to get an entry in the Logging Buffer.            >>    <<03575>>01204000
                                                               <<03575>>01206000
   IF NOT GENTRY(INDEX,ENTRY'(DST)) THEN                                01208000
   BEGIN                                                                01210000
      <<NO MORE ENTRIES>>                                               01212000
      <<DB-reg = buffer dst #; DB = DB-reg entry cond. >>      <<03575>>01214000
      DB:=EXCHANGEDB(ENTRY'(DST));                             <<00644>>01216000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>01218000
      EXCHANGEDB(STACK);                                       <<04889>>01220000
      STAT:=NOLOGENTRIES;                                               01224000
      INDEX':=0D;                                                       01226000
      RELSIR(LOGSIR,A);                                        <<00794>>01228000
      RESETCRITICAL(CRSTATE);                                  <<00644>>01230000
      ERROREXIT(INTRINEXIT,0,0);                                        01232000
   END;                                                                 01234000
                                                               <<04889>>01236000
   RELSIR(LOGSIR,A);                                           <<00794>>01238000
                                                               <<03575>>01240000
<< Get ready to set logging bit in PXFIXED.              >>    <<03575>>01242000
                                                               <<03575>>01244000
   PUSH(DL);                                                            01246000
   ASSEMBLE(DUP);                                                       01248000
   TOS:=TOS-2;                                                          01250000
   TOS:=S0';                                                            01252000
   ASSEMBLE(XCH,DEL,SUB);                                               01254000
   @PXFIXED:=TOS;                                                       01256000
   PXFIXED(22).(1:1):=1;                                                01258000
                                                               <<03575>>01260000
<< Initialize the entry.   >>                                  <<03575>>01262000
                                                               <<03575>>01264000
   BUFDST:=ENTRY'(DST);                                                 01266000
   ENTRY' := "  ";                                             <<04889>>01268000
   MOVE ENTRY'(1):=ENTRY',(BENTRYSIZE-1);                               01270000
   ENUM:=INDEX;                                                         01272000
   INDEX:=0;                                                            01274000
   WHO(,,,BENTRY'(USER),BENTRY'(GROUP),BENTRY'(ACCT));                  01278000
   DENTRY'(RECS):=0D;                                                   01280000
   ENTRY'(WSTATE):=ACT;                                                 01282000
   IF STATREG.(0:1) = 1 THEN ENTRY'(SCODE):=SCODE'             <<01389>>01284000
   ELSE ENTRY'(SCODE):=0;                                      <<01389>>01286000
   ENTRY'(UPIN) := MYPIN;                                      <<04162>>01288000
   MOVE'FROM'DSEG(@ENTRY'(LGNUM),BUFDST,USERNO,1);             <<04162>>01290000
   ENTRY'(LGNUM):=ENTRY'(LGNUM)+1;                                      01294000
   MOVE'TO'DSEG(BUFDST,USERNO,@ENTRY'(LGNUM),1);               <<04162>>01296000
   ENTRY'(ERROR):=0;                                                    01300000
                                                                        01302000
   <<NOW WRITE ENTRY TO LOGBUFF>>                                       01304000
                                                                        01306000
   MOVE'TO'DSEG(BUFDST,ENUM,@ENTRY',BENTRYSIZE-2);             <<04162>>01308000
   INDEX:=ENUM;                                                         01312000
                                                                        01314000
                                                                        01316000
   <<NOW PREPARE A LOG OPEN RECORD>>                                    01318000
   <<DB-reg = buffer dst #; DB = DB-reg entry cond. >>         <<03575>>01320000
   DB:=EXCHANGEDB(BUFDST);                                              01322000
   CHECKMESSAGE;                                                        01324000
   IF LOGBUFF(BSPACE) <= 0 AND DLOGBUFF(FSPACE') <             <<04889>>01326000
   DOUBLE(BLKFACTOR) AND NOWAIT THEN                           <<01389>>01328000
   BEGIN                                                                01330000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>01332000
      EXCHANGEDB(0);                                           <<04889>>01334000
      RELENTRY(ENUM,BUFDST);                                            01336000
      EXCHANGEDB(STACK);                                       <<04889>>01338000
      STAT:=NWAITERR;                                                   01340000
      INDEX' := 0D;                                            <<04889>>01342000
      RESETCRITICAL(CRSTATE);                                  <<00644>>01344000
      ERROREXIT(INTRINEXIT,0,0);                                        01346000
   END;                                                                 01348000
                                                               <<04889>>01350000
   FORIT:                                                      <<01389>>01352000
                                                               <<04889>>01354000
   IF LOGBUFF(LOGTYPE) = DISC THEN                             <<01389>>01356000
   BEGIN                                                                01358000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<04889>>01360000
      BEGIN                                                    <<01389>>01364000
         FLUSH(ENUM);                                          <<01389>>01366000
         CHECKMESSAGE;                                         <<01389>>01368000
      END;                                                     <<01389>>01370000
   END;                                                                 01372000
                                                               <<01389>>01374000
   IF LOGBUFF(BSPACE) >= 1 THEN                                         01376000
   BEGIN                                                                01378000
      @BUF:=BUFBASE+(LOGBUFF(BUFUSED))*RECSIZE;                <<04821>>01380000
      @BBUF:=2*@BUF;                                                    01382000
      @DBUF:=@BUF;                                                      01384000
      INDEX:=ENUM;                                                      01386000
      MOVE BBUF(LID'):=BLOGBUFF(LOGID),(8);                    <<04889>>01388000
      DBUF(RNUM):=DLOGBUFF(TRECS):=DLOGBUFF(TRECS)+1D;                  01390000
      BUF(CODE):=OPEN;                                                  01392000
      BUF(CODE).(0:8):=LOGBUFF(SCODE).(0:8);                            01394000
                                                                        01396000
      DBUF(TIME):=CLOCK;                                                01398000
      BUF(DATE):=CALENDAR;                                              01400000
      BUF(LNUM):=LOGBUFF(LGNUM);                                        01402000
      MOVE BBUF(CREATOR):=BLOGBUFF(USER),(24);                          01404000
       BUF(LPIN) := MYPIN;                                     <<04162>>01406000
      X:=RECSIZEM1;                                            <<03575>>01408000
      TOS:=-1;                                                          01410000
      DO                                                                01412000
      BEGIN                                                             01414000
         IF X <> CKSUM THEN                                             01416000
         TOS:=TOS XOR BUF(X);                                           01418000
      END UNTIL (X:=X-1) < 0;                                           01420000
      BUF(CKSUM):=TOS;                                                  01422000
      LOGBUFF(BSPACE):=LOGBUFF(BSPACE)-1;                               01424000
      LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                <<04821>>01426000
   END                                                                  01428000
   ELSE                                                                 01430000
   BEGIN                                                                01432000
      FLUSH(ENUM);                                             <<01389>>01434000
      CHECKMESSAGE;                                            <<01389>>01436000
      GO FORIT;                                                         01438000
   END;                                                                 01440000
   RELEASE(DLOGBUFF(RESOURCE),NULL,1);                         <<00644>>01442000
   EXCHANGEDB(STACK);                                          <<04889>>01444000
   STAT:=0;                                                             01446000
   INDEX1(1) := LOGTABINDEX;                                   <<04891>>01448000
   INDEX1:=ENUM;                                                        01450000
   RESETCRITICAL(CRSTATE);                                     <<00644>>01452000
   ERROREXIT(INTRINEXIT,0,0);                                           01454000
END;                                                                    01456000
                                                                        01458000
$PAGE   "LOGGING INTRINSICS  --  WRITELOG"                              01460000
                                                                        01462000
PROCEDURE WRITELOG(INDEX',DATA,LEN,MODE,STAT);                 <<04889>>01464000
DOUBLE INDEX';                                                          01466000
INTEGER MODE,LEN,STAT;                                         <<04889>>01468000
LOGICAL ARRAY DATA;                                                     01470000
OPTION PRIVILEGED;                                                      01472000
                                                                        01474000
COMMENT                                                        <<03575>>01476000
 Intrinsic to write physical records to the logging file.      <<03575>>01478000
                                                               <<03575>>01480000
Will try to output the record(s) to the buffer area of the     <<03575>>01482000
Logging Buffer. If the buffer area is full, will flush it to   <<03575>>01484000
the disc logging file or to the disc buffer file (via call to  <<03575>>01486000
FLUSH).                                                        <<03575>>01488000
                                                               <<03575>>01490000
BEGINLOG,ENDLOG - will do as above but will force the new      <<03575>>01492000
records (and the buffer area) to be flushed to disc.           <<03575>>01494000
PARAMETERS:                                                    <<03575>>01496000
                                                               <<03575>>01498000
 INDEX' - Originally from OPENLOG, identifies user's access    <<03575>>01500000
          to logging file.                                     <<03575>>01502000
 DATA   - Array supplied by user, containing the information   <<03575>>01504000
         to be logged.                                         <<03575>>01506000
 LEN'   - Length of array DATA. Positive count = # words,      <<03575>>01508000
         negative count = # bytes. (If > 119 words, info will  <<03575>>01510000
         be divided into more than one physical record).       <<03575>>01512000
 MODE   - Wait = 0, No wait = 1, Write and flush = 2.          <<04162>>01514000
 STAT   - Status info returned to user.                        <<03575>>01516000
;                                                              <<03575>>01518000
                                                               <<03575>>01520000
BEGIN                                                                   01522000
   ENTRY BEGINLOG,ENDLOG;                                      <<01389>>01524000
                                                               <<03575>>01528000
                                                               <<03574>>01530000
   INTEGER LENGTH;                                             <<03574>>01532000
   INTEGER S0 = S-0;                                                    01534000
   INTEGER INDEX;                                              <<04162>>01538000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    01540000
   INTEGER X = X;                                                       01542000
   INTEGER QLEN,RECSOUT,TRECSOUT;                                       01544000
   INTEGER RLEN;   <<RECORD LENGTH>>                           <<01389>>01546000
   INTEGER DB;                                                          01548000
   INTEGER ENUM;                                               <<00644>>01550000
   LOGICAL NOWAIT,CRSTATE;                                     <<00644>>01556000
   LOGICAL POINTER BUF;                                                 01558000
   DOUBLE POINTER DBUF;                                                 01560000
   BYTE POINTER BBUF;                                                   01562000
                                                                        01564000
   INTEGER STACK;                                              <<04889>>01566000
   INTEGER BUFDST;                                                      01568000
   DOUBLE PARMS;                                                        01570000
   LOGICAL PARMS1 = PARMS;                                              01572000
   LOGICAL PARMS2 = PARMS + 1;                                          01574000
   LOGICAL BEGIN'TRAN,END'TRAN;                                <<01389>>01576000
   LOGICAL FLUSH'FLAG;                                         <<01433>>01578000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<03575>>01584000
   BYTE ARRAY BENTRY'(*) = ENTRY';                             <<00644>>01586000
   BYTE ARRAY CNAME(0:8) = Q;                                  <<00644>>01590000
   BYTE ARRAY CGROUP(0:8) = Q;                                 <<00644>>01592000
   BYTE ARRAY CACCT(0:8) = Q;                                  <<00644>>01594000
                                                                        01600000
   DEFINE INTRINEXIT = [10/211,6/5]#,                                   01602000
   FLAG  = [1/1,8/0,7/5]#;                                              01604000
                                                                        01606000
                                                                        01610000
                                                                        01612000
                                                                        01614000
SUBROUTINE CHECKMESSAGE;                                                01616000
BEGIN                                                                   01618000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<04889>>01620000
   BEGIN                                                                01622000
      TOS:=LOGBUFF(LOGMSG);                                    <<04889>>01624000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>01626000
      <<DB-reg = DB-reg entry cond.; DB = buffer dst #>>       <<03575>>01628000
      EXCHANGEDB(STACK);                                       <<04889>>01630000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                01632000
      RESETCRITICAL(CRSTATE);                                  <<00644>>01634000
      ERROREXIT(INTRINEXIT,0,0);                                        01636000
   END;                                                                 01638000
END;                                                                    01640000
                                                                        01642000
SUBROUTINE OUTPUTRECORD;                                       <<03575>>01644000
                                                               <<03575>>01646000
<< Outputs a Log Record to the buffer area of the Logging  >>  <<03575>>01648000
<< buffer.                                                 >>  <<03575>>01650000
<<  ENTRY:   DB at Logging Buffer.                         >>  <<03575>>01652000
<<  EXIT :   DB at stack.                                  >>  <<03575>>01654000
                                                               <<03575>>01656000
                                                               <<03575>>01658000
BEGIN                                                          <<03575>>01660000
   @BUF := BUFBASE + LOGBUFF(BUFUSED)*RECSIZE;                 <<04821>>01662000
   @DBUF := @BUF;                                              <<03575>>01664000
   @BBUF := 2 * @BUF;                                          <<03575>>01666000
   DBUF(RNUM) := DLOGBUFF(TRECS) := DLOGBUFF(TRECS) + 1D;      <<03575>>01668000
                                                               <<03575>>01670000
   IF RECSOUT > 0 THEN BUF(CODE) := CONT   <<Continuation rec>><<03575>>01672000
     ELSE                                                      <<03575>>01674000
       IF BEGIN'TRAN THEN BUF(CODE) := TRAN'BEGIN              <<03575>>01676000
         ELSE                                                  <<03575>>01678000
           IF END'TRAN THEN BUF(CODE) := TRAN'END              <<03575>>01680000
             ELSE BUF(CODE) := USER'SUB;                       <<03575>>01682000
   BUF(CODE).(0:8) := LOGBUFF(SCODE).(0:8);                    <<03575>>01684000
   BUF(DATE) := CALENDAR;                                      <<03575>>01686000
   DBUF(TIME) := CLOCK;                                        <<03575>>01688000
   BUF(LNUM) := LOGBUFF(LGNUM);                                <<03575>>01690000
   BUF(LEN') := RLEN;                                          <<04889>>01692000
   << DB-reg at stack; DB=Logbuffer dst # >>                   <<03575>>01694000
   DB := EXCHANGEDB(DB);                                       <<03575>>01696000
                                                               <<03575>>01698000
   << Move data into buffer >>                                 <<03575>>01700000
   IF QLEN - RECSOUT * DATAREA > DATAREA                       <<03575>>01702000
       THEN LENGTH := DATAREA                                  <<03575>>01704000
     ELSE LENGTH := QLEN - RECSOUT * DATAREA;                  <<03575>>01706000
                                                               <<03575>>01708000
   MOVE'TO'DSEG(DB,@BUF(UAREA),@DATA+RECSOUT*DATAREA,LENGTH);  <<04889>>01710000
   <<DB-reg = buffer dst #; DB = DB-reg entry cond.>>          <<03575>>01712000
   DB := EXCHANGEDB(DB);                                       <<03575>>01714000
                                                               <<03575>>01716000
   << Compute checksum >>                                      <<03575>>01718000
   X := RECSIZEM1;                                             <<03575>>01720000
   TOS := -1;                                                  <<03575>>01722000
   DO BEGIN                                                    <<03575>>01724000
       IF X <> CKSUM  THEN                                     <<03575>>01726000
         TOS := TOS XOR BUF(X);                                <<03575>>01728000
   END UNTIL (X := X-1) < 0;                                   <<03575>>01730000
   BUF(CKSUM) := TOS;                                          <<03575>>01732000
   LOGBUFF(BSPACE) := LOGBUFF(BSPACE) - 1;                     <<03575>>01734000
   LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                   <<04821>>01736000
   RECSOUT := RECSOUT + 1;                                     <<03575>>01738000
END;               <<Subroutine OUTPUTRECORD>>                 <<03575>>01740000
                                                               <<03575>>01742000
                                                                        01744000
                                                               <<     >>01746000
   BEGIN'TRAN:=END'TRAN:=FALSE;                                <<01389>>01748000
   GO OVER;                                                    <<01389>>01750000
                                                               <<03575>>01752000
BEGINLOG:                                                      <<01389>>01754000
   BEGIN'TRAN:=TRUE;                                           <<01389>>01756000
   END'TRAN := FALSE;                                          <<03575>>01758000
   GO OVER;                                                    <<01389>>01760000
                                                               <<03575>>01762000
ENDLOG:                                                        <<01389>>01764000
   END'TRAN:=TRUE;                                             <<01389>>01766000
   BEGIN'TRAN := FALSE;                                        <<03575>>01768000
                                                               <<03575>>01770000
OVER:                                                          <<01389>>01772000
   ERRORON;                                                             01774000
   IF (MODE <> 0) AND (MODE <> 1) AND (MODE <> 2) THEN         <<01389>>01776000
   BEGIN                                                                01778000
      STAT:=MODEERR;                                                    01780000
                                                               <<01433>>01782000
      ERROREXIT(INTRINEXIT,0,0);                                        01784000
   END;                                                                 01786000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    01788000
   IF MODE = 2 THEN FLUSH'FLAG:=TRUE ELSE FLUSH'FLAG:=FALSE;   <<01433>>01790000
   PARMS1:=0; PARMS2:=[8/2,2/2,2/2,2/2,2/2];                            01792000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                                    01794000
   RLEN:=LEN;                                                 <<<04889>>01796000
   IF LEN < 0 THEN                                             <<04889>>01798000
   <<Convert to a word count.>>                                <<03575>>01800000
   BEGIN                                                       <<     >>01802000
      TOS:=LEN;                                                <<04889>>01804000
      TOS:=2;                                                  <<     >>01806000
      ASSEMBLE(DIV);                                           <<     >>01808000
      IF TOS <> 0 THEN                                         <<     >>01810000
      QLEN:=-(LEN/2)+1                                         <<04889>>01812000
      ELSE QLEN:=-(LEN/2);                                     <<04889>>01814000
      ASSEMBLE(DEL);                                                    01816000
   END                                                         <<     >>01818000
   ELSE QLEN:=LEN;                                            <<<04889>>01820000
   IF @DATA+(QLEN-1) > S0 THEN                                 <<     >>01822000
   BEGIN                                                                01824000
      STAT:=BOUNDSERR;                                                  01826000
                                                               <<     >>01828000
      ERROREXIT(INTRINEXIT,0,0);                                        01830000
   END;                                                                 01832000
                                                               <<03574>>01834000
   BUFDST := INDEX1(1);                                        <<03574>>01836000
   ENUM := INDEX1;                                             <<03574>>01838000
                                                               <<03574>>01840000
   STACK := EXCHANGEDB(0);    << Make sure we're at stack >>   <<04889>>01844000
                                                               <<04890>>01846000
   << Make sure we have the proper capability >>               <<04890>>01848000
                                                               <<04890>>01850000
   IF NOT OKAY'UCAP THEN                                       <<04890>>01852000
   BEGIN                                                       <<04890>>01854000
      EXCHANGEDB(STACK);                                       <<04890>>01856000
      STAT := ILLEGALCAP;                                      <<04890>>01858000
      ERROREXIT(INTRINEXIT,0,0);                               <<04890>>01860000
   END;                                                        <<04890>>01862000
                                                               <<04890>>01864000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<04891>>01866000
      EXCHANGEDB(STACK);   << Back to entry condition >>       <<04889>>01870000
   CRSTATE:=SETCRITICAL;                                       <<     >>01872000
    INDEX := 0;                                                <<03574>>01876000
   WHO(,,,CNAME,CGROUP,CACCT);                                 <<00644>>01878000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<03574>>01880000
   IF BENTRY' = "        "  THEN                               <<04891>>01884000
   BEGIN                                                       <<00644>>01886000
      EXCHANGEDB(STACK);                                       <<04889>>01890000
      RESETCRITICAL(CRSTATE);                                  <<00644>>01892000
      STAT:=INDEXERR;                                          <<00644>>01894000
      ERROREXIT(INTRINEXIT,0,0);                               <<00644>>01896000
   END;                                                        <<00644>>01898000
   IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <> CACCT,(8) <<00644>>01900000
      OR BENTRY'(GROUP) <> CGROUP,(8) OR                       <<04162>>01902000
      ENTRY'(UPIN) <> MYPIN     THEN                           <<04162>>01904000
   BEGIN                                                       <<00644>>01906000
      <<ILLEGAL CALL>>                                         <<00644>>01908000
      EXCHANGEDB(STACK);                                       <<04889>>01912000
      RESETCRITICAL(CRSTATE);                                  <<00644>>01914000
      STAT:=SECVIOL;                                           <<00644>>01916000
      ERROREXIT(INTRINEXIT,0,0);                               <<00644>>01918000
   END;                                                        <<00644>>01920000
   INDEX := ENUM;                                              <<04891>>01926000
   RECSOUT:=0;                                                          01928000
   TRECSOUT:=IF QLEN MOD DATAREA = 0  THEN QLEN/DATAREA        <<03575>>01930000
              ELSE QLEN/DATAREA+1;                             <<03575>>01932000
   <<DB-reg = buffer dst #; DB = DB-reg entry cond.>>          <<03575>>01936000
   DB := EXCHANGEDB(BUFDST);                                   <<04891>>01938000
   CHECKMESSAGE;                                                        01940000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<03577>>01942000
   BEGIN                                                                01944000
      <<CHECK FOR SPACE>>                                               01946000
      TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                             01948000
      DEL;                                                              01950000
                                                                        01952000
      IF ILOGBUFF(BSPACE) < TRECSOUT AND NOWAIT THEN                    01954000
      IF DLOGBUFF(FSPACE') < DOUBLE(TRECSOUT) THEN             <<04889>>01956000
      BEGIN                                                             01958000
         <<NO ROOM IN BUFFER OR DISC>>                                  01960000
         LOGBUFF(ERROR):=-1;                                            01962000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                   <<00644>>01964000
         EXCHANGEDB(STACK);;                                   <<04889>>01968000
         STAT:=NWAITERR;                              <<TEMP>>          01970000
         RESETCRITICAL(CRSTATE);                               <<00644>>01972000
         ERROREXIT(INTRINEXIT,0,0);                                     01974000
      END;                                                              01976000
                                                                        01978000
      DO                                                                01980000
      BEGIN                                                             01982000
         IF LOGBUFF(BSPACE) >= 1 THEN OUTPUTRECORD             <<03575>>01984000
         ELSE                                                           01988000
         BEGIN                               <<WRITE TO DISC>>          01990000
               FLUSH(ENUM);                                    <<01389>>01992000
               CHECKMESSAGE;                                   <<01389>>01994000
         END;                                                           01996000
      END UNTIL RECSOUT >= TRECSOUT;                                    01998000
      IF BEGIN'TRAN OR END'TRAN OR FLUSH'FLAG THEN FLUSH(ENUM);         02000000
      CHECKMESSAGE;                                            <<01389>>02002000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>02004000
      EXCHANGEDB(STACK);                                       <<04889>>02008000
      STAT:=0;                                                          02010000
      <<End tape logging>>                                     <<03575>>02012000
   END                                                                  02014000
   ELSE                                                                 02016000
   BEGIN                                      <<DISC LOGGING>>          02018000
      TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                             02020000
      DEL;                                                              02022000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<04889>>02024000
      BEGIN                                                    <<01389>>02028000
         FLUSH(ENUM);                                          <<01389>>02030000
         CHECKMESSAGE;                                         <<01389>>02032000
      END;                                                     <<01389>>02034000
      DO                                                                02036000
      BEGIN                                                             02038000
         IF LOGBUFF(BSPACE) >= 1 THEN                                   02040000
         BEGIN                                                          02042000
            OUTPUTRECORD;                                      <<03575>>02044000
            IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))   <<04889>>02048000
            THEN                                               <<00937>>02050000
            BEGIN                                              <<00937>>02052000
               FLUSH(ENUM);                                    <<00937>>02054000
               CHECKMESSAGE;                                   <<00937>>02056000
            END;                                               <<00937>>02058000
         END                                                            02060000
         ELSE                                                           02062000
         BEGIN                                                          02064000
            FLUSH(ENUM);                                       <<01389>>02066000
            CHECKMESSAGE;                                      <<01389>>02068000
         END;                                                           02070000
      END UNTIL RECSOUT >= TRECSOUT;                                    02072000
      IF BEGIN'TRAN OR END'TRAN OR FLUSH'FLAG THEN FLUSH(ENUM);<<01433>>02074000
      CHECKMESSAGE;                                            <<01389>>02076000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>02078000
      EXCHANGEDB(STACK);                                       <<04889>>02082000
      STAT:=0;                                                          02084000
   END;                                                                 02086000
   RESETCRITICAL(CRSTATE);                                     <<00644>>02088000
   ERROREXIT(INTRINEXIT,0,0);                                           02090000
END;                                                                    02092000
$PAGE    "LOGGING INTRINSICS  --  LOGSTATUS"                   <<01389>>02094000
PROCEDURE LOGSTATUS(ENTRY'INDEX,STAT'ARRAY,STATUS');           <<01389>>02096000
DOUBLE ENTRY'INDEX;                                            <<01389>>02098000
INTEGER STATUS';                                               <<01389>>02100000
LOGICAL ARRAY STAT'ARRAY;                                      <<01389>>02102000
BEGIN                                                          <<01389>>02104000
                                                               <<03575>>02106000
                                                               <<03575>>02108000
COMMENT                                                        <<03575>>02110000
 Intrinsic to interrogate a logging system for information     <<03575>>02112000
 pertaining to size of the logfile, space remaining in the     <<03575>>02114000
 logfile, and the number of users who have opened the logfile. <<03575>>02116000
 This information is obtained from the communications area of  <<03575>>02118000
 the memory logging buffer and passes it to the user.          <<03575>>02120000
                                                               <<03575>>02122000
PARAMETERS:                                                    <<03575>>02124000
                                                               <<03575>>02126000
 ENTRY'INDEX - Supplied by the user. (Originally obtained from <<03575>>02128000
               intrinsic OPENLOG).                             <<03575>>02130000
 STAT'ARRAY - Formatted array returned to the user containing: <<03575>>02132000
              Word 0,1 : total records written to the log file.<<03575>>02134000
              Word 2,3 : size of logfile.                      <<03575>>02136000
              Word 4,5 : space remaining in the logfile.       <<03575>>02138000
              Word 6   : number of users using the logfile.    <<03575>>02140000
 STATUS'    - Status information returned to the user.         <<03575>>02142000
              (0 = all O.K.)                                   <<03575>>02144000
;                                                              <<03575>>02146000
                                                               <<03575>>02148000
                                                               <<03575>>02150000
                                                               <<03575>>02152000
   DOUBLE ARRAY DSTAT'ARRAY(*) = STAT'ARRAY;                   <<01389>>02154000
   LOGICAL ARRAY INDEX'(*) = ENTRY'INDEX;                      <<01389>>02156000
   INTEGER  STACK;                                             <<03574>>02158000
   LOGICAL BUFDST,ENUM;                                        <<01389>>02160000
   LOGICAL ARRAY ENTRY'(0:BENTRYSIZE-1) = Q;                   <<03575>>02162000
   BYTE ARRAY BENTRY'(*) = ENTRY';                             <<01389>>02166000
   INTEGER DB,CRSTATE;                                         <<01389>>02170000
   INTEGER INDEX,TABINDEX;                                     <<01389>>02172000
   DOUBLE PARMS;                                               <<01389>>02174000
   LOGICAL PARMS1 = PARMS;                                     <<01389>>02176000
   LOGICAL PARMS2 = PARMS + 1;                                 <<01389>>02178000
   DOUBLE QRECS,QFSIZE,QFSPACE;                                <<01389>>02180000
   INTEGER QUSERS;                                             <<01433>>02182000
   BYTE ARRAY CNAME(0:8) = Q;                                  <<01389>>02184000
   BYTE ARRAY CGROUP(0:8) = Q;                                 <<01389>>02186000
   BYTE ARRAY CACCT(0:8) = Q;                                  <<01389>>02188000
   DEFINE INTRINEXIT = [10/214,6/3]#,                          <<01389>>02190000
   FLAG = [1/1,8/0,7/3]#;                                      <<04889>>02192000
                                                               <<01389>>02196000
   EQUATE                                                      <<01389>>02200000
   REC   =   0,                                                <<01433>>02202000
   SIZE   =   1,                                               <<01433>>02204000
   SPACE   =   2,                                              <<01433>>02206000
   USERS   =   6;                                              <<01433>>02208000
                                                               <<01389>>02210000
   ERRORON;                                                    <<01389>>02212000
   PARMS1:=0;                                                  <<01389>>02214000
   PARMS2:=[8/0,2/0,2/2,2/2,2/2];                              <<01389>>02216000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                           <<01389>>02218000
   IF CARRY THEN                                               <<03574>>02220000
   BEGIN         << DB not at stack >>                         <<03574>>02222000
      BUFDST := INDEX'(1);                                     <<03574>>02224000
      ENUM := INDEX';                                          <<03574>>02226000
      STACK := EXCHANGEDB(0);                                  <<03574>>02228000
   END                                                         <<03574>>02230000
   ELSE                                                        <<03574>>02232000
   BEGIN                                                       <<03574>>02234000
      BUFDST := INDEX'(1);                                     <<03574>>02236000
      ENUM := INDEX';                                          <<03574>>02238000
      STACK := 0;                                              <<03574>>02240000
   END;                                                        <<03574>>02242000
                                                               <<03574>>02244000
                                                               <<03574>>02246000
                                                               <<03574>>02250000
   << Make sure we have the proper capability >>               <<04890>>02252000
                                                               <<04890>>02254000
   IF NOT OKAY'UCAP THEN                                       <<04890>>02256000
   BEGIN                                                       <<04890>>02258000
      EXCHANGEDB(STACK);                                       <<04890>>02260000
      STATUS' := ILLEGALCAP;                                   <<04890>>02262000
      ERROREXIT(INTRINEXIT,0,0);                               <<04890>>02264000
   END;                                                        <<04890>>02266000
                                                               <<04890>>02268000
   << Verify the validity of the INDEX parameter. >>           <<03574>>02270000
                                                               <<03574>>02272000
  IF NOT CHEKINDEX(BUFDST,ENUM)  THEN                          <<04891>>02274000
   BEGIN         << Bad DST or bad entry offset >>             <<03574>>02278000
      EXCHANGEDB(STACK);                                       <<04889>>02280000
      STATUS' := INDEXERR;                                     <<03574>>02282000
      ERROREXIT(INTRINEXIT,0,0);                               <<03574>>02284000
   END;                                                        <<03574>>02286000
                                                               <<03574>>02288000
   CRSTATE:=SETCRITICAL;                                       <<01389>>02294000
   INDEX := TABINDEX := 0;                                     <<03574>>02298000
   WHO(,,,CNAME,CGROUP,CACCT);                                 <<01389>>02300000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<03574>>02302000
    IF BENTRY' = "        " THEN                               <<04891>>02306000
   BEGIN                                                       <<01389>>02308000
      EXCHANGEDB(STACK);                                       <<04889>>02310000
      RESETCRITICAL(CRSTATE);                                  <<01389>>02312000
      STATUS':=INDEXERR;                                       <<01389>>02314000
      ERROREXIT(INTRINEXIT,0,0);                               <<01389>>02316000
   END;                                                        <<01389>>02318000
   IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <> CACCT,(8) <<01389>>02320000
      OR BENTRY'(GROUP) <> CGROUP,(8) OR ENTRY'(UPIN) <> MYPIN <<04162>>02322000
   THEN                                                        <<01389>>02324000
   BEGIN                                                       <<01389>>02326000
      EXCHANGEDB(STACK);                                       <<04889>>02328000
      RESETCRITICAL(CRSTATE);                                  <<01389>>02330000
      STATUS':=SECVIOL;                                        <<01389>>02332000
      ERROREXIT(INTRINEXIT,0,0);                               <<01389>>02334000
   END;                                                        <<01389>>02336000
   DB:=EXCHANGEDB(BUFDST);                                     <<01389>>02340000
   QRECS:=DLOGBUFF(TRECS);                                     <<01389>>02342000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<03577>>02344000
   BEGIN                                                       <<01433>>02346000
      QFSIZE:=0D;   QFSPACE:=0D;                               <<01433>>02348000
   END                                                         <<01433>>02350000
   ELSE                                                        <<03575>>02352000
   BEGIN                                                       <<03575>>02354000
      QFSPACE := DLOGBUFF(MAXFSPACE) - DLOGBUFF(TRECS);        <<04889>>02356000
      QFSIZE := DLOGBUFF(MAXFSPACE);                           <<04889>>02358000
   END;                                                        <<03575>>02360000
   QUSERS:=LOGBUFF(NUMUSER);                                   <<01433>>02362000
   IF QFSPACE < 0D THEN QFSPACE :=0D;                          <<01433>>02364000
   EXCHANGEDB(STACK);                                          <<04889>>02366000
   DSTAT'ARRAY(REC):=QRECS;                                    <<01389>>02370000
   DSTAT'ARRAY(SIZE):=QFSIZE;                                  <<01389>>02372000
   DSTAT'ARRAY(SPACE):=QFSPACE;                                <<01389>>02374000
   STAT'ARRAY(USERS):=QUSERS;                                  <<01433>>02376000
   RESETCRITICAL(CRSTATE);                                     <<01389>>02378000
   ERROREXIT(INTRINEXIT,0,0);                                  <<01389>>02380000
END;                                                           <<01389>>02382000
$PAGE   "LOGGING INTRINSICS  --  CLOSELOG"                              02384000
                                                                        02386000
PROCEDURE CLOSELOG(INDEX',MODE,STAT);                                   02388000
DOUBLE INDEX';                                                          02390000
INTEGER STAT,MODE;                                                      02392000
OPTION PRIVILEGED;                                                      02394000
                                                               <<03575>>02396000
COMMENT                                                        <<03575>>02398000
  Intrinsic to close access to a User Logging file.            <<03575>>02400000
Will output a close record to the buffer area of the Logging   <<03575>>02402000
Buffer. (Calls FLUSH if no room). Releases the entry in the    <<03575>>02404000
Logging Buffer for this user.                                  <<03575>>02406000
                                                               <<03575>>02408000
PARAMETERS:                                                    <<03575>>02410000
                                                               <<03575>>02412000
 INDEX' - Originally from OPENLOG, identifies the user's       <<03575>>02414000
         access to the logging file.                           <<03575>>02416000
 MODE   - 0 = wait,  1 = no wait.                              <<03575>>02418000
 STAT   - Status information returned to user.                 <<03575>>02420000
                                                               <<03575>>02422000
;                                                              <<03575>>02424000
BEGIN                                                                   02426000
                                                               <<03574>>02428000
   BYTE ARRAY CNAME(0:8) = Q;                                           02432000
   BYTE ARRAY CGROUP(0:8) = Q;                                          02434000
   BYTE ARRAY CACCT(0:8) = Q;                                           02436000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<03575>>02438000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      02440000
                                                                        02444000
   LOGICAL ARRAY INDEX1(*) = INDEX';                                    02446000
   INTEGER INDEX;                                              <<04162>>02448000
LOGICAL NOWAIT,CRSTATE;                                        <<04162>>02450000
   INTEGER DB;                                                 <<04162>>02452000
   DOUBLE PARMS;                                                        02458000
   LOGICAL PARMS1 = PARMS;                                              02460000
   LOGICAL PARMS2 = PARMS + 1;                                          02462000
                                                                        02468000
   DEFINE INTRINEXIT = [10/212,6/3]#,                                   02470000
   FLAG  = [1/1,8/0,7/3]#;                                              02472000
                                                                        02474000
   LOGICAL POINTER BUF;                                        <<04162>>02476000
   DOUBLE POINTER DBUF;                                                 02478000
   BYTE POINTER BBUF;                                                   02480000
   INTEGER X = X;                                                       02482000
   INTEGER BUFDST;                                                      02486000
   INTEGER STACK,ENUM;                                                  02488000
                                                                        02492000
                                                                        02496000
                                                                        02498000
                                                                        02500000
SUBROUTINE CHECKMESSAGE;                                                02502000
BEGIN                                                                   02504000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<04889>>02506000
   BEGIN                                                                02508000
      TOS:=LOGBUFF(LOGMSG);                                    <<04889>>02510000
      RELEASE(DLOGBUFF(RESOURCE),NULL,1);                      <<00644>>02512000
      DB:=EXCHANGEDB(STACK);                                   <<04889>>02516000
      STAT:=TOS;    <<END OF FILE OR OUT OF DISC SPACE>>                02518000
      RESETCRITICAL(CRSTATE);                                  <<00644>>02520000
      ERROREXIT(INTRINEXIT,0,0);                                        02522000
   END;                                                                 02524000
END;                                                                    02526000
                                                                        02530000
                                                                        02532000
                                                                        02534000
   ERRORON;                                                             02536000
                                                               <<     >>02538000
   PARMS1:=0;                                                           02540000
   PARMS2:=[8/0,2/0,2/2,2/2,2/2];                                       02542000
   IF (MODE <> 0) AND (MODE <> 1) THEN                                  02544000
   BEGIN                                                                02546000
      STAT:=MODEERR;                                                    02548000
                                                               <<     >>02550000
      ERROREXIT(INTRINEXIT,0,0);                                        02552000
   END;                                                                 02554000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                                    02558000
   IF CARRY THEN                                                        02560000
   BEGIN                                                                02562000
      <<NOT POINTING AT STACK>>                                         02564000
      BUFDST:=INDEX1(1);                                                02566000
      ENUM:=INDEX1;                                                     02568000
      STACK:=EXCHANGEDB(0);                                             02570000
   END                                                                  02572000
   ELSE                                                                 02574000
   BEGIN                                                                02576000
      BUFDST:=INDEX1(1);                                                02578000
      ENUM:=INDEX1;                                                     02580000
      STACK:=0;                                                         02582000
   END;                                                                 02584000
                                                               <<04890>>02586000
   << Make sure we have the proper capability >>               <<04890>>02588000
                                                               <<04890>>02590000
   IF NOT OKAY'UCAP THEN                                       <<04890>>02592000
   BEGIN                                                       <<04890>>02594000
      EXCHANGEDB(STACK);                                       <<04890>>02596000
      STAT := ILLEGALCAP;                                      <<04890>>02598000
      ERROREXIT(INTRINEXIT,0,0);                               <<04890>>02600000
   END;                                                        <<04890>>02602000
                                                               <<04890>>02604000
                                                               <<03574>>02606000
   << Verify the validity of the INDEX parameter. >>           <<03574>>02608000
                                                               <<03574>>02610000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<04891>>02612000
   BEGIN        << Bad DST or bad entry offset >>              <<03574>>02616000
      EXCHANGEDB(STACK);                                       <<04889>>02618000
      STAT := INDEXERR;                                        <<03574>>02622000
      ERROREXIT(INTRINEXIT,0,0);                               <<03574>>02624000
   END;                                                        <<03574>>02626000
                                                               <<04889>>02628000
   CRSTATE:=SETCRITICAL;                                       <<     >>02630000
                                                                        02632000
   INDEX := 0;                                                 <<03574>>02636000
   WHO(,,,CNAME,CGROUP,CACCT);                                          02638000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<03574>>02640000
   IF BENTRY' = "        "  THEN                               <<04891>>02644000
   BEGIN                                                                02646000
   EXCHANGEDB(STACK);                                          <<04889>>02648000
      STAT:=INDEXERR;                                                   02650000
      RESETCRITICAL(CRSTATE);                                  <<00644>>02652000
      ERROREXIT(INTRINEXIT,0,0);                                        02654000
   END;                                                                 02656000
   IF BENTRY'(USER) <> CNAME,(8) OR BENTRY'(ACCT) <> CACCT,(8)          02658000
      OR BENTRY'(GROUP) <> CGROUP,(8) OR ENTRY'(UPIN) <> MYPIN <<04162>>02660000
    THEN                                                       <<04162>>02662000
   BEGIN                                                                02664000
      <<ILLEGAL CALL>>                                                  02666000
      EXCHANGEDB(STACK);                                       <<04889>>02668000
      STAT:=SECVIOL;                                                    02670000
      RESETCRITICAL(CRSTATE);                                  <<00644>>02672000
      ERROREXIT(INTRINEXIT,0,0);                                        02674000
   END;                                                                 02676000
   IF MODE = 1 THEN NOWAIT:=TRUE ELSE NOWAIT:=FALSE;                    02680000
   DB:=EXCHANGEDB(BUFDST);                                              02682000
   CHECKMESSAGE;                                                        02684000
   TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                                02686000
   DEL;                                                                 02688000
   IF NOWAIT THEN                                                       02690000
   BEGIN            <<MUST HAVE SPACE IN MEM BUFFER AND DISC>>          02692000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN   <<04889>>02694000
      BEGIN                                                    <<01389>>02698000
         FLUSH(ENUM);                                          <<01389>>02700000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                   <<00644>>02702000
     EXCHANGEDB(STACK);                                        <<04889>>02704000
         STAT:=NWAITERR;                                                02706000
            RESETCRITICAL(CRSTATE);                            <<00644>>02708000
         ERROREXIT(INTRINEXIT,0,0);                                     02710000
      END;                                                              02712000
   END;                                                                 02714000
   INDEX:=ENUM;                                                         02716000
   FORIT:                                                               02718000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED)) THEN    <<04889>>02720000
      BEGIN                                                    <<01389>>02724000
         FLUSH(ENUM);                                          <<01389>>02726000
         CHECKMESSAGE;                                         <<01389>>02728000
      END;                                                     <<01389>>02730000
   IF LOGBUFF(BSPACE) >= 1 THEN                                         02732000
   BEGIN                                                                02734000
      @BUF:=BUFBASE+(LOGBUFF(BUFUSED))*RECSIZE;                <<04821>>02736000
      @BBUF:=2*@BUF;                                                    02738000
      @DBUF:=@BUF;                                                      02740000
      BUF:="  ";                                               <<04821>>02742000
      MOVE BUF(1):=BUF, (LOGBUFF(BSPACE)*RECSIZE-1);           <<03575>>02744000
      MOVE BBUF(LID'):=BLOGBUFF(LOGID),(8);                    <<04889>>02746000
      BUF(LPIN) := MYPIN;                                      <<04889>>02748000
      MOVE BBUF(CREATOR):=BLOGBUFF(USER),(24);                          02750000
      BUF(LNUM):=LOGBUFF(LGNUM);                                        02752000
      BUF(CODE):=CLOSE;                                                 02754000
      BUF(CODE).(0:8):=LOGBUFF(SCODE).(0:8);                            02756000
      DBUF(RNUM):=DLOGBUFF(TRECS):=DLOGBUFF(TRECS)+1D;         <<01389>>02758000
      BUF(DATE):=CALENDAR;                                     <<01389>>02760000
      DBUF(TIME):=CLOCK;                                       <<01389>>02762000
      X := RECSIZEM1;                                          <<03575>>02764000
      TOS:=-1;                                                 <<01389>>02766000
      DO                                                       <<01389>>02768000
      BEGIN                                                    <<01389>>02770000
         IF X <> CKSUM THEN                                    <<01389>>02772000
         TOS:=TOS XOR BUF(X);                                  <<01389>>02774000
      END UNTIL (X:=X-1) < 0;                                  <<01389>>02776000
      BUF(CKSUM):=TOS;                                         <<01389>>02778000
      LOGBUFF(BSPACE):=LOGBUFF(BSPACE)-1;                      <<01389>>02780000
      LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) + 1;                <<04821>>02782000
      FLUSH(ENUM);                                             <<01389>>02784000
      CHECKMESSAGE;                                            <<01389>>02786000
   END  <<BSPACE >= 1>>                                                 02788000
   ELSE                                                                 02790000
   BEGIN                                                                02792000
      IF DLOGBUFF(FSPACE') >= DOUBLE(BLKFACTOR) THEN           <<04889>>02794000
      BEGIN                                                             02796000
         FLUSH(ENUM);                                          <<01389>>02798000
         CHECKMESSAGE;                                         <<01389>>02800000
          GO FORIT;                                                     02802000
      END                                                               02804000
      ELSE GO FORIT;                                                    02806000
   END;                                                                 02808000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<03577>>02810000
   IF LOGBUFF(STATE)=INACT THEN AWAKE(LOGBUFF(LOGPIN),%20,0);  <<01389>>02812000
   RELEASE(DLOGBUFF(RESOURCE),NULL,1);                         <<00644>>02814000
   EXCHANGEDB(0);                                                       02816000
   RELENTRY(ENUM,BUFDST);                                               02818000
                                                               <<00644>>02822000
                                                               <<00644>>02824000
   EXCHANGEDB(STACK);                                          <<04889>>02826000
   STAT:=0;                                                             02828000
   RESETCRITICAL(CRSTATE);                                     <<00644>>02830000
   ERROREXIT(INTRINEXIT,0,0);                                           02832000
END;                                                                    02834000
$TITLE        "LOGGING INTRINSICS  --  FLUSHLOG"               <<01389>>02836000
$PAGE                                                          <<04162>>02838000
PROCEDURE FLUSHLOG(INDEX',STAT);                               <<01389>>02840000
DOUBLE INDEX';                                                 <<01389>>02842000
INTEGER STAT;                                                  <<01389>>02844000
                                                               <<03575>>02846000
                                                               <<03575>>02848000
COMMENT                                                        <<03575>>02850000
 Intrinsic used to flush the User Logging memory buffer to the <<03575>>02852000
disc logging file or the disc logging buffer. No special       <<03575>>02854000
records are written. (Performed via call to FLUSH).            <<03575>>02856000
                                                               <<03575>>02858000
 PARAMETERS:                                                   <<03575>>02860000
                                                               <<03575>>02862000
 INDEX' - Supplied by user to identify access to logging file. <<03575>>02864000
          (Originally from intrinsic OPENLOG).                 <<03575>>02866000
 STAT   - Status information returned to user. (0 = all O.K.)  <<03575>>02868000
;                                                              <<03575>>02870000
                                                               <<03575>>02872000
                                                               <<03575>>02874000
                                                               <<03575>>02876000
BEGIN                                                          <<01389>>02878000
                                                               <<03574>>02880000
   INTEGER BUFDST;                                             <<03574>>02882000
   INTEGER ENUM;                                               <<01389>>02884000
   INTEGER QSTAT;                                              <<01389>>02886000
   INTEGER  STACK;                                             <<03574>>02888000
   INTEGER DB;                                                 <<01389>>02890000
   DOUBLE PARMS;                                               <<01389>>02894000
   LOGICAL PARMS1 = PARMS;                                     <<01389>>02896000
   LOGICAL PARMS2 = PARMS + 1;                                 <<01389>>02898000
   LOGICAL CRSTATE;                                            <<01389>>02900000
  BYTE ARRAY CNAME(0:8) = Q;                                   <<03574>>02902000
  BYTE ARRAY CGROUP(0:8) = Q;                                  <<03574>>02904000
  BYTE ARRAY CACCT(0:8) = Q;                                   <<03574>>02906000
                                                               <<03574>>02908000
  ARRAY ENTRY'(0:BENTRYSIZE-1) = Q;                            <<03574>>02910000
  BYTE ARRAY BENTRY'(*) = ENTRY';                              <<03574>>02912000
                                                               <<03574>>02914000
  INTEGER INDEX;                                               <<04889>>02916000
                                                               <<01389>>02918000
   LOGICAL ARRAY INDEX1(*) = INDEX';                           <<01389>>02920000
   DEFINE INTRINEXIT = [10/213,6/2]#;                          <<01389>>02922000
   DEFINE FLAG = [1/1,8/0,7/2]#;                               <<01389>>02924000
                                                               <<03575>>02926000
   SUBROUTINE CHECKMESSAGE;                                    <<01389>>02928000
   BEGIN                                                       <<01389>>02930000
      IF LOGBUFF(LOGMSG) <> CONTINUE THEN                      <<04889>>02932000
      BEGIN                                                    <<01389>>02934000
         QSTAT := LOGBUFF(LOGMSG);                             <<04889>>02936000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                   <<01389>>02938000
         EXCHANGEDB(STACK);                                    <<04889>>02940000
         STAT := QSTAT;                                        <<03574>>02944000
         RESETCRITICAL(CRSTATE);                               <<03574>>02946000
         ERROREXIT(INTRINEXIT,0,0);                            <<01389>>02948000
      END;                                                     <<01389>>02950000
   END;                                                        <<01389>>02952000
                                                               <<03575>>02954000
                                                               <<03575>>02956000
   ERRORON;                                                    <<01389>>02958000
   QSTAT:=0;                                                   <<01389>>02960000
   PARMS1:=0;                                                  <<01389>>02962000
   PARMS2:=[12/0,2/2,2/2];                                     <<01389>>02964000
                                                               <<01389>>02966000
   TOS:=CHEK(INTRINEXIT,FLAG,PARMS);                           <<01389>>02970000
   IF CARRY THEN                                               <<03574>>02972000
   BEGIN        << DB not at stack >>                          <<03574>>02974000
      BUFDST := INDEX1(1);                                     <<03574>>02976000
      ENUM := INDEX1;                                          <<03574>>02978000
      STACK := EXCHANGEDB(0);                                  <<03574>>02980000
   END                                                         <<03574>>02982000
   ELSE                                                        <<03574>>02984000
   BEGIN                                                       <<03574>>02986000
      BUFDST := INDEX1(1);                                     <<03574>>02988000
      ENUM := INDEX1;                                          <<03574>>02990000
      STACK := 0;                                              <<03574>>02992000
   END;                                                        <<03574>>02994000
                                                               <<04890>>02996000
   << Make sure we have the proper capability >>               <<04890>>02998000
                                                               <<04890>>03000000
   IF NOT OKAY'UCAP THEN                                       <<04890>>03002000
   BEGIN                                                       <<04890>>03004000
      EXCHANGEDB(STACK);                                       <<04890>>03006000
      STAT := ILLEGALCAP;                                      <<04890>>03008000
      ERROREXIT(INTRINEXIT,0,0);                               <<04890>>03010000
   END;                                                        <<04890>>03012000
                                                               <<03574>>03014000
   << Verify the validity of the INDEX parameter. >>           <<03574>>03016000
                                                               <<03574>>03018000
   IF NOT CHEKINDEX(BUFDST,ENUM) THEN                          <<04891>>03020000
   BEGIN       << Bad DST or bad entry offset >>               <<03574>>03024000
      EXCHANGEDB(STACK);                                       <<04889>>03026000
      STAT := INDEXERR;                                        <<03574>>03028000
      ERROREXIT(INTRINEXIT,0,0);                               <<03574>>03030000
   END;                                                        <<03574>>03032000
                                                               <<03574>>03034000
   CRSTATE:=SETCRITICAL;                                       <<01389>>03036000
   CNAME := "  ";                  << Clear CNAME, CGROUP,  >> <<03574>>03038000
   MOVE CNAME(1) := CNAME, (26);   << and CACCT.            >> <<03574>>03040000
                                                               <<03574>>03042000
   INDEX := 0;                                                 <<04889>>03044000
                                                               <<03574>>03046000
   WHO(,,,CNAME,CGROUP,CACCT);                                 <<03574>>03048000
   MOVE'FROM'DSEG(@ENTRY',BUFDST,ENUM,BENTRYSIZE);             <<03574>>03050000
   IF BENTRY' = "        " THEN                                <<04891>>03052000
   BEGIN                                                       <<03574>>03054000
      EXCHANGEDB(STACK);                                       <<04889>>03056000
      STAT := INDEXERR;                                        <<03574>>03058000
      RESETCRITICAL(CRSTATE);                                  <<03574>>03060000
      ERROREXIT(INTRINEXIT,0,0);                               <<03574>>03062000
   END;                                                        <<03574>>03064000
                                                               <<03574>>03066000
   IF BENTRY'(USER) <> CNAME, (8) OR                           <<03574>>03068000
      BENTRY'(ACCT) <> CACCT, (8) OR                           <<03574>>03070000
      BENTRY'(GROUP) <> CGROUP, (8) OR                         <<03574>>03072000
      ENTRY'(UPIN) <> MYPIN  THEN                              <<04162>>03074000
   BEGIN                                                       <<03574>>03076000
      EXCHANGEDB(STACK);                                       <<04889>>03078000
      STAT := SECVIOL;                                         <<03574>>03080000
      RESETCRITICAL(CRSTATE);                                  <<03574>>03082000
      ERROREXIT(INTRINEXIT,0,0);                               <<03574>>03084000
   END;                                                        <<03574>>03086000
   DB := EXCHANGEDB(BUFDST);                                   <<03574>>03090000
   TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                       <<01389>>03092000
   FLUSH(ENUM);                                                <<01389>>03094000
   CHECKMESSAGE;                                               <<01389>>03096000
   RELEASE(DLOGBUFF(RESOURCE),NULL,1);                         <<01389>>03098000
   EXCHANGEDB(STACK);                                          <<04889>>03100000
   STAT:=QSTAT;                                                <<01389>>03104000
   RESETCRITICAL(CRSTATE);                                     <<01389>>03106000
   ERROREXIT(INTRINEXIT,0,0);                                  <<01389>>03108000
END;                                                           <<01389>>03110000
$TITLE        "USER LOGGING UTILITIES"                         <<01389>>03112000
$PAGE                                                          <<04162>>03114000
                                                               <<01389>>03116000
PROCEDURE FLUSH(INDEX);                                        <<01389>>03118000
VALUE INDEX;                                                   <<01389>>03120000
INTEGER INDEX;                                                 <<01389>>03122000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01389>>03124000
                                                               <<04821>>03126000
COMMENT                                                        <<03575>>03128000
 Performs all I/O necessary to empty the buffer area to the    <<03575>>03130000
 disc logging file or disc buffer file. If not enough room     <<03575>>03132000
 in current extent, will awake the Logging Process to allocate <<03575>>03134000
 another extent.                                               <<03575>>03136000
                                                               <<03575>>03138000
ENTRY, EXIT :                                                  <<03575>>03140000
  DB is at the Logging Buffer.                                 <<03575>>03142000
  Process owns the Logging Resource.                           <<03575>>03144000
                                                               <<03575>>03146000
PARAMETER:                                                     <<03575>>03148000
 INDEX - Offset within the User Logging memory buffer for the  <<03575>>03150000
         user's entry.                                         <<03575>>03152000
         If it's NULL, then we were called by the user logging <<04821>>03154000
         process and we DO NOT want to try to awake the logging<<04821>>03156000
         process and then wait for it. (Obviously, we would    <<04821>>03158000
         be stuck waiting for ourselves).                      <<04821>>03160000
;                                                              <<03575>>03162000
                                                               <<03575>>03164000
                                                               <<03575>>03166000
BEGIN                                                          <<01389>>03168000
                                                               <<01389>>03170000
   EQUATE                                                      <<04821>>03172000
      NUMPARMS  =  1;   << Number of parameters to FLUSH. >>   <<04821>>03174000
                                                               <<04821>>03176000
   DEFINE                                                      <<04821>>03178000
     CALLED'BY'USER   =  (INDEX <> NULL) #;                    <<04821>>03180000
                                                               <<04821>>03182000
   DOUBLE QADDRESS;                                            <<01389>>03184000
   LOGICAL LOGADDR1 = QADDRESS;                                <<01389>>03186000
   LOGICAL LOGADDR2 = QADDRESS+1;                              <<01389>>03188000
                                                               <<01389>>03192000
   LOGICAL                                                     <<04821>>03196000
      COUNT,      << Amount to be written from buffer >>       <<04821>>03198000
      LEFT'OVER;  << Amount left after the write      >>       <<04821>>03200000
                                                               <<04821>>03202000
                                                               <<01389>>03204000
   DOUBLE                                                      <<04892>>03206000
      ATT'STAT;             << Return from ATTACHIO >>         <<04892>>03208000
                                                               <<04892>>03210000
   INTEGER                                                     <<04892>>03212000
      ATT'STAT0  =  ATT'STAT + 0,                              <<04892>>03214000
      ERRCODE,                                                 <<04892>>03216000
      TYPE',                                                   <<04892>>03218000
      ENTRY'DB;                                                <<04892>>03220000
                                                               <<04892>>03222000
   ARRAY TLOGID(0:4) = Q;                                      <<04892>>03224000
   BYTE ARRAY BTLOGID(*) = TLOGID;                             <<04892>>03226000
                                                               <<04892>>03228000
                                                               <<01389>>03230000
SUBROUTINE CHECKMESSAGE;                                       <<01389>>03232000
BEGIN                                                          <<01389>>03234000
   IF LOGBUFF(LOGMSG) <> CONTINUE THEN                         <<04889>>03236000
   ASSEMBLE(EXIT NUMPARMS);                                    <<04821>>03238000
END;                                                           <<01389>>03240000
                                                               <<01389>>03242000
                                                               <<01389>>03244000
SUBROUTINE ERR'EXIT;                                           <<04892>>03246000
BEGIN                                                          <<04892>>03248000
                                                               <<04892>>03250000
<< Called when I/O error occurs. Will print F.S. error and   >><<04892>>03252000
<< U.L. error, set the logmsg word to indicate a write error,>><<04892>>03254000
<< and exit back to the calling procedure.                   >><<04892>>03256000
                                                               <<04892>>03258000
ERRCODE := IOSTAT(ATT'STAT0);  << Get the F.S. error         >><<04892>>03260000
TYPE'   := LOGBUFF(LOGTYPE);                                   <<04892>>03262000
MOVE BTLOGID := BLOGBUFF(LOGID), (8);                          <<04892>>03264000
BTLOGID(8) := 0;                                               <<04892>>03266000
                                                               <<04892>>03268000
LOGBUFF(LOGMSG) := WRITEERR;   << So everyone will know      >><<04892>>03270000
                                                               <<04892>>03272000
ENTRY'DB := EXCHANGEDB(0);     << Back to stack              >><<04892>>03274000
                                                               <<04892>>03276000
GENMSG(FSSETNO,ERRCODE,,,,,,,0);  << File System error first >><<04892>>03278000
                                                               <<04892>>03280000
<< Now U.L. error >>                                           <<04892>>03282000
                                                               <<04892>>03284000
IF TYPE' = DISC                                                <<04892>>03286000
    THEN GENMSG(SETNO,FWRITEERROR,0,@BTLOGID,,,,,0)            <<04892>>03288000
ELSE GENMSG(SETNO,BWRITEERROR,0,@BTLOGID,,,,,0);               <<04892>>03290000
                                                               <<04892>>03292000
EXCHANGEDB(ENTRY'DB);                                          <<04892>>03294000
                                                               <<04892>>03296000
ASSEMBLE (EXIT NUMPARMS);                                      <<04892>>03298000
                                                               <<04892>>03300000
END;       << Err'exit >>                                      <<04892>>03302000
                                                               <<04892>>03304000
                                                               <<04892>>03306000
                                                               <<01389>>03308000
SUBROUTINE CLEAR;                                              <<01389>>03310000
BEGIN                                                          <<01389>>03312000
   LOGBUFF(BUFBASE) := "  ";                                   <<04821>>03314000
   MOVE LOGBUFF(BUFBASE+1):=LOGBUFF(BUFBASE),(BLKSIZE-1);      <<01389>>03316000
   IF LOGBUFF(LOGTYPE) = DISC THEN                             <<04821>>03318000
   BEGIN                                                       <<04821>>03320000
      IF LOGBUFF(EXTENT) >= LOGBUFF(LASTEXT') AND              <<04889>>03322000
         DLOGBUFF(FSPACE') < DOUBLE(BLKFACTOR)                 <<04889>>03324000
        THEN ILOGBUFF(BSPACE) := INTEGER(DLOGBUFF(FSPACE'))    <<04889>>03326000
      ELSE LOGBUFF(BSPACE) := BLKFACTOR;                       <<04821>>03328000
   END                                                         <<04821>>03330000
   ELSE LOGBUFF(BSPACE) := BLKFACTOR;                          <<04821>>03332000
                                                               <<04821>>03334000
   LOGBUFF(BUFUSED) := 0;                                      <<04821>>03336000
END;                                                           <<01389>>03338000
<<***** End of Subroutines ***********>>                       <<04821>>03340000
                                                               <<04821>>03342000
                                                               <<01389>>03344000
                                                               <<01389>>03346000
   COUNT := 0;                                                 <<04821>>03348000
   LEFT'OVER := 0;                                             <<04821>>03350000
                                                               <<04821>>03352000
                                                               <<04821>>03354000
                                                               <<04821>>03356000
   IF LOGBUFF(LOGTYPE) <> DISC  THEN                           <<03577>>03358000
   BEGIN                                                       <<01389>>03360000
                                                               <<04821>>03362000
CHECK'SPACE:                                                   <<01433>>03364000
                                                               <<04821>>03366000
      IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED)) THEN    <<04889>>03368000
      BEGIN                                                    <<04821>>03370000
                                                               <<04821>>03372000
         << We need the logging process to start emptying the>><<04821>>03374000
         << the disc buffer file before we post the buffer.  >><<04821>>03376000
         << However, if we were called by the logging process>><<04821>>03378000
         << we just want to set a flag and return. The log   >><<04821>>03380000
         << process will see the flag, empty the disc buffer,>><<04821>>03382000
         << and call us again later.                         >><<04821>>03384000
                                                               <<04821>>03386000
         IF NOT CALLED'BY'USER THEN                            <<04821>>03388000
         BEGIN                                                 <<04821>>03390000
            LOGBUFF(USERMSG) := DISCSPACE;                     <<04889>>03392000
            RETURN;                                            <<04821>>03394000
         END;                                                  <<04821>>03396000
                                                               <<04821>>03398000
         PDISABLE;                                             <<01389>>03400000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                   <<01389>>03402000
         AWAKE(LOGBUFF(LOGPIN),%20,0);                         <<01389>>03404000
         LOGBUFF(SLPCT):=LOGBUFF(SLPCT)+1;                     <<01389>>03406000
         LOGBUFF(WSTATE):=INACT;                               <<01433>>03408000
         WAIT(%20,0);                                          <<01389>>03410000
                                                               <<04821>>03412000
         << First want to make sure that the logging process >><<04821>>03414000
         << was able to successfully complete this request.  >><<04821>>03416000
         << If all is okay, then we'll go back and try again.>><<04821>>03418000
         << If there was some problem, then CHECKMESSAGE will>><<04821>>03420000
         << return to the caller.                            >><<04821>>03422000
                                                               <<04821>>03424000
         OBTAIN(DLOGBUFF(RESOURCE),NULL);                      <<01433>>03426000
         CHECKMESSAGE;                                         <<01389>>03428000
         GO CHECK'SPACE;                                       <<01433>>03430000
      END;                                                     <<01389>>03432000
                                                               <<04821>>03434000
      << There is room in the disc buffer - start flushing.  >><<04821>>03436000
                                                               <<04821>>03438000
      QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);          <<01389>>03440000
      COUNT := LOGBUFF(BUFUSED) * RECSIZE;                     <<04821>>03442000
      IF DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE) >            <<01389>>03444000
      DLOGBUFF(FSIZE) THEN                                     <<01389>>03446000
      BEGIN                                                    <<01389>>03448000
                                                               <<01389>>03450000
         << We will need more than one write to flush the    >><<04821>>03452000
         << entire buffer. The disc buffer file is treated   >><<04821>>03454000
         << like a circular file, we may only have room for  >><<04821>>03456000
         << part of the buffer before we cycle back to the   >><<04821>>03458000
         << start of the buffer file.                        >><<04821>>03460000
                                                               <<04821>>03462000
                                                               <<01389>>03464000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03466000
         @LOGBUFF(BUFBASE),WRITE,COUNT:=INTEGER(DLOGBUFF(FSIZE)-        03468000
         DLOGBUFF(INBUFREC))*RECSIZE,LOGADDR1,LOGADDR2,FLAGS); <<01389>>03470000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN  ERR'EXIT;       <<04892>>03472000
                                                               <<04892>>03476000
         << Time to reset our pointer to the top of the disc >><<04821>>03478000
         << buffer file.                                     >><<04821>>03480000
                                                               <<04821>>03482000
         DLOGBUFF(INBUFREC):=0D;                               <<01389>>03484000
         COUNT := LOGBUFF(BUFUSED) * RECSIZE - COUNT;          <<04821>>03486000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01389>>03488000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03490000
         @LOGBUFF(BUFBASE+BLKSIZE-LOGBUFF(BSPACE)*RECSIZE-COUNT),       03492000
         WRITE,COUNT,LOGADDR1,LOGADDR2,FLAGS);                 <<01389>>03494000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN ERR'EXIT;        <<04892>>03496000
                                                               <<04892>>03498000
                                                               <<04821>>03502000
         << We have now successfully completed flushing the  >><<04821>>03504000
         << buffer. Now update the global info and clear the >><<04821>>03506000
         << buffer so we're ready for more stuff.            >><<04821>>03508000
                                                               <<04821>>03510000
         DLOGBUFF(FSPACE'):=DLOGBUFF(FSPACE')-DOUBLE(BLKFACTOR)<<04889>>03512000
                            + DOUBLE(LOGBUFF(BSPACE));         <<04889>>03514000
         LOGBUFF(BSPACE):=BLKFACTOR;                           <<01389>>03516000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  03518000
         IF DLOGBUFF(INBUFREC)>=DLOGBUFF(FSIZE) THEN           <<01389>>03520000
         DLOGBUFF(INBUFREC):=0D;                               <<01389>>03522000
         CLEAR;                                                <<01389>>03524000
          RETURN;                                              <<01433>>03526000
      END                                                      <<01389>>03528000
                                                               <<04821>>03530000
      ELSE                                                     <<01389>>03532000
      BEGIN                                                    <<01389>>03534000
                                                               <<04821>>03536000
         << Simple case, only one write will be necessary to>> <<04821>>03538000
         << flush the buffer to the disc buffer file.       >> <<04821>>03540000
                                                               <<04821>>03542000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01389>>03544000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03546000
              @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2, <<04821>>03548000
              FLAGS);                                          <<04821>>03550000
         IF ATT'STAT0.(13:3) <> SUCCESS  THEN ERR'EXIT;        <<04892>>03552000
                                                               <<04892>>03554000
                                                               <<04821>>03558000
         << We have now successfully completed flushing the  >><<04821>>03560000
         << buffer. Now update the global info and clear the >><<04821>>03562000
         << buffer so we're ready for more stuff.            >><<04821>>03564000
                                                               <<04821>>03566000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  03570000
         IF DLOGBUFF(INBUFREC) >= DLOGBUFF(FSIZE) THEN         <<01389>>03572000
         DLOGBUFF(INBUFREC):=0D;                               <<01389>>03574000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<04889>>03576000
                              DOUBLE(COUNT/RECSIZE);           <<04889>>03578000
         CLEAR;                                                <<01389>>03580000
      END;                                                     <<01389>>03582000
                                                               <<04821>>03584000
      << The buffer is flushed, and ready for more use. If   >><<04821>>03586000
      << there is any stuff in the disc buffer file, we will >><<04821>>03588000
      << awake the logging process to take care of it.       >><<04821>>03590000
      << Of course, if we were called by the logging process >><<04821>>03592000
      << then we simply return.                              >><<04821>>03594000
                                                               <<04821>>03596000
      IF DLOGBUFF(FSIZE)-DLOGBUFF(FSPACE')>=DOUBLE(BLKFACTOR)  <<04889>>03598000
         AND  CALLED'BY'USER                                   <<04821>>03600000
        THEN  AWAKE(LOGBUFF(LOGPIN),%20,0);                    <<04821>>03602000
         RETURN;                                               <<01433>>03604000
   END;                                                        <<01389>>03606000
                                                               <<04821>>03608000
   << This is the case for a disc log file. >>                 <<04821>>03610000
                                                               <<04821>>03612000
   IF DLOGBUFF(FSPACE') <= DOUBLE(LOGBUFF(BUFUSED))  THEN      <<04889>>03614000
   BEGIN                                                       <<04821>>03618000
                                                               <<04821>>03620000
      << There is either not enough room in this extent to  >> <<04821>>03622000
      << flush the entire buffer, or after the buffer is    >> <<04821>>03624000
      << flushed the buffer will be full. In this case we   >> <<04821>>03626000
      << will flush the buffer and ask for another extent.  >> <<04821>>03628000
                                                               <<04821>>03630000
      IF LOGBUFF(EXTENT) >= LOGBUFF(LASTEXT') THEN             <<04889>>03632000
      BEGIN                                                    <<04821>>03634000
                                                               <<04821>>03636000
         << Opps...there are no more extents available. We   >><<04821>>03638000
         << will only write out what we can.                 >><<04821>>03640000
                                                               <<04821>>03642000
         IF DLOGBUFF(FSPACE') > 0D  THEN                       <<04889>>03644000
         BEGIN                                                 <<04821>>03646000
            COUNT:=INTEGER(DLOGBUFF(FSPACE'))*RECSIZE;         <<04889>>03648000
                                                               <<04821>>03650000
            IF COUNT > BLKSIZE                                 <<04821>>03652000
               THEN COUNT := BLKSIZE-LOGBUFF(BSPACE)*RECSIZE;  <<04821>>03654000
                                                               <<04821>>03656000
            QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);    <<01389>>03658000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03660000
            @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2,FLAGS);     03662000
            IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;      <<04892>>03664000
                                                               <<04892>>03666000
         END;                                                  <<01389>>03670000
                                                               <<04821>>03672000
         << Update the global info, tell the process that    >><<04821>>03674000
         << we're totally out of file space, and tell the    >><<04821>>03676000
         << user that we are out of file space.              >><<04821>>03678000
                                                               <<04821>>03680000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<04889>>03684000
                            DOUBLE(COUNT/RECSIZE);             <<04821>>03686000
         DLOGBUFF(INBUFREC) := DLOGBUFF(INBUFREC) +            <<04821>>03688000
                               DOUBLE(COUNT/RECSIZE);          <<04821>>03690000
         CLEAR;                                                <<04821>>03692000
                                                               <<04821>>03694000
         LOGBUFF(USERMSG) := DISCSPACE;                        <<04889>>03696000
         LOGBUFF(LOGMSG) := EOFONLOGFILE;                      <<04889>>03698000
                                                               <<04821>>03700000
         IF NOT CALLED'BY'USER THEN                            <<04821>>03702000
         BEGIN                                                 <<04821>>03704000
            IF DLOGBUFF(FSPACE') = 0D THEN                     <<04889>>03706000
            BEGIN                                              <<04821>>03708000
               LOGBUFF(USERMSG) := CONTINUE;                   <<04889>>03710000
               LOGBUFF(LOGMSG) := CONTINUE;                    <<04889>>03712000
            END;                                               <<04821>>03714000
         END                                                   <<04821>>03716000
         ELSE AWAKE(LOGBUFF(LOGPIN),%20,0);                    <<04821>>03718000
                                                               <<04821>>03720000
         RETURN;                                               <<04821>>03722000
      END                                                      <<01389>>03724000
                                                               <<04821>>03726000
      ELSE                                                     <<04821>>03728000
      BEGIN                                                    <<01389>>03730000
                                                               <<04821>>03732000
         << We have another extent available to us. Write out>><<04821>>03734000
         << enough to fill this extent. We will then ask the >><<04821>>03736000
         << log process to get us another extent so that we  >><<04821>>03738000
         << can then finish flushing the buffer.             >><<04821>>03740000
                                                               <<04821>>03742000
         COUNT:=INTEGER(DLOGBUFF(FSPACE'))*RECSIZE;            <<04889>>03744000
         LEFT'OVER := BLKSIZE-COUNT - LOGBUFF(BSPACE)*RECSIZE; <<04821>>03746000
         IF COUNT = 0 THEN LEFT'OVER := 0;                     <<04821>>03748000
                                                               <<04821>>03750000
         IF COUNT > 0 THEN                                     <<04821>>03752000
         BEGIN  << Something to write >>                       <<04821>>03754000
                                                               <<04821>>03756000
         QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);       <<01389>>03758000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03760000
         @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,LOGADDR2,FLAGS);        03762000
         IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;         <<04892>>03764000
                                                               <<04892>>03766000
                                                               <<04821>>03770000
         << Now update the global info to reflect what>>       <<04821>>03772000
         << has just happened.                        >>       <<04821>>03774000
                                                               <<04821>>03776000
         LOGBUFF(BSPACE) := LOGBUFF(BSPACE) + COUNT/RECSIZE;   <<04821>>03778000
         LOGBUFF(BUFUSED) := LOGBUFF(BUFUSED) - COUNT/RECSIZE; <<04821>>03780000
         DLOGBUFF(INBUFREC) := DLOGBUFF(INBUFREC) +            <<04821>>03782000
                               DOUBLE(COUNT/RECSIZE);          <<04821>>03784000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<04889>>03786000
                             DOUBLE(COUNT/RECSIZE);            <<04821>>03788000
                                                               <<04821>>03790000
         << If there is any info left in the buffer, then   >> <<04821>>03792000
         << must shift it to the top to prepare for the next>> <<04821>>03794000
         << write.                                          >> <<04821>>03796000
                                                               <<04821>>03798000
         IF LEFT'OVER > 0 THEN                                 <<04821>>03800000
           MOVE LOGBUFF(BUFBASE):=LOGBUFF(BUFBASE+COUNT),      <<04821>>03802000
                                  (LEFT'OVER);                 <<04821>>03804000
                                                               <<04821>>03806000
         << Now clear the remaider of the buffer >>            <<04821>>03808000
                                                               <<04821>>03810000
         LOGBUFF(BUFBASE+LEFT'OVER) := "  ";                   <<04821>>03812000
         MOVE LOGBUFF(BUFBASE+LEFT'OVER+1) :=                  <<04821>>03814000
              LOGBUFF(BUFBASE+LEFT'OVER), (COUNT-1);           <<04821>>03816000
                                                               <<04821>>03818000
         END;      << Something to write >>                    <<04821>>03820000
                                                               <<04821>>03822000
         << We need another extent. Only wake up the logging >><<04821>>03824000
         << process if we have been called by a user.        >><<04821>>03826000
                                                               <<04821>>03828000
         IF NOT CALLED'BY'USER THEN                            <<04821>>03830000
         BEGIN                                                 <<04821>>03832000
                                                               <<04821>>03834000
            IF LEFT'OVER > 0  OR                               <<04821>>03836000
               (COUNT = 0 LAND LOGBUFF(BUFUSED) > 0)           <<04821>>03838000
              THEN LOGBUFF(USERMSG) := DISCSPACE               <<04889>>03840000
            ELSE LOGBUFF(LOGMSG) := CONTINUE;                  <<04889>>03842000
            RETURN;                                            <<04821>>03844000
         END;                                                  <<04821>>03846000
                                                               <<04821>>03848000
         DLOGBUFF(INBUFREC):=0D;                               <<01389>>03850000
         PDISABLE;                                             <<01389>>03852000
         LOGBUFF(USERMSG):=DISCSPACE;                          <<04889>>03854000
         AWAKE(LOGBUFF(LOGPIN),%20,0);                         <<01389>>03856000
         LOGBUFF(SLPCT):=LOGBUFF(SLPCT)+1;                     <<01389>>03858000
         LOGBUFF(WSTATE):=INACT;                               <<01389>>03860000
                                                               <<04821>>03862000
         << Wait for LOG PROC to allocate the next extent >>   <<03575>>03864000
                                                               <<04821>>03866000
         WAIT(%20,0);                                          <<01389>>03868000
                                                               <<04821>>03870000
         << Make sure that the log process was able to       >><<04821>>03872000
         << successfully complete this request. If not,      >><<04821>>03874000
         << CHECKMESSAGE will return to the caller.          >><<04821>>03876000
                                                               <<04821>>03878000
         CHECKMESSAGE;                                         <<01389>>03880000
                                                               <<04821>>03882000
         << Now check to see if there is any more to flush.  >><<04821>>03884000
                                                               <<04821>>03886000
         COUNT := LOGBUFF(BUFUSED) * RECSIZE;                  <<04821>>03888000
         IF COUNT > 0 THEN                                     <<04821>>03890000
         BEGIN                                                 <<04821>>03892000
                                                               <<04821>>03894000
            << Now we can finish writing to the new extent.  >><<04821>>03896000
                                                               <<04821>>03898000
            QADDRESS := DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);  <<04821>>03900000
        ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),<<04892>>03902000
                          @LOGBUFF(BUFBASE),WRITE,COUNT,       <<04821>>03904000
                          LOGADDR1,LOGADDR2,FLAGS);            <<04821>>03906000
         IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;         <<04892>>03908000
                                                               <<04892>>03910000
                                                               <<04821>>03914000
         END;    << Complete the write into new extent >>      <<04821>>03916000
                                                               <<04821>>03918000
                                                               <<04821>>03920000
         << The buffer has been successfully flushed, clear  >><<04821>>03922000
         << it out, and update the global info - i.e. the    >><<04821>>03924000
         << number of records now available in the buffer.   >><<04821>>03926000
                                                               <<04821>>03928000
         DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);  03932000
         DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -              <<04889>>03934000
                              DOUBLE(COUNT/RECSIZE);           <<04889>>03936000
         CLEAR;                                                <<04821>>03938000
         LOGBUFF(LOGMSG):=CONTINUE;                            <<04889>>03942000
         RETURN;                                               <<01389>>03944000
      END;                                                     <<01389>>03946000
                                                               <<04821>>03948000
   END                                                         <<01389>>03950000
   ELSE                                                        <<04821>>03952000
   BEGIN                                                       <<01389>>03954000
      << Simple case, there is plenty of room in the current >><<04821>>03956000
      << extent - just write it out and return.              >><<04821>>03958000
                                                               <<04821>>03960000
      QADDRESS:=DLOGBUFF(LOGADDR)+DLOGBUFF(INBUFREC);          <<01389>>03962000
      COUNT := LOGBUFF(BUFUSED) * RECSIZE;                     <<04821>>03964000
      ATT'STAT:=ATTACHIO(LOGBUFF(LOGDEV),QMISC,LOGBUFF(BDST),  <<04892>>03966000
      @LOGBUFF(BUFBASE),WRITE,COUNT,LOGADDR1,                  <<01389>>03968000
      LOGADDR2,FLAGS);                                         <<01389>>03970000
      IF ATT'STAT0.(13:3) <> SUCCESS THEN ERR'EXIT;            <<04892>>03972000
                                                               <<04892>>03974000
                                                               <<04821>>03978000
      DLOGBUFF(FSPACE') := DLOGBUFF(FSPACE') -                 <<04889>>03984000
                           DOUBLE(COUNT/RECSIZE);              <<04889>>03986000
      DLOGBUFF(INBUFREC):=DLOGBUFF(INBUFREC)+DOUBLE(COUNT/RECSIZE);     03988000
      CLEAR;                                                   <<04821>>03990000
      LOGBUFF(LOGMSG):=CONTINUE;                               <<04889>>03992000
   END;                                                        <<01389>>03994000
                                                               <<04821>>03996000
END;       << Procedure FLUSH >>                               <<04821>>03998000
                                                               <<01389>>04000000
                                                                        04002000
                                                                        04004000
$PAGE                                                          <<04892>>04006000
PROCEDURE UPSHIFT'(PTR);                                                04008000
VALUE PTR;                                                              04010000
BYTE POINTER PTR;                                                       04012000
OPTION INTERNAL;                                               <<04889>>04014000
BEGIN                                                                   04016000
   BYTE POINTER BPS0 = S-0;                                             04018000
   TOS:=@PTR;                                                           04020000
   DO                                                                   04022000
   BEGIN                                                                04024000
      ASSEMBLE(DUP);                                                    04026000
      MOVE *:=* WHILE ANS,1;                                            04028000
      TOS:=TOS+1;                                                       04030000
   END UNTIL BPS0(-1) = 0;                                              04032000
END;                                                                    04034000
                                                                        04036000
                                                                        04038000
$PAGE  "TABLE ACCESS UTILITIES"                                <<04162>>04040000
                                                                        04042000
PROCEDURE FENTRY(LOGID',PASS,LFNAME',CUSER,CACCT,TYPE');       <<04889>>04044000
BYTE ARRAY LOGID',LFNAME',CUSER,CACCT,PASS;                    <<04889>>04046000
LOGICAL TYPE';                                                          04048000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                                  04050000
                                                               <<03573>>04052000
COMMENT                                                        <<03573>>04054000
ENTRY IN THE LOGGING IDENTIFIER TABLE (LIDTAB).                         04056000
                                                                        04058000
THE SEARCH USES THE "LOGID" PARAMETER TO FIND THE ENTRY AND             04060000
RETURNS INFORMATION ON THE LOGGING IDENTIFIER IN THE OTHER              04062000
PARAMETERS.                                                             04064000
                                                                        04066000
LOGID'   =   Logging identifer.                                <<03573>>04068000
PASS     =   Password associated with the logid.               <<03573>>04070000
LFNAME'   =  Name of the destination file                      <<04889>>04072000
CUSER    =  Name of the user who created the logging id.       <<03573>>04076000
CACCT    =  Account the creator resides in.                    <<03573>>04078000
TYPE'    =  The type of the logging file :                     <<03573>>04080000
               -1 = NULL (not in use)                          <<03573>>04082000
                0 = DISC                                       <<03573>>04084000
                1 = TAPE                                       <<03573>>04086000
                2 = SDISC                                      <<04162>>04088000
                3 = CTAPE                                      <<04162>>04090000
                                                               <<03573>>04092000
    DB must be at stack.                                       <<04162>>04094000
                                                               <<03575>>04096000
RETURNS:                                                       <<03575>>04098000
   CCG If not found.                                           <<03575>>04100000
   CCE If found.                                               <<03575>>04102000
;                                                              <<03573>>04104000
                                                                        04106000
BEGIN                                                                   04108000
   INTEGER STATUS' = Q-1;                                               04110000
   INTEGER MAX,I,J,K;                                          <<04162>>04112000
   LOGICAL MASK = Q-4;                                                  04114000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<03575>>04116000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      04118000
                                                                        04120000
                                                                        04122000
   <<GET MAX NUMBER OF ENTRIES>>                                        04124000
                                                                        04126000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<03574>>04128000
   MOVE LOGID':=LOGID' WHILE ANS,0;                                     04132000
   K:=TOS-@LOGID';                                                      04134000
                                                               <<03573>>04136000
   IF  K <= 0 THEN                                             <<03573>>04138000
   BEGIN        << Logid does not start with alpha char. >>    <<03573>>04140000
      CC := CCG;                                               <<03573>>04142000
      RETURN;                                                  <<03573>>04144000
   END;                                                        <<03573>>04146000
                                                               <<03573>>04148000
   IF K > 8 THEN K:=8;                                                  04150000
   I := 1;                                                     <<04889>>04152000
   DO                                                                   04154000
   BEGIN                     <<SEARCH FOR LOGGING IDENTIFIER>>          04156000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);      <<04889>>04158000
      IF BENTRY'(LID+7) <> " " THEN J:=8                                04162000
      ELSE                                                              04164000
      BEGIN                                                             04166000
         MOVE BENTRY'(LID):=BENTRY'(LID) WHILE AN,0;                    04168000
         J:=TOS-@BENTRY'(LID);                                          04170000
      END;                                                              04172000
   END UNTIL (BENTRY'(LID) = LOGID',(J)) AND (ENTRY'(TYP) <> NULL) AND  04174000
   (K = J) OR (I:=I+1) > MAX;                                           04176000
   IF I <= MAX THEN                                                     04178000
   BEGIN                                                                04180000
      <<FOUND IT>>                                                      04182000
      IF MASK.(12:1) THEN                                               04184000
      BEGIN                                                             04186000
         IF BENTRY'(FNAME'+7) <> " "                           <<04889>>04188000
            THEN MOVE LFNAME' := BENTRY'(FNAME'), (8), 2       <<04889>>04190000
         ELSE MOVE LFNAME' := BENTRY'(FNAME')  WHILE AN, 1;    <<04889>>04192000
                                                               <<03573>>04194000
         IF ENTRY'(TYP) = DISC THEN                            <<03573>>04196000
         BEGIN                                                 <<03573>>04198000
            IF BENTRY'(LW) <> " " THEN                         <<03573>>04200000
            BEGIN         << Get lockword >>                   <<03573>>04202000
               MOVE * := "/", 2;                               <<03573>>04204000
               IF BENTRY'(LW+7) <> " "                         <<03573>>04206000
                  THEN MOVE * := BENTRY'(LW), (8), 2           <<03573>>04208000
               ELSE MOVE * := BENTRY'(LW)  WHILE AN, 1;        <<03573>>04210000
            END;                                               <<03573>>04212000
                                                               <<03573>>04214000
            MOVE * := ".", 2;                                  <<03573>>04216000
            IF BENTRY'(FGROUP+7) <> " "                        <<03573>>04218000
               THEN MOVE * := BENTRY'(FGROUP), (8), 2          <<03573>>04220000
            ELSE MOVE * := BENTRY'(FGROUP)  WHILE AN, 1;       <<03573>>04222000
                                                               <<03573>>04224000
            MOVE * := ".", 2;                                  <<03573>>04226000
            IF BENTRY'(FACCT+7) <> " "                         <<03573>>04228000
               THEN MOVE * := BENTRY'(FACCT), (8), 2           <<03573>>04230000
            ELSE MOVE * := BENTRY'(FACCT)  WHILE AN, 1;        <<03573>>04232000
         END;                                                  <<03573>>04234000
      END;                                                              04236000
      IF MASK.(13:1) THEN MOVE CUSER:=BENTRY'(UNAME),(8);               04238000
      IF MASK.(11:1) THEN MOVE PASS:=BENTRY'(PW),(8);                   04240000
      IF MASK.(14:1) THEN MOVE CACCT:=BENTRY'(UACCT),(8);               04242000
      IF MASK.(15:1) THEN TYPE':=ENTRY'(TYP);                           04244000
   END                                                                  04246000
   ELSE                                                                 04248000
   BEGIN                                   <<DID NOT FIND IT>>          04250000
      CC:=CCG;                                                          04252000
      RETURN;                                                           04254000
   END;                                                                 04256000
   CC:=CCE;                                                             04258000
END;                                                                    04260000
                                                                        04262000
$PAGE                                                          <<04162>>04264000
PROCEDURE DENTRY(LOGID',LEN);                                  <<04162>>04266000
   VALUE LEN;                                                  <<04162>>04268000
   INTEGER LEN;                                                <<04162>>04270000
   BYTE ARRAY LOGID';                                          <<04162>>04272000
   OPTION INTERNAL;                                            <<04162>>04274000
                                                                        04276000
                                                                        04278000
<< This procedure deletes entries from the Logging Identifier>><<03575>>04280000
<< Table (LIDTAB).                                           >><<03575>>04282000
<< The parameter LOGID' is used as the search key and if the >><<03575>>04284000
<< user calling this procedure is the creator, then the entry>><<03575>>04286000
<< will be deleted.                                          >><<03575>>04288000
<<                                                           >><<03575>>04290000
<<    DB must be at stack.                                   >><<04162>>04292000
<< RETURNS:                                                  >><<03575>>04294000
<<     CCE - entry for the specified entry was deleted.      >><<04162>>04296000
<<     CCL - entry not found.ed.                             >><<04162>>04298000
<<     CCG - user is not the creator, entry not deleted.     >><<04162>>04300000
<<                                                           >><<03575>>04302000
                                                                        04306000
BEGIN                                                                   04310000
   INTEGER STATUS' = Q-1;                                               04312000
   INTEGER I,MAX;                                                       04314000
   INTEGER LIDLENGTH;      << Length of logid from the table >><<04162>>04316000
                                                               <<03575>>04318000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<03575>>04320000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      04322000
   BYTE ARRAY CUSER(0:7) = Q;                                           04324000
   BYTE ARRAY CACCT (0:7) = Q;                                          04328000
                                                               <<03575>>04330000
   << Get the maximum number of entries in the LID.   >>       <<04162>>04334000
                                                               <<04162>>04336000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<04162>>04338000
                                                               <<04162>>04340000
   I := 1;                                                     <<04162>>04342000
   DO                                                          <<04162>>04344000
     BEGIN                                                     <<04162>>04346000
        << Get next entry from LID. >>                         <<04162>>04348000
                                                               <<04162>>04350000
        MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);    <<04162>>04352000
                                                               <<04162>>04354000
        << Need length of the logid as found in the table >>   <<04162>>04356000
                                                               <<04162>>04358000
        IF BENTRY'(LID+7) <> " " THEN LIDLENGTH := 8           <<04162>>04360000
        ELSE                                                   <<04162>>04362000
        BEGIN                                                  <<04162>>04364000
           MOVE BENTRY'(LID) := BENTRY'(LID) WHILE AN, 1;      <<04162>>04366000
           LIDLENGTH := TOS - @BENTRY';                        <<04162>>04368000
        END;                                                   <<04162>>04370000
                                                               <<04162>>04372000
        IF BENTRY'(LID) = LOGID', (LEN)  AND                   <<04162>>04374000
           LIDLENGTH = LEN    THEN                             <<04162>>04376000
        BEGIN       << We've found the specified logid >>      <<04162>>04378000
           WHO(,,,CUSER,,CACCT);                               <<04162>>04380000
           IF BENTRY'(UNAME) <> CUSER, (8)  OR                 <<04583>>04382000
              BENTRY'(UACCT) <> CACCT, (8)  THEN               <<04583>>04384000
           BEGIN                                               <<04162>>04386000
              CC := CCG;    << Not the creator >>              <<04162>>04388000
              RETURN;                                          <<04162>>04390000
           END;                                                <<04162>>04392000
                                                               <<04162>>04394000
           << At this point we've found the match and are the>><<04162>>04396000
           << creator. Blank out the entry.                  >><<04162>>04398000
                                                               <<04162>>04400000
           ENTRY' := "  ";                                     <<04162>>04402000
           MOVE ENTRY'(1) := ENTRY', (LIDESIZE-1);             <<04162>>04404000
           ENTRY'(TYP) := NULL;                                <<04162>>04406000
           MOVE'TO'DSEG(LIDDST,I*LIDESIZE,@ENTRY',LIDESIZE);   <<04162>>04408000
           WRITEDSEG(LIDDST);                                  <<04162>>04410000
                                                               <<04162>>04412000
           CC := CCE;                                          <<04162>>04414000
           RETURN;                                             <<04162>>04416000
        END;       << Found a match >>                         <<04162>>04418000
     END                                                       <<04162>>04420000
   UNTIL (I := I + 1) > MAX;                                   <<04162>>04422000
                                                               <<04162>>04424000
   << If we fall thru here, the logid was not found >>         <<04162>>04426000
                                                               <<04162>>04428000
   CC := CCL;                                                  <<04162>>04430000
                                                               <<04162>>04432000
END;              << Procedure DENTRY >>                       <<04162>>04434000
                                                                        04436000
                                                                        04438000
                                                                        04440000
$PAGE                                                          <<04162>>04442000
PROCEDURE AENTRY(NEWENTRY');                                   <<03573>>04444000
   ARRAY NEWENTRY';                                            <<03573>>04446000
   OPTION INTERNAL;                                            <<04162>>04448000
                                                               <<03573>>04450000
   << NEWENTRY' is in the format of an entry for the LIDTAB. >><<03573>>04452000
                                                               <<03573>>04454000
                                                                        04456000
<< This procedure adds entries to the Logging Identifier     >><<03575>>04458000
<< Table (LIDTAB).                                           >><<03575>>04460000
<<                                                           >><<03575>>04462000
<<    DB must be at stack.                                   >><<04162>>04464000
<< RETURNS:                                                  >><<03575>>04466000
<<     CCL if entry not added (no room).                     >><<03575>>04468000
<<     CCE if entry added to LIDTAB.                         >><<03575>>04470000
<<                                                           >><<03575>>04472000
<<                                                           >><<03575>>04474000
BEGIN                                                                   04476000
   BYTE ARRAY NEWENTRY(*) = NEWENTRY';                         <<03573>>04478000
                                                                        04480000
   INTEGER STATUS' = Q-1;                                               04482000
   INTEGER I,MAX;                                                       04484000
                                                               <<03575>>04486000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<03575>>04488000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      04490000
                                                               <<03575>>04492000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<03574>>04494000
                                                                        04498000
   I:=0;                                                                04500000
   DO                                                                   04502000
   BEGIN                     <<SEARCH FOR LOGGING IDENTIFIER>>          04504000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,EBASE+I*LIDESIZE,LIDESIZE);<<03574>>04506000
  END                                                          <<03573>>04510000
     UNTIL ( (BENTRY'(LID) = NEWENTRY(LID), (8))  LAND         <<03573>>04512000
             (0 <= INTEGER(ENTRY'(TYP))  <= 3) )  OR           <<03573>>04514000
             (I := I + 1) >= MAX;                              <<03573>>04516000
   IF I >= MAX THEN                                            <<01844>>04518000
   BEGIN                                   <<NOT THERE, GOOD>>          04520000
      <<FIND A FREE ENTRY>>                                             04522000
      I:=0;                                                             04524000
      DO                                                                04526000
      BEGIN                                                             04528000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,EBASE+I*LIDESIZE,LIDESIZE);<<03574>>04530000
      END UNTIL ENTRY'(TYP) = NULL OR (I:=I+1) >= MAX;         <<01844>>04534000
      IF I >= MAX THEN                                         <<01844>>04536000
      BEGIN                                      <<NONE FREE>>          04538000
         CC:=CCL;                                                       04540000
         RETURN;                                                        04542000
      END;                                                              04544000
      << OK -- build entry and add to table >>                 <<03573>>04546000
      WHO(,,,NEWENTRY(UNAME),,NEWENTRY(UACCT));                <<03573>>04550000
     MOVE'TO'DSEG(LIDDST,EBASE+I*LIDESIZE,@NEWENTRY',LIDESIZE);<<03574>>04554000
   END                                                                  04558000
   ELSE                                                                 04560000
   BEGIN                                                                04562000
      CC:=CCG;                                                          04564000
      RETURN;                                                           04566000
   END;                                                                 04568000
   WRITEDSEG(LIDDST);                                                   04570000
   CC:=CCE;                                                             04572000
END;                                                                    04574000
$PAGE                                                          <<04162>>04576000
LOGICAL PROCEDURE COMPSTRING(STRING1,STRING2,MAXLEN);          <<01389>>04578000
VALUE MAXLEN;                                                  <<01389>>04580000
INTEGER MAXLEN;                                                <<01389>>04582000
BYTE ARRAY STRING1;                                            <<01389>>04584000
BYTE ARRAY STRING2;                                            <<01389>>04586000
OPTION INTERNAL;                                               <<04889>>04588000
                                                               <<04889>>04590000
BEGIN                                                          <<01389>>04592000
   BYTE BYTE1,BYTE2;                                           <<01389>>04594000
   INTEGER LEN1,LEN2;                                          <<01389>>04596000
   BYTE POINTER BPS0 = S-0;                                    <<01389>>04598000
                                                               <<04889>>04600000
                                                               <<04889>>04602000
   BYTE1:=STRING1(MAXLEN);                                     <<01389>>04604000
   BYTE2:=STRING2(MAXLEN);                                     <<01389>>04606000
   STRING1(MAXLEN) := " ";                                     <<04889>>04608000
   STRING2(MAXLEN) := " ";                                    <<<04889>>04610000
   MOVE STRING1:=STRING1 WHILE AN,0;                           <<01389>>04612000
   LEN1:=@BPS0-@STRING1;                                       <<01389>>04614000
   MOVE STRING2:=STRING2 WHILE AN,0;                           <<01389>>04616000
   LEN2:=@BPS0-@STRING2;                                       <<01389>>04618000
   STRING1(MAXLEN):=BYTE1;                                     <<01389>>04620000
   STRING2(MAXLEN):=BYTE2;                                     <<01389>>04622000
   IF (STRING1 <> STRING2,(LEN1) ) OR (LEN1 <> LEN2) THEN      <<01389>>04624000
   COMPSTRING:=FALSE ELSE COMPSTRING:=TRUE;                    <<01389>>04626000
END;                                                           <<01389>>04628000
$TITLE        "USER LOGGING CI INTERFACE"                               04630000
$PAGE                                                          <<04162>>04632000
                                                                        04634000
PROCEDURE CXGETLOG(PARMSP,ERRNUM,PARMNUM);                              04636000
BYTE ARRAY PARMSP;                                                      04638000
INTEGER ERRNUM;                                                         04640000
INTEGER PARMNUM;                                                        04642000
OPTION PRIVILEGED,UNCALLABLE;                                           04644000
                                                                        04646000
                                                               <<03573>>04648000
<<    This procedure is the command executor for the         >><<03573>>04650000
<<    :GETLOG command.                                       >><<03573>>04652000
<<    Syntax is:                                             >><<03573>>04654000
<<        :GETLOG logid;LOG=logfile,{DISC/TAPE/SDISC/CTAPE}  >><<03577>>04656000
<<                [;PASS=password]                           >><<03573>>04658000
                                                               <<03573>>04660000
                                                                        04662000
BEGIN                                                                   04664000
DEFINE                                                         <<04162>>04668000
   SEMI  = ";" #;                                              <<04162>>04670000
                                                                        04672000
   BYTE POINTER  PARMPTR,DELIMPTR;                             <<04162>>04674000
   INTEGER LEN,I;                                                       04676000
   LOGICAL TEST;                                                        04678000
   LOGICAL LOGF;      <<true if LOG keyword found>>            <<03573>>04680000
   LOGICAL PASSF;     <<true if PASS keyword found>>           <<03573>>04682000
   BYTE ARRAY STOPPER(0:1) = Q;                                         04690000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<03575>>04694000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      04696000
                                                               <<03573>>04698000
   BYTE ARRAY KEYLISTP(*) = PB :=                              <<03573>>04700000
               5,3,"LOG",                                      <<03573>>04702000
               6,4,"PASS",                                     <<03573>>04704000
               0;                                              <<03573>>04706000
   BYTE ARRAY KEYLIST(0:11);                                   <<03573>>04708000
                                                               <<03573>>04710000
   LOGF := PASSF := FALSE;                                     <<03573>>04712000
   PARMNUM := 0;                                               <<03573>>04714000
   TEST.(0:8):=%15;  TEST.(8:8):=%12;   STOPPER:=0; STOPPER(1):=0;      04716000
   ENTRY':="  ";                                                        04718000
   MOVE ENTRY'(1):=ENTRY',(LIDESIZE-1);                                 04720000
   MOVE KEYLIST := KEYLISTP, (12);                             <<03573>>04722000
                                                               <<03573>>04724000
   SCAN PARMSP UNTIL TEST,1;                                            04726000
   MOVE * := STOPPER ,(1);                                     <<03573>>04730000
   UPSHIFT'(PARMSP);                                                    04732000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              04734000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)                <<04162>>04736000
      THEN RETURN;                                             <<03573>>04738000
   PARMNUM := PARMNUM + 1;                                     <<03573>>04740000
   MOVE BENTRY'(LID) := PARMPTR, (LEN);                        <<03573>>04742000
                                                               <<03573>>04744000
   DO                                                          <<03573>>04746000
     BEGIN                                                     <<03573>>04748000
        IF DELIMPTR <> SEMI THEN                               <<03573>>04750000
        BEGIN                                                  <<03573>>04752000
           ERRNUM := EXPECTEDSEMI;                             <<03573>>04754000
           CIERR(ERRNUM,DELIMPTR);                             <<03573>>04756000
           RETURN;                                             <<03573>>04758000
        END;                                                   <<03573>>04760000
                                                               <<03573>>04762000
        LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);            <<03573>>04764000
        I := SEARCH(PARMPTR,LEN,KEYLIST);                      <<03573>>04766000
        CASE I  OF                                             <<03573>>04768000
        BEGIN                                                  <<03573>>04770000
           BEGIN             <<not found>>                     <<03573>>04772000
              IF PARMNUM >= 3 THEN                             <<03573>>04774000
              BEGIN          <<all parms found - error>>       <<03573>>04776000
                 ERRNUM := EXTRAPARM;                          <<03573>>04778000
                 CIERR(ERRNUM,PARMPTR);                        <<03573>>04780000
                 RETURN;                                       <<03573>>04782000
              END;                                             <<03573>>04784000
              ERRNUM := INVALIDPARM;  <<expected           >>  <<03573>>04786000
              CIERR(ERRNUM,PARMPTR);  <<  "PASS" OR "LOG"  >>  <<03573>>04788000
              RETURN;                                          <<03573>>04790000
           END;              <<not found>>                     <<03573>>04792000
                                                               <<03573>>04794000
           BEGIN                  <<"LOG">>                    <<03573>>04796000
              IF NOT PARSELOG(PARMPTR,DELIMPTR,ENTRY',LOGF,    <<03573>>04798000
                               ERRNUM)    THEN RETURN;         <<03573>>04800000
              PARMNUM := PARMNUM + 1;                          <<03573>>04802000
           END;                   <<"LOG">>                    <<03573>>04804000
                                                               <<03573>>04806000
           BEGIN                  <<"PASS">>                   <<03573>>04808000
              IF NOT PARSEPASS(PARMPTR,DELIMPTR,BENTRY',PASSF, <<03573>>04810000
                               ERRNUM)    THEN RETURN;         <<03573>>04812000
              PARMNUM := PARMNUM + 1;                          <<03573>>04814000
           END;                   <<"PASS">>                   <<03573>>04816000
                                                               <<03573>>04818000
        END;                 <<case>>                          <<03573>>04820000
                                                               <<03573>>04822000
     END                                                       <<03573>>04824000
   UNTIL DELIMPTR = STOPPER;                                   <<03573>>04826000
                                                                        04830000
   IF LOGF THEN                                                         04832000
   BEGIN                                                                04834000
      AENTRY(ENTRY');                                          <<03573>>04836000
      IF > THEN                                                         04838000
      BEGIN                                                             04840000
         ERRNUM:=DUPLICATE;                      <<DUP ENTRY>>          04842000
         CIERR(ERRNUM,PARMSP);                                          04846000
         RETURN;                                                        04848000
      END;                                                              04850000
      IF < THEN                                                         04852000
      BEGIN      <<MAX NUMBER LOGID'S EXCEEDED>>                        04854000
         ERRNUM:=MAXEXCEEDED;                                           04856000
         CIERR(ERRNUM,PARMSP);                                          04860000
         RETURN;                                                        04862000
      END;                                                              04864000
   END                                                                  04866000
END;                                                                    04870000
                                                                        04872000
                                                                        04874000
$PAGE                                                          <<04162>>04876000
PROCEDURE CXRELLOG(PARMSP,ERRNUM,PARMNUM);                              04878000
BYTE ARRAY PARMSP;                                                      04880000
INTEGER ERRNUM;                                                         04882000
INTEGER PARMNUM;                                                        04884000
OPTION PRIVILEGED,UNCALLABLE;                                           04886000
                                                                        04888000
                                                               <<03573>>04890000
<<    This procedure is the command executor for the         >><<03573>>04892000
<<    :RELLOG command.                                       >><<03573>>04894000
<<    Syntax is:                                             >><<03573>>04896000
<<        :RELLOG logid                                      >><<03573>>04898000
                                                                        04900000
                                                                        04902000
BEGIN                                                                   04904000
                                                               <<03573>>04906000
                                                                        04910000
                                                                        04912000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>04914000
   INTEGER LEN,DUMMY;                                          <<04162>>04918000
   BYTE ARRAY STOPPER(0:1) = Q;  LOGICAL TEST;                          04920000
                                                               <<03575>>04924000
                                                               <<03575>>04926000
   TEST.(0:8):=%15;  TEST.(8:8):=%15; STOPPER:=0; STOPPER(1):=0;        04928000
   SCAN PARMSP UNTIL TEST,1;                                            04930000
   MOVE * := STOPPER, (1);                                     <<03573>>04934000
   UPSHIFT'(PARMSP);                                                    04936000
   PARMNUM:=0;                                                          04938000
                                                               <<03573>>04940000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              04942000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)                <<04162>>04944000
      THEN RETURN;                                             <<03573>>04946000
                                                               <<03573>>04948000
   PARMNUM := PARMNUM + 1;                                     <<03573>>04950000
   IF DELIMPTR <> STOPPER THEN                                 <<03573>>04954000
   BEGIN                                                       <<03573>>04956000
      ERRNUM := ONEPARM;                                       <<03573>>04958000
      CIERR(ERRNUM,DELIMPTR);                                  <<03573>>04960000
      RETURN;                                                  <<03573>>04962000
   END;                                                        <<03573>>04964000
                                                               <<03573>>04966000
                                                               <<03573>>04968000
   << Check if there is an active process for this logid. >>   <<04162>>04972000
                                                               <<04162>>04974000
   IF FINDLOG(PARMPTR,DUMMY)  THEN                             <<04162>>04976000
   BEGIN         << Active process >>                          <<04162>>04978000
      ERRNUM := -BUSY;                                         <<04162>>04980000
      CIERR(ERRNUM,PARMSP);                                    <<04162>>04982000
      RETURN;                                                  <<04162>>04984000
   END;                                                        <<04162>>04986000
                                                               <<04162>>04988000
   << Try to delete the entry from the LID table >>            <<04162>>04990000
                                                               <<04162>>04992000
   DENTRY(PARMPTR,LEN);                                        <<04162>>04994000
   IF > THEN                                                   <<04162>>04996000
   BEGIN        << Not the creator >>                          <<04162>>04998000
      ERRNUM := SECURITYVIOL;                                  <<04162>>05000000
      CIERR(ERRNUM,PARMSP);                                    <<04162>>05002000
      RETURN;                                                  <<04162>>05004000
   END                                                         <<04162>>05006000
   ELSE                                                        <<04162>>05008000
      IF < THEN                                                <<04162>>05010000
      BEGIN     << Logid not found in LID table >>             <<04162>>05012000
         ERRNUM := -NIXLOGID;                                  <<04162>>05014000
         CIERR(ERRNUM,PARMSP);                                 <<04162>>05016000
         RETURN;                                               <<04162>>05018000
      END;                                                     <<04162>>05020000
                                                               <<04162>>05022000
   << If we get this far, the entry has been released  >>      <<04162>>05024000
                                                               <<04162>>05026000
END;         << CXRELLOG >>                                    <<04162>>05028000
                                                                        05030000
                                                                        05032000
                                                                        05034000
                                                                        05036000
                                                                        05038000
$PAGE                                                          <<04162>>05040000
PROCEDURE CXALTLOG(PARMSP,ERRNUM,PARMNUM);                              05042000
BYTE ARRAY PARMSP;                                                      05044000
INTEGER ERRNUM;                                                         05046000
INTEGER PARMNUM;                                                        05048000
OPTION PRIVILEGED,UNCALLABLE;                                           05050000
                                                                        05052000
                                                                        05054000
                                                               <<03573>>05056000
<<     This procedure is the command executor for the        >><<03573>>05058000
<<     :ALTLOG command.                                      >><<03573>>05060000
<<     Syntax is:                                            >><<03573>>05062000
<<      :ALTLOG logid [;LOG=logfile,{DISC/TAPE/SDISC/CTAPE}] >><<03577>>05064000
<<                 [;PASS=password]                          >><<03573>>05066000
                                                                        05068000
BEGIN                                                                   05070000
   DEFINE                                                      <<04162>>05072000
      SEMI  =  ";"#;                                           <<04162>>05074000
                                                                        05078000
                                                                        05080000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>05082000
   LOGICAL                                                     <<03573>>05086000
      LOGF,             <<true if ;LOG= found>>                <<03573>>05088000
      PASSF;            <<true if ;PASS= found>>               <<03573>>05090000
   INTEGER LEN,I,MAX,LIDLENGTH;                                         05092000
   BYTE ARRAY STOPPER(0:1) = Q; LOGICAL TEST;                           05096000
   BYTE ARRAY CACCT(0:7) = Q;                                           05100000
   BYTE ARRAY CGROUP(0:7) = Q;                                 <<01389>>05102000
   BYTE ARRAY CUSER(0:7) = Q;                                           05104000
   LOGICAL ARRAY ENTRY'(0:LIDESIZE-1) = Q;                     <<03575>>05106000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      05108000
                                                               <<03573>>05112000
   BYTE ARRAY KEYLISTP(*) = PB :=                              <<03573>>05114000
            5,3,"LOG",                                         <<03573>>05116000
            6,4,"PASS",                                        <<03573>>05118000
            0;                                                 <<03573>>05120000
   EQUATE   DICTLEN = 12;                                      <<03573>>05122000
   BYTE ARRAY KEYLIST(0:DICTLEN-1);                            <<03573>>05124000
                                                               <<03573>>05126000
                                                               <<03573>>05128000
   MOVE KEYLIST := KEYLISTP, (DICTLEN);                        <<03573>>05130000
   LOGF := PASSF := FALSE;                                     <<03573>>05132000
                                                               <<03575>>05134000
   TEST.(0:8):=%15;  TEST.(8:8):=%15; STOPPER:=0; STOPPER(1):=0;        05136000
   SCAN PARMSP UNTIL TEST,1;                                            05138000
   MOVE * := STOPPER, (1);                                     <<03573>>05142000
   UPSHIFT'(PARMSP);                                                    05144000
   PARMNUM:=0;                                                          05146000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              05148000
   IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)                <<04162>>05150000
      THEN RETURN;                                             <<03573>>05152000
                                                               <<03573>>05154000
   PARMNUM:=PARMNUM+1;                                                  05158000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<03574>>05160000
                                                                        05164000
   I:=0;                                                                05166000
   DO                                                                   05168000
   BEGIN                     <<SEARCH FOR LOGGING IDENTIFIER>>          05170000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,EBASE+I*LIDESIZE,LIDESIZE);<<03574>>05172000
      IF BENTRY'(LID+7) <> " " THEN LIDLENGTH:=8                        05176000
      ELSE                                                              05178000
      BEGIN                                                             05180000
         <<get length of logid parm>>                          <<03573>>05182000
         MOVE BENTRY'(LID):=BENTRY'(LID) WHILE AN,0;                    05184000
         LIDLENGTH:=TOS-@BENTRY'(LID);                                  05186000
      END;                                                              05188000
   END UNTIL (BENTRY'(LID) = PARMPTR,(LEN)) AND (LIDLENGTH = LEN)       05190000
   OR (I:=I+1) >= MAX;                                         <<03573>>05192000
   IF I >= MAX THEN                                            <<03573>>05194000
   BEGIN                                                                05196000
      ERRNUM:=NIXLOGID;                                                 05198000
      CIERR(ERRNUM,PARMPTR);                                            05202000
      RETURN;                                                           05204000
   END;                                                                 05206000
   IF FINDLOG(BENTRY'(LID),I) THEN                                      05208000
   BEGIN                                                                05210000
      ERRNUM:=BUSY;                                                     05212000
      CIERR(ERRNUM,PARMPTR);                                            05216000
      RETURN;                                                           05218000
   END;                                                                 05220000
   MOVE CACCT:="  ";                                                    05222000
   MOVE CACCT(1):=CACCT,(23);                                  <<01389>>05224000
   WHO(,,,CUSER,CGROUP,CACCT);                                 <<01389>>05226000
IF BENTRY'(UNAME) <> CUSER,(8) OR BENTRY'(UACCT) <> CACCT,(8) THEN      05228000
   BEGIN                                                                05230000
      ERRNUM:=SECURITYVIOL;             <<SECURITY VIOLATION>>          05232000
      CIERR(ERRNUM,PARMPTR);                                            05236000
      RETURN;                                                           05238000
   END;                                                                 05240000
                                                               <<03573>>05242000
   DO                                                                   05246000
   BEGIN                                                                05248000
      IF DELIMPTR <> SEMI THEN                                 <<03573>>05250000
      BEGIN                                                    <<03573>>05252000
         <<invalid delimiter between keywords>>                <<03573>>05254000
         ERRNUM := EXPECTEDSEMI;                               <<03573>>05256000
         CIERR(ERRNUM,DELIMPTR);                               <<03573>>05258000
         RETURN;                                               <<03573>>05260000
      END;                                                     <<03573>>05262000
                                                               <<03573>>05264000
      LEN:=NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                         05266000
      I := SEARCH(PARMPTR,LEN,KEYLIST);                        <<03573>>05268000
      CASE I OF                                                <<03573>>05270000
      BEGIN                                                    <<03573>>05272000
         BEGIN               <<not found>>                     <<03573>>05274000
            IF PARMNUM >= 3 THEN                               <<03573>>05276000
            BEGIN            <<all found - error>>             <<03573>>05278000
               ERRNUM := EXTRAPARM;                            <<03573>>05280000
               CIERR(ERRNUM,PARMPTR);                          <<03573>>05282000
               RETURN;                                         <<03573>>05284000
            END;                                               <<03573>>05286000
            ERRNUM := INVALIDPARM;  <<expected             >>  <<03573>>05288000
            CIERR(ERRNUM,PARMPTR);  <<  "PASS" OR "LOG"    >>  <<03573>>05290000
            RETURN;                                            <<03573>>05292000
         END;                <<not found>>                     <<03573>>05294000
                                                               <<03573>>05296000
         BEGIN                    <<"LOG">>                    <<03573>>05298000
           IF NOT PARSELOG(PARMPTR,DELIMPTR,ENTRY',LOGF,ERRNUM)<<03573>>05300000
              THEN RETURN;                                     <<03573>>05302000
           PARMNUM := PARMNUM + 1;                             <<03573>>05304000
         END;                     <<"LOG">>                    <<03573>>05306000
                                                               <<03573>>05308000
         BEGIN                    <<"PASS">>                   <<03573>>05310000
        IF NOT PARSEPASS(PARMPTR,DELIMPTR,BENTRY',PASSF,ERRNUM)<<03573>>05312000
          THEN RETURN;                                         <<03573>>05314000
        PARMNUM := PARMNUM + 1;                                <<03573>>05316000
         END;                     <<"PASS">>                   <<03573>>05318000
                                                               <<03573>>05320000
      END;         << Case >>                                  <<03573>>05322000
                                                               <<03573>>05324000
   END                                                         <<03573>>05326000
  UNTIL DELIMPTR = STOPPER;                                    <<03573>>05328000
                                                               <<03573>>05330000
   DENTRY(BENTRY',LIDLENGTH);                                  <<04162>>05334000
   AENTRY(ENTRY');                                             <<03573>>05336000
   IF <> THEN                                                           05338000
   BEGIN                                                                05340000
      ERRNUM:=DUPLICATE;                         <<DUP ENTRY>>          05342000
      CIERR(ERRNUM,PARMPTR);                                            05346000
      RETURN;                                                           05348000
   END;                                                                 05350000
END;                                                                    05354000
                                                                        05356000
                                                                        05358000
                                                                        05360000
                                                                        05362000
$PAGE                                                          <<04162>>05364000
PROCEDURE CXLISTLOG(PARMSP,ERRNUM,PARMNUM);                             05366000
BYTE ARRAY PARMSP;                                                      05368000
INTEGER ERRNUM;                                                         05370000
INTEGER PARMNUM;                                                        05372000
OPTION PRIVILEGED,UNCALLABLE;                                           05374000
                                                                        05376000
                                                                        05378000
                                                               <<03573>>05380000
<<    This procedure is the command executor for the         >><<03573>>05382000
<<    :LISTLOG command.                                      >><<03573>>05384000
<<    Syntax is :                                            >><<03573>>05386000
<<        :LISTLOG  [logid [;pass]]                          >><<03573>>05388000
                                                                        05390000
                                                                        05392000
BEGIN                                                                   05394000
   DEFINE                                                      <<04162>>05396000
      SEMI  =  ";"#;                                           <<04162>>05398000
                                                                        05402000
   BYTE ARRAY HEADER(*) = PB :=                                <<04162>>05404000
   8(" "),"LOGID",14(" "),"CREATOR",14(" "),"LOGFILE";         <<03573>>05406000
   INTEGER I,MAX,LEN;                                                   05408000
   LOGICAL TEST;  BYTE ARRAY STOPPER(0:1) = Q;                          05410000
   LOGICAL CREATOR;                                                     05412000
   BYTE POINTER BPS0 = S;                                               05414000
   LOGICAL FIRST;                                                       05418000
   BYTE POINTER FILPTR,LIDPTR;                                          05420000
BYTE POINTER  PARMPTR,DELIMPTR;                                <<03573>>05422000
   BYTE ARRAY CUSER(0:8) = Q;                                           05424000
   BYTE ARRAY CACCT(0:8) = Q;                                           05426000
   LOGICAL ARRAY ENTRY'(0:TENTRYSIZE-1) = Q;                   <<03575>>05428000
   INTEGER ARRAY IENTRY'(*) = ENTRY';                          <<04162>>05430000
   BYTE ARRAY BENTRY'(*) = ENTRY';                                      05432000
   LOGICAL ARRAY OUTREC'(0:35) = Q;                                     05434000
   BYTE ARRAY BOUTREC'(*) = OUTREC';                                    05436000
   LOGICAL ARRAY OUTREC(0:71) = Q;                                      05438000
   BYTE ARRAY BOUTREC(*) = OUTREC;                                      05440000
   EQUATE                                                               05442000
   ID      =      4,                                           <<03573>>05444000
   CRE     =      23,                                          <<03573>>05446000
   FILE    =      44;                                          <<03573>>05448000
                                                               <<03573>>05450000
                                                               <<03576>>05452000
                                                               <<03576>>05454000
LOGICAL SUBROUTINE VALID'ENTRY;                                <<03576>>05456000
BEGIN                                                          <<03576>>05458000
                                                               <<03576>>05460000
<< Checks the entry from the LIDTAB to see if valid info  >>   <<03576>>05462000
<< is really there before printing out.                   >>   <<03576>>05464000
                                                               <<03576>>05466000
   VALID'ENTRY := FALSE;                                       <<03576>>05468000
                                                               <<03576>>05470000
                                                               <<03576>>05472000
   IF BENTRY'(LID) <> ALPHA  OR  BENTRY'(FNAME') <> ALPHA  OR  <<04889>>05474000
      BENTRY'(UNAME) <> ALPHA  OR  BENTRY'(UACCT) <> ALPHA  OR <<04162>>05476000
      IENTRY'(TYP) < 0  OR  IENTRY'(TYP) > 3  THEN RETURN;     <<04162>>05478000
                                                               <<03576>>05482000
   MOVE BENTRY'(LID) := BENTRY'(LID)  WHILE AN,1;              <<03576>>05484000
   LEN := TOS - @BENTRY';                                      <<03576>>05486000
   IF  LEN < 8  AND  BENTRY'(LEN) <> " "   THEN RETURN;        <<03576>>05488000
                                                               <<03576>>05490000
   MOVE BENTRY'(UNAME) := BENTRY'(UNAME) WHILE AN,1;           <<04162>>05492000
   LEN := TOS - @BENTRY';                                      <<04162>>05494000
   IF LEN < TYP  AND  BENTRY'(LEN) <> " "  THEN RETURN;        <<04162>>05496000
                                                               <<04162>>05498000
   << We've found no special characters (except blank) that  >><<03576>>05500000
   << would indicate that this is a garbage entry.  So set   >><<03576>>05502000
   << flag - this one can be printed out.                    >><<03576>>05504000
                                                               <<03576>>05506000
   VALID'ENTRY := TRUE;                                        <<03576>>05508000
                                                               <<03576>>05510000
END;                                                           <<03576>>05512000
                                                               <<03576>>05514000
                                                               <<03576>>05516000
                                                               <<03576>>05518000
   TEST.(0:8):=%15;  TEST.(8:8):=%15;   STOPPER:=0;  STOPPER(1):= 0;    05522000
   SCAN PARMSP UNTIL TEST,1;                                            05524000
   MOVE * := STOPPER, (1);                                     <<03573>>05528000
   MOVE CUSER(1):=CUSER,(17);                                           05530000
   UPSHIFT'(PARMSP);                                                    05534000
   MOVE'FROM'DSEG(@MAX,LIDDST,MENTRIES,1);                     <<03574>>05536000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              05540000
   IF LEN = 0 THEN                                                      05542000
   BEGIN                                                                05544000
      IF DELIMPTR <> STOPPER THEN                              <<03573>>05546000
      BEGIN                  <<should be no more parms>>       <<03573>>05548000
         ERRNUM := EXPECTEDLOGID;                              <<03573>>05550000
         CIERR(ERRNUM,DELIMPTR);                               <<03573>>05552000
         RETURN;                                               <<03573>>05554000
      END;                                                     <<03573>>05556000
   FIRST:=TRUE;                                                         05558000
   I:=1;                                                                05560000
   DO                                                                   05562000
   BEGIN                                                                05564000
      MOVE'FROM'DSEG(@ENTRY',LIDDST,I*LIDESIZE,LIDESIZE);      <<03574>>05566000
      IF ENTRY'(TYP) <> NULL THEN                                       05570000
      BEGIN                                                             05572000
      IF NOT VALID'ENTRY  THEN GO NEXT1;                       <<03576>>05574000
      IF FIRST THEN                                                     05576000
      BEGIN                                                             05578000
         MOVE OUTREC:="  ";                                             05580000
         MOVE OUTREC(1):=OUTREC,(36);                                   05582000
         PRINT(OUTREC,-7,0);                                   <<03573>>05584000
         MOVE BOUTREC:=HEADER,(55);                                     05586000
         PRINT(OUTREC,-55,0);                                  <<03573>>05588000
         MOVE OUTREC:="  ";                                             05590000
         MOVE OUTREC(1):=OUTREC,(36);                                   05592000
         PRINT(OUTREC,-7,0);                                   <<03573>>05594000
         FIRST:=FALSE;                                                  05596000
      END;                                                              05598000
         MOVE BOUTREC(ID):=BENTRY'(LID),(8);                            05600000
         IF BENTRY'(UNAME+7) <> " " THEN                                05602000
         MOVE BOUTREC(CRE):=BENTRY'(UNAME),(8),2                        05604000
         ELSE                                                           05606000
         MOVE BOUTREC(CRE):=BENTRY'(UNAME) WHILE AN,1;                  05608000
         MOVE *:=".",2;                                                 05610000
         MOVE *:=BENTRY'(UACCT) WHILE AN,1;                             05612000
         IF BENTRY'(FNAME'+7) <> " "                           <<04889>>05616000
            THEN MOVE BOUTREC(FILE) := BENTRY'(FNAME'), (8), 2 <<04889>>05618000
         ELSE MOVE BOUTREC(FILE) := BENTRY'(FNAME') WHILE AN,1;<<04889>>05620000
                                                               <<03573>>05622000
         IF ENTRY'(TYP) = DISC  THEN                           <<03573>>05624000
         BEGIN                                                 <<03573>>05626000
            << Get fully qualified disc file name >>           <<03573>>05628000
            MOVE BPS0 := ".",2;                                <<03573>>05630000
            IF BENTRY'(FGROUP+7) <> " "                        <<03573>>05632000
               THEN MOVE * := BENTRY'(FGROUP), (8), 2          <<03573>>05634000
            ELSE MOVE * := BENTRY'(FGROUP) WHILE AN,1;         <<03573>>05636000
                                                               <<03573>>05638000
            MOVE BPS0 := "." ,2;                               <<03573>>05640000
            IF BENTRY'(FACCT) <> " "                           <<03573>>05642000
               THEN MOVE * := BENTRY'(FACCT), (8), 2           <<03573>>05644000
            ELSE MOVE * := BENTRY'(FACCT) WHILE AN,1;          <<03573>>05646000
         END;   << Qualify the disc file name >>               <<03573>>05648000
                                                               <<03573>>05650000
         PRINT(OUTREC,-72,0);                                  <<03573>>05652000
         MOVE OUTREC:="  ";                                             05654000
         MOVE OUTREC(1):=OUTREC,(36);                                   05656000
NEXT1:                                                         <<03576>>05658000
      END;                                                              05660000
   END UNTIL (I:=I+1) > MAX;                                            05662000
   IF FIRST THEN                                                        05664000
   BEGIN                                                                05666000
      ERRNUM:=NOLOGID;                                                  05668000
      CIERR(ERRNUM);                                                    05672000
      RETURN;                                                           05674000
   END;                                                                 05676000
   END                                                                  05678000
   ELSE                                                                 05680000
     <<Parameter specified - only print that entry>>           <<03575>>05682000
   BEGIN                                                                05684000
      IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)             <<04162>>05686000
        THEN RETURN;                                           <<03573>>05688000
      PARMNUM := PARMNUM + 1;                                  <<03573>>05690000
                                                               <<03573>>05692000
      MOVE OUTREC:="  ";                                                05694000
      MOVE OUTREC(1):=OUTREC,(36);                                      05696000
      FENTRY(PARMPTR,,BOUTREC(FILE),BOUTREC(CRE),BOUTREC(CRE+9));       05698000
      IF <> THEN                                               <<03573>>05700000
      BEGIN                  <<not found>>                     <<03573>>05702000
         ERRNUM := NIXLOGID;                                   <<03573>>05704000
         CIERR(ERRNUM,PARMPTR);                                <<03573>>05706000
         RETURN;                                               <<03573>>05708000
      END                                                      <<03573>>05710000
      ELSE                                                     <<03573>>05712000
      BEGIN                  <<found in LIDTAB>>               <<03573>>05714000
      MOVE BOUTREC(FILE):=BOUTREC(FILE) WHILE AN,0;            <<01389>>05716000
      IF BPS0 = "/" THEN                                       <<01389>>05718000
      BEGIN                                                    <<01389>>05720000
         @BPS0:=@BPS0+1;                                       <<01389>>05722000
         ASSEMBLE(DUP);                                        <<01389>>05724000
         MOVE *:=*WHILE AN,0;                                  <<01389>>05726000
         ASSEMBLE(DEL);                                        <<01389>>05728000
      END;                                                     <<01389>>05730000
      IF BPS0 ="." THEN                                        <<01389>>05732000
      BEGIN                                                    <<01389>>05734000
         MOVE *:=*,(1),1;                                      <<01389>>05736000
         MOVE *:=* WHILE AN,0;                                 <<01389>>05738000
         IF BPS0 = "." THEN                                    <<01389>>05740000
         BEGIN                                                 <<01389>>05742000
            MOVE *:=*,(1),1;                                   <<01389>>05744000
            MOVE *:=* WHILE AN,1;                              <<01389>>05746000
            MOVE *:="        ";                                <<01389>>05748000
         END;                                                  <<01389>>05750000
      END                                                      <<01389>>05752000
      ELSE                                                     <<01389>>05754000
      BEGIN                                                    <<01389>>05756000
         ASSEMBLE(DEL);                                        <<01389>>05758000
         MOVE *:="        ";                                   <<01389>>05760000
      END;                                                     <<01389>>05762000
         WHO(,,,CUSER,,CACCT);                                          05764000
        IF CUSER <> BOUTREC(CRE),(8) OR CACCT <> BOUTREC(CRE+9),(8) THEN05766000
         CREATOR:=FALSE ELSE CREATOR:=TRUE;                             05768000
         @LIDPTR:=@PARMPTR;                                             05770000
         MOVE BOUTREC(CRE):=BOUTREC(CRE) WHILE AN,1;                    05772000
         MOVE *:=".",2;                                                 05774000
         MOVE *:=BOUTREC(CRE+9) WHILE AN,1;                             05776000
         @FILPTR:=@BPS0;                                                05778000
         MOVE FILPTR:=" ";                                              05780000
         MOVE FILPTR(1):=FILPTR,(@BOUTREC(FILE)-@FILPTR-1);             05782000
         MOVE BOUTREC(ID):=PARMPTR WHILE AN,1;                          05784000
         IF DELIMPTR <> STOPPER THEN                           <<03573>>05786000
         BEGIN                                                          05788000
            IF DELIMPTR <> SEMI THEN                           <<03573>>05790000
            BEGIN                                              <<03573>>05792000
               <<invalid delimiter between keywords>>          <<03573>>05794000
               ERRNUM := EXPECTEDSEMI;                         <<03573>>05796000
               CIERR(ERRNUM,DELIMPTR);                         <<03573>>05798000
               RETURN;                                         <<03573>>05800000
            END;                                               <<03573>>05802000
                                                               <<03573>>05804000
            LEN:=NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                   05806000
            IF LEN = 4 AND PARMPTR = "PASS" THEN                        05808000
            BEGIN                                                       05810000
               IF CREATOR THEN                                          05812000
               BEGIN                                                    05814000
                  LEN:=TOS-@BOUTREC(ID);                                05816000
                  MOVE BOUTREC(ID+LEN):="/";                            05818000
                  FENTRY(LIDPTR,BOUTREC(ID+LEN+1));                     05820000
               END                                                      05822000
               ELSE                                                     05824000
               BEGIN                                                    05826000
                  ERRNUM:=CREPARM;                                      05828000
                  CIERR(ERRNUM,PARMPTR);                                05830000
               END;                                                     05832000
            END                                                         05834000
            ELSE                                                        05836000
            BEGIN                                                       05838000
               <<only other valid keyword is PASS>>            <<03573>>05840000
               ERRNUM:=EXPASS;                                          05842000
               CIERR(ERRNUM,PARMPTR);                                   05844000
            END;                                                        05846000
         IF DELIMPTR <> STOPPER THEN                           <<03573>>05848000
         BEGIN                                                 <<03573>>05850000
            <<there should be no more parms>>                  <<03573>>05852000
            ERRNUM := EXTRAPARM;                               <<03573>>05854000
            CIERR(ERRNUM,DELIMPTR);                            <<03573>>05856000
            RETURN;                                            <<03573>>05858000
         END;                                                  <<03573>>05860000
                                                               <<03573>>05862000
         END;                                                           05864000
         MOVE OUTREC':="  ";                                            05866000
         MOVE OUTREC'(1):=OUTREC',(25);                                 05868000
         PRINT(OUTREC',-7,0);                                  <<03573>>05870000
         MOVE BOUTREC':=HEADER,(55);                                    05872000
         PRINT(OUTREC',-55,0);                                 <<03573>>05874000
         MOVE OUTREC':="  ";                                            05876000
         MOVE OUTREC'(1):=OUTREC',(34);                                 05878000
         PRINT(OUTREC',-7,0);                                  <<03573>>05880000
         PRINT(OUTREC,-72,0);                                  <<03573>>05882000
      END;                   <<found in LIDTAB>>               <<03573>>05884000
   END;                                                                 05888000
   PRINT(OUTREC,0,%60);     << Double space >>                <<<03573>>05892000
END;                                                                    05894000
                                                                        05896000
$PAGE                                                          <<04162>>05898000
PROCEDURE CXSHOWLOGSTATUS(PARMSP,ERRNUM,PARMNUM);                       05900000
BYTE ARRAY PARMSP;                                                      05902000
INTEGER ERRNUM;                                                         05904000
INTEGER PARMNUM;                                                        05906000
OPTION PRIVILEGED,UNCALLABLE;                                           05908000
                                                               <<03573>>05910000
<<    This procedure is the command executor for the         >><<03573>>05912000
<<    :SHOWLOGSTATUS command.                                >><<03573>>05914000
<<    Syntax is :                                            >><<03573>>05916000
<<        :SHOWLOGSTATUS  [logid]                            >><<03573>>05918000
                                                               <<03573>>05920000
                                                               <<03573>>05922000
BEGIN                                                                   05924000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>05926000
   EQUATE                                                               05932000
   NUSER   =   23,                                                      05934000
   ID      =   6,                                                       05936000
   RECORDS =   44,                                                      05938000
   STAT   =   30;                                                       05940000
   BYTE ARRAY HEADER(*) = PB :=6(" "),"LOGID",10(" "),"USERS", <<04162>>05942000
                             4(" "),"STATE",8(" "),"RECORDS";  <<04162>>05944000
   LOGICAL ARRAY WOUTREC(0:39) = Q;                            <<03573>>05946000
   BYTE ARRAY OUTREC(*) = WOUTREC;                             <<03573>>05948000
   BYTE ARRAY STOPPER(0:1) = Q;                                         05950000
   LOGICAL  TEST,CRSTATE;                                               05952000
   INTEGER TABINDEX,STAT',DB,LEN,USERS,I;                      <<04162>>05954000
   DOUBLE NUMREC;                                                       05956000
   LOGICAL A,FIRST;                                            <<04889>>05958000
                                                               <<03575>>05964000
   TEST.(0:8):=%15;  TEST.(8:8):=%15;                                   05966000
   STOPPER:=0;   STOPPER(1):=0;                                         05968000
   SCAN PARMSP UNTIL TEST,1;                                            05970000
   MOVE  * := STOPPER, (1);                                    <<03573>>05974000
   UPSHIFT'(PARMSP);                                                    05976000
   CRSTATE:=SETCRITICAL;                                                05980000
   LEN:=FINDPARM(PARMSP,PARMPTR,DELIMPTR);                              05982000
   IF LEN = 0 THEN                                                      05984000
   BEGIN                                                                05986000
      IF DELIMPTR <> STOPPER THEN                              <<03573>>05988000
      BEGIN                                                    <<03573>>05990000
         RESETCRITICAL(CRSTATE);                               <<03573>>05992000
         ERRNUM := EXPECTEDLOGID;                              <<03573>>05994000
         CIERR(ERRNUM,PARMPTR);                                <<03573>>05996000
         RETURN;                                               <<03573>>05998000
      END;                                                     <<03573>>06000000
                                                               <<03573>>06002000
   FIRST:=TRUE;                                                         06004000
      TOS:=EXCHANGEDB(LOGDST);                                          06006000
      A:=GETSIR(LOGSIR);                                                06008000
      TABINDEX:=LOGTAB(INUSE);                                          06010000
      WHILE (TABINDEX <> NULL) AND (TABINDEX <> "  ") DO       <<03573>>06012000
      BEGIN                                                             06014000
         IF (BLOGTAB(LGNAME) <> ALPHA) OR (LOGTAB(DST) = NULL) <<04891>>06016000
           THEN GO AROUND;                                     <<03573>>06018000
         IF FIRST THEN                                                  06020000
         BEGIN                                                          06022000
            TOS:=EXCHANGEDB(0);                                         06024000
            PRINT(WOUTREC,0,0);                                <<03573>>06026000
            MOVE OUTREC:=HEADER,(50);                                   06028000
            PRINT(WOUTREC,-50,0);                              <<03573>>06030000
            MOVE OUTREC:="  ";                                          06032000
            MOVE OUTREC(1):=OUTREC,(59);                                06034000
            PRINT(WOUTREC,-10,0);                              <<03573>>06036000
            FIRST:=FALSE;                                               06038000
            TOS:=EXCHANGEDB(LOGDST);                                    06040000
         END;                                                           06042000
         I:=0;                                                          06044000
         DO                                                             06046000
         BEGIN                                                          06048000
            OUTREC(ID+I):=BLOGTAB(LGNAME+I);                            06050000
         END UNTIL(I:=I+1) >=8;                                         06052000
                                                               <<04164>>06054000
         STAT' := LOGTAB(STATUS);                              <<04164>>06056000
         IF STAT' = RECOVERING  OR  STAT' = INITIALIZING  THEN <<04164>>06058000
         BEGIN                                                          06060000
            DB:=EXCHANGEDB(0);                                          06062000
            IF STAT' = RECOVERING                              <<04164>>06064000
               THEN MOVE OUTREC(STAT):= "RECOVERING"           <<04164>>06066000
            ELSE MOVE OUTREC(STAT) := "INITIALIZING";          <<04164>>06068000
                                                               <<04164>>06070000
            PRINT(WOUTREC,-60,0);                              <<03573>>06072000
            MOVE OUTREC:=" ";                                           06074000
            MOVE OUTREC(1):=OUTREC,(59);                                06076000
            DB:=EXCHANGEDB(LOGDST);                                     06078000
         END                                                            06080000
         ELSE                                                           06082000
         BEGIN                                                          06084000
         IF LOGTAB(DST) = NULL  THEN GO AROUND;                <<04891>>06088000
         EXCHANGEDB(LOGTAB(DST));                              <<04891>>06090000
                                                               <<01389>>06092000
         TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                          06094000
         DEL;                                                           06096000
                                                               <<01389>>06098000
         NUMREC:=DLOGBUFF(TRECS);                                       06100000
         USERS:=LOGBUFF(NUMUSER);                                       06102000
         STAT':=LOGBUFF(STATE);                                         06104000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                            06106000
         TOS:=EXCHANGEDB(0);                                            06108000
         LEN:=DASCII(NUMREC,10,OUTREC(RECORDS));                        06110000
         ASCII(USERS,10,OUTREC(NUSER));                                 06112000
         IF STAT' = 1 THEN MOVE OUTREC(STAT):="ACT" ELSE                06114000
         MOVE OUTREC(STAT):="INACT";                                    06116000
         PRINT(WOUTREC,-60,0);                                 <<03573>>06118000
         MOVE OUTREC:="  ";                                             06120000
         MOVE OUTREC(1):=OUTREC,(59);                                   06122000
         TOS:=EXCHANGEDB(LOGDST);                                       06124000
         END;                                                           06126000
AROUND:                                                        <<01389>>06128000
         TABINDEX:=LOGTAB(NEXT);                                        06130000
      END;                                                              06132000
                                                               <<01389>>06134000
                                                               <<03573>>06138000
      RELSIR(LOGSIR,A);                                                 06140000
      TOS:=EXCHANGEDB(0);                                               06142000
      IF FIRST THEN                                                     06144000
      BEGIN                                                             06146000
         ERRNUM:=-NOLOGPROCRUN;                                         06148000
         CIERR(ERRNUM);                                                 06150000
         RESETCRITICAL(CRSTATE);                                        06154000
         RETURN;                                                        06156000
      END;                                                              06158000
   END                                                                  06160000
   ELSE                                                                 06162000
                                                                        06164000
   BEGIN                               <<ONLY ONE LOGGING ID>>          06166000
      IF NOT PARSELOGID(PARMSP,PARMPTR,LEN,ERRNUM)             <<04162>>06168000
         THEN RETURN;                                          <<03573>>06170000
                                                               <<03573>>06172000
      PARMNUM := PARMNUM + 1;                                  <<03573>>06174000
                                                               <<03573>>06176000
      IF DELIMPTR <> STOPPER THEN                              <<03573>>06178000
      BEGIN                                                    <<03573>>06180000
         RESETCRITICAL(CRSTATE);                               <<03573>>06182000
         ERRNUM := ONEPARM;                                    <<03573>>06184000
         CIERR(ERRNUM,DELIMPTR);                               <<03573>>06186000
         RETURN;                                               <<03573>>06188000
      END;                                                     <<03573>>06190000
                                                               <<03573>>06192000
      A := GETSIR(LOGSIR);                                     <<02058>>06194000
      IF FINDLOG(PARMPTR,TABINDEX) THEN                                 06196000
      BEGIN                                                             06198000
         MOVE OUTREC:=HEADER,(50);                                      06200000
         PRINT(WOUTREC,-50,0);                                 <<03573>>06202000
         MOVE OUTREC:="  ";                                             06204000
         MOVE OUTREC(1):=OUTREC,(59);                                   06206000
         PRINT(WOUTREC,-10,0);                                 <<03573>>06208000
         I:=0;                                                          06210000
         DB:=EXCHANGEDB(LOGDST);                                        06212000
         DO OUTREC(ID+I):=BLOGTAB(LGNAME+I) UNTIL (I:=I+1) >= 8;        06216000
                                                               <<04166>>06218000
         STAT' := LOGTAB(STATUS);                              <<04164>>06220000
         IF STAT' = RECOVERING  OR  STAT' = INITIALIZING  THEN <<04164>>06222000
         BEGIN                                                 <<04166>>06224000
            EXCHANGEDB(0);                                     <<04166>>06226000
            IF STAT' = RECOVERING                              <<04164>>06228000
               THEN MOVE OUTREC(STAT) := "RECOVERING"          <<04164>>06230000
            ELSE MOVE OUTREC(STAT) := "INITIALIZING";          <<04164>>06232000
                                                               <<04164>>06234000
            PRINT(WOUTREC,-60,0);                              <<04166>>06236000
            RELSIR(LOGSIR,A);                                  <<04166>>06238000
            RESETCRITICAL(CRSTATE);                            <<04166>>06240000
            RETURN;                                            <<04166>>06242000
         END;                                                  <<04166>>06244000
                                                               <<04166>>06246000
         IF LOGTAB(DST) = NULL  THEN GO AROUND2;               <<04891>>06248000
         EXCHANGEDB(LOGTAB(DST));                              <<04891>>06250000
         TOS:=OBTAIN(DLOGBUFF(RESOURCE),NULL);                          06252000
         DEL;                                                           06254000
         NUMREC:=DLOGBUFF(TRECS);                                       06256000
         USERS:=LOGBUFF(NUMUSER);                                       06258000
         STAT':=LOGBUFF(STATE);                                         06260000
         RELEASE(DLOGBUFF(RESOURCE),NULL,1);                            06262000
         RELSIR(LOGSIR,A);                                              06264000
         TOS:=EXCHANGEDB(0);                                            06266000
         LEN:=DASCII(NUMREC,10,OUTREC(RECORDS));                        06268000
         ASCII(USERS,10,OUTREC(NUSER));                                 06270000
         IF STAT' = 1 THEN MOVE OUTREC(STAT):="ACT" ELSE                06272000
         MOVE OUTREC(STAT):="INACT";                                    06274000
         PRINT(WOUTREC,-60,0);                                 <<03573>>06276000
      END                                                               06278000
      ELSE                                                              06280000
      BEGIN                                                             06282000
                                                               <<04891>>06284000
AROUND2:                                                       <<04891>>06286000
                                                               <<04891>>06288000
         << Logid not found >>                                 <<03573>>06290000
         RELSIR(LOGSIR,A);                                     <<02058>>06292000
         RESETCRITICAL(CRSTATE);                               <<03573>>06294000
         ERRNUM:=LOGPROCNORUN;                                          06296000
         CIERR(ERRNUM,PARMPTR);                                         06300000
         RETURN;                                                        06304000
      END;                                                              06306000
   END;                                                                 06308000
   RESETCRITICAL(CRSTATE);                                              06312000
   PRINT(WOUTREC,0,%60);     << Double space >>                <<03573>>06314000
END;                                                                    06316000
$TITLE "PARSING UTILITIES"                                     <<03573>>06318000
$PAGE                                                          <<04162>>06320000
LOGICAL PROCEDURE PARSELOGID(PARMSP,PARMPTR,LEN,ERR);          <<04162>>06322000
   VALUE LEN;                                                  <<03573>>06324000
   BYTE ARRAY PARMSP;                                          <<03573>>06326000
   BYTE POINTER PARMPTR;                                       <<04162>>06328000
   INTEGER LEN,ERR;                                            <<03573>>06330000
   OPTION INTERNAL;                                            <<03573>>06332000
                                                               <<03573>>06334000
BEGIN                                                          <<03573>>06336000
                                                               <<03573>>06338000
<< Parses the LOGID parameter from the command image. On   >>  <<03573>>06340000
<< return:                                                 >>  <<03573>>06342000
<<     PARMPTR -> the logid                                >>  <<03573>>06344000
<<                                                         >>  <<03573>>06348000
                                                               <<03573>>06350000
   BYTE POINTER                                                <<03573>>06352000
     BPS0 = S-0,                                               <<03573>>06354000
     PT;                                                       <<03573>>06356000
                                                               <<03573>>06358000
                                                               <<03573>>06360000
   PARSELOGID := FALSE;                                        <<03573>>06362000
                                                               <<03573>>06364000
   IF LEN > 8 THEN                                             <<03573>>06366000
   BEGIN                     <<logid too long>>                <<03573>>06368000
      ERR := LOGIDLENGTH;                                      <<03573>>06370000
      CIERR(ERR,PARMSP);                                       <<03573>>06372000
      RETURN;                                                  <<03573>>06374000
   END;                                                        <<03573>>06376000
                                                               <<03573>>06378000
   IF LEN < 1 THEN                                             <<03573>>06380000
   BEGIN                     <<logid not found>>               <<03573>>06382000
      ERR := EXPECTEDLOGID;                                    <<03573>>06384000
      CIERR(ERR,PARMSP);                                       <<03573>>06386000
      RETURN;                                                  <<03573>>06388000
   END;                                                        <<03573>>06390000
                                                               <<03573>>06392000
   IF PARMPTR <> ALPHA THEN                                    <<03573>>06394000
   BEGIN                     <<must start with alpha. char.>>  <<03573>>06396000
      ERR := NOTALPHALOGID;                                    <<03573>>06398000
      CIERR(ERR,PARMPTR);                                      <<03573>>06400000
      RETURN;                                                  <<03573>>06402000
   END;                                                        <<03573>>06404000
                                                               <<03573>>06406000
   MOVE PARMPTR := PARMPTR WHILE AN, 0;                        <<03573>>06408000
   @PT := @BPS0;                                               <<03573>>06410000
   IF (@PT - @PARMPTR) <> LEN THEN                             <<03573>>06412000
   BEGIN                     <<special characters>>            <<03573>>06414000
      ERR := NOSPECHAR;                                        <<03573>>06416000
      CIERR(ERR,PT);                                           <<03573>>06418000
      RETURN;                                                  <<03573>>06420000
   END;                                                        <<03573>>06422000
                                                               <<03573>>06424000
   PARSELOGID := TRUE;                                         <<03573>>06426000
END;                                                           <<03573>>06428000
                                                               <<03573>>06430000
                                                               <<03573>>06432000
                                                               <<03573>>06434000
$PAGE                                                          <<04162>>06436000
LOGICAL PROCEDURE PARSELOG(PARMPTR,DELIMPTR,ENTRY',LOGF,ERR);  <<03573>>06438000
   BYTE POINTER PARMPTR,DELIMPTR;                              <<03573>>06440000
   ARRAY ENTRY';                                               <<03573>>06442000
   LOGICAL LOGF;                                               <<03573>>06444000
   INTEGER ERR;                                                <<03573>>06446000
   OPTION INTERNAL;                                            <<03573>>06448000
                                                               <<03573>>06450000
<<Parses the "LOG" parameter. Will return:                   >><<03573>>06452000
<<  LOGF = true if correct syntax found.                     >><<03573>>06454000
<<  ENTRY' = entry for the LIDTAB with the filename.         >><<03573>>06456000
<<  PARMPTR,DELIMPTR = ptrs to the parm and it's delimiter.  >><<03573>>06458000
                                                               <<03573>>06460000
BEGIN                                                          <<03573>>06462000
                                                               <<04162>>06464000
   DEFINE                                                      <<04162>>06466000
      FNAME'LEN    =   16#,   << # words in file entry >>      <<04162>>06468000
      NAME         =   FNAME'/2#, << Word index >>             <<04889>>06470000
      CLEAR'LOGFNAME=                                          <<04162>>06472000
           ENTRY'(NAME) := "  ";                               <<04162>>06474000
           MOVE ENTRY'(NAME+1) := ENTRY'(NAME),(FNAME'LEN-1)#; <<04162>>06476000
                                                               <<04162>>06478000
   EQUATE                                                      <<03573>>06480000
      EQ   = "=",                                              <<03573>>06482000
      COMMA = ",";                                             <<03573>>06484000
   BYTE ARRAY QUALNAME(0:35);    <<hold fully qualified fname>><<03573>>06486000
   BYTE POINTER                                                <<03573>>06488000
      PT,FILEPTR,GPPT,ACCPT,BPS0 = S-0;                        <<03573>>06490000
   INTEGER LEN,I;                                              <<03573>>06492000
   DOUBLE PDEF;              << Parms for call      >>         <<03573>>06494000
   LOGICAL DUMMY,EPTR;       <<   to CHECKFILENAME' >>         <<03573>>06496000
                                                               <<03573>>06498000
   LOGICAL ARRAY DEF(*) = PDEF;                                <<03573>>06500000
                                                               <<03573>>06502000
   << The value in EPTR (from CHECKFILENAME') is a byte     >> <<03573>>06504000
   << pointer to where the error was found.                 >> <<03573>>06506000
                                                               <<03573>>06508000
   BYTE POINTER ERRPTR = EPTR;                                 <<03573>>06510000
                                                               <<03573>>06512000
   BYTE ARRAY BENTRY'(*) = ENTRY';                             <<03573>>06514000
   BYTE ARRAY CGROUP(0:8);                                     <<03573>>06516000
   BYTE ARRAY TYPELISTP(*) = PB :=                             <<03573>>06518000
           6,4,"DISC",                                         <<03573>>06520000
           6,4,"TAPE",                                         <<03573>>06522000
           7,5,"SDISC",                                        <<03577>>06524000
           8,5,"CTAPE",                                        <<03577>>06526000
           0;                                                  <<03573>>06528000
EQUATE DICTLEN = 27;                                           <<03577>>06530000
   BYTE ARRAY TYPELIST(0:DICTLEN-1);                           <<03573>>06532000
                                                               <<03573>>06534000
   PARSELOG := FALSE;                                          <<03573>>06536000
   MOVE TYPELIST := TYPELISTP, (DICTLEN);                      <<03573>>06538000
                                                               <<03573>>06540000
   IF LOGF THEN                                                <<03573>>06542000
   BEGIN                     <<"LOG" already found>>           <<03573>>06544000
      ERR := DUPKEYWORD;                                       <<03573>>06546000
      CIERR(ERR,PARMPTR);                                      <<03573>>06548000
      RETURN;                                                  <<03573>>06550000
   END;                                                        <<03573>>06552000
                                                               <<03573>>06554000
   IF DELIMPTR <> EQ THEN                                      <<03573>>06556000
   BEGIN                                                       <<03573>>06558000
      ERR := EXPECTEDEQ;                                       <<03573>>06560000
      CIERR(ERR,DELIMPTR);                                     <<03573>>06562000
      RETURN;                                                  <<03573>>06564000
   END;                                                        <<03573>>06566000
                                                               <<03573>>06568000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<03573>>06570000
                                                               <<03573>>06572000
   DEF(0) := @PARMPTR;       << Make it look like parm >>      <<03573>>06574000
   DEF(1) := LEN;            <<  from MYCOMMAND        >>      <<03573>>06576000
                                                               <<03573>>06578000
   ERR := CHECKFILENAME'(PDEF,DUMMY,DUMMY,EPTR);               <<03573>>06580000
   IF < THEN                                                   <<03573>>06582000
   BEGIN                     << Syntax error >>                <<03573>>06584000
      CIERR(ERR,ERRPTR);                                       <<03573>>06586000
      RETURN;                                                  <<03573>>06588000
   END;                                                        <<03573>>06590000
   IF > THEN                                                   <<03573>>06592000
   BEGIN                << Back ref. file or sys file >>       <<03573>>06594000
      IF ERR = 0                                               <<03573>>06596000
         THEN  CIERR(ERR:=NOBACKREF,PARMPTR)                   <<03573>>06598000
      ELSE  CIERR(ERR:=NOSYSFILE,PARMPTR);                     <<03573>>06600000
      RETURN;                                                  <<03573>>06602000
   END;                                                        <<03573>>06604000
                                                               <<03573>>06606000
   @FILEPTR := @PARMPTR;                                       <<03573>>06608000
   IF DELIMPTR <> COMMA THEN                                   <<03573>>06610000
   BEGIN                                                       <<03573>>06612000
      ERR := EXPECTEDCOMMA;                                    <<03573>>06614000
      CIERR(ERR,DELIMPTR);                                     <<03573>>06616000
      RETURN;                                                  <<03573>>06618000
   END;                                                        <<03573>>06620000
                                                               <<03573>>06622000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<03573>>06624000
   I := SEARCH(PARMPTR,LEN,TYPELIST);                          <<03573>>06626000
   IF  I = 0  THEN                                             <<03573>>06628000
   BEGIN                     <<not found>>                     <<03573>>06630000
      ERR := ILLEGALTYPE;                                      <<03573>>06632000
      CIERR(ERR,PARMPTR);                                      <<03573>>06634000
      RETURN;                                                  <<03573>>06636000
   END                       <<not found>>                     <<03573>>06638000
                                                               <<03573>>06640000
   ELSE                                                        <<03573>>06642000
     IF I = 1  THEN                                            <<03573>>06644000
      BEGIN                  <<"DISC">>                        <<03573>>06646000
         CLEAR'LOGFNAME;                                       <<04162>>06648000
         QUALIFYFILENAME(FILEPTR,QUALNAME);                    <<03573>>06650000
         MOVE BENTRY'(FNAME') := QUALNAME WHILE AN,0;          <<04889>>06652000
         IF BPS0 = "/" THEN                                    <<03573>>06654000
         BEGIN               <<get lock word>>                 <<03573>>06656000
            @PT := @BPS0 + 1;                                  <<03573>>06658000
            ASSEMBLE (DDEL);                                   <<03573>>06660000
            MOVE BENTRY'(LW) := PT WHILE AN,0;                 <<03573>>06662000
         END;                <<get lock word>>                 <<03573>>06664000
         IF BPS0 = "." THEN                                    <<03573>>06666000
         BEGIN               <<get file group>>                <<03573>>06668000
            @PT := @GPPT := @BPS0 +1;                          <<03573>>06670000
            ASSEMBLE(DDEL);                                    <<03573>>06672000
            MOVE BENTRY'(FGROUP) := PT WHILE AN,0;             <<03573>>06674000
            IF BPS0 = "." THEN                                 <<03573>>06676000
            BEGIN            <<file account>>                  <<03573>>06678000
               @PT := @ACCPT := @BPS0 + 1;                     <<03573>>06680000
               ASSEMBLE (DDEL);                                <<03573>>06682000
               MOVE BENTRY'(FACCT) := PT WHILE AN,0;           <<03573>>06684000
            END;             <<get file account>>              <<03573>>06686000
         END;                <<get group>>                     <<03573>>06688000
                                                               <<03573>>06690000
         WHO(,,,BENTRY'(UNAME),CGROUP,BENTRY'(UACCT));         <<03573>>06692000
         IF NOT COMPSTRING(CGROUP,GPPT,8)  OR                  <<03573>>06694000
            NOT COMPSTRING(BENTRY'(UACCT),ACCPT,8)  THEN       <<03573>>06696000
         BEGIN                                                 <<03573>>06698000
            ERR := ILLEGALFILE;                                <<03573>>06700000
            CIERR(ERR,FILEPTR);                                <<03573>>06702000
            RETURN;                                            <<03573>>06704000
         END;                                                  <<03573>>06706000
         ENTRY'(TYP) := DISC;                                  <<03573>>06708000
      END                    <<"DISC">>                        <<03573>>06710000
                                                               <<03573>>06712000
  ELSE                                                         <<03573>>06714000
      IF  I >= 2 AND I <= 4  THEN                              <<03577>>06716000
      BEGIN                  <<"TAPE">>                        <<03573>>06718000
         CLEAR'LOGFNAME;                                       <<04162>>06720000
         MOVE BENTRY'(FNAME') := FILEPTR WHILE AN,0;           <<04889>>06722000
         IF BPS0 = "/" THEN                                    <<03573>>06724000
         BEGIN                                                 <<03573>>06726000
            ASSEMBLE(DDEL);                                    <<03573>>06728000
            ERR := ILLEGALTAPEFILE;                            <<03573>>06730000
            CIERR(ERR,FILEPTR);                                <<03573>>06732000
            RETURN;                                            <<03573>>06734000
         END;                                                  <<03573>>06736000
                                                               <<03573>>06738000
         IF BPS0 = "."  THEN                                   <<03573>>06740000
         BEGIN                                                 <<03573>>06742000
            ASSEMBLE(DDEL);                                    <<03573>>06744000
            ERR := ILLEGALTAPEFILE;                            <<03573>>06746000
            CIERR(ERR,FILEPTR);                                <<03573>>06748000
            RETURN;                                            <<03573>>06750000
         END;                                                  <<03573>>06752000
                                                               <<03573>>06754000
         CASE I OF                                             <<03577>>06756000
         BEGIN                                                 <<03577>>06758000
            <<0>>  ;    << Error clause - never get here >>    <<03577>>06760000
            <<1>>  ;    << "DISC" - never get here >>          <<03577>>06762000
            <<2>>  ENTRY'(TYP) := TAPE;                        <<03577>>06764000
            <<3>>  ENTRY'(TYP) := SDISC;                       <<03577>>06766000
            <<4>>  ENTRY'(TYP) := CTAPE;                       <<03577>>06768000
         END;                                                  <<03577>>06770000
                                                               <<03577>>06772000
      END;                   <<"TAPE">>                        <<03573>>06774000
                                                               <<03573>>06776000
                                                               <<03573>>06778000
   LOGF := TRUE;                                               <<03573>>06780000
   PARSELOG := TRUE;                                           <<03573>>06782000
END;                                                           <<03573>>06784000
                                                               <<03573>>06786000
                                                               <<03573>>06788000
                                                               <<03573>>06790000
$PAGE                                                          <<04162>>06792000
LOGICAL PROCEDURE PARSEPASS(PARMPTR,DELIMPTR,BENTRY',PASSF,    <<03573>>06794000
                            ERR);                              <<03573>>06796000
   BYTE POINTER  PARMPTR,DELIMPTR;                             <<03573>>06798000
   LOGICAL PASSF;                                              <<03573>>06800000
   BYTE ARRAY BENTRY';                                         <<03573>>06802000
   INTEGER ERR;                                                <<03573>>06804000
   OPTION INTERNAL;                                            <<03573>>06806000
                                                               <<03573>>06808000
<<Parses the PASS parameter. Returns:                        >><<03573>>06810000
<<  PASSF = true if correct syntax found.                    >><<03573>>06812000
<<  BENTRY' = entry for the LIDTAB with the password.        >><<03573>>06814000
<<  PARMPTR,DELIMPTR = ptrs to the parm and it's delimeter.  >><<03573>>06816000
                                                               <<03573>>06818000
BEGIN                                                          <<03573>>06820000
   EQUATE   EQ  =  "=";                                        <<03573>>06822000
   INTEGER LEN;                                                <<03573>>06824000
   BYTE POINTER PT;                                            <<03573>>06826000
                                                               <<03573>>06828000
   PARSEPASS := FALSE;                                         <<03573>>06830000
   IF PASSF THEN                                               <<03573>>06832000
   BEGIN                     <<"PASS" already found>>          <<03573>>06834000
      ERR := DUPKEYWORD;                                       <<03573>>06836000
      CIERR(ERR,PARMPTR);                                      <<03573>>06838000
      RETURN;                                                  <<03573>>06840000
   END;                      <<"PASS" already found>>          <<03573>>06842000
                                                               <<03573>>06844000
   IF DELIMPTR <> EQ THEN                                      <<03573>>06846000
   BEGIN                                                       <<03573>>06848000
      ERR := EXPECTEDEQ;                                       <<03573>>06850000
      CIERR(ERR,PARMPTR);                                      <<03573>>06852000
      RETURN;                                                  <<03573>>06854000
   END;                                                        <<03573>>06856000
                                                               <<03573>>06858000
   LEN := NEXTPARM(DELIMPTR,PARMPTR,DELIMPTR);                 <<03573>>06860000
   IF LEN > 8 THEN                                             <<03573>>06862000
   BEGIN                     <<password too long>>             <<03573>>06864000
      ERR := PWLEN;                                            <<03573>>06866000
      CIERR(ERR,PARMPTR);                                      <<03573>>06868000
      RETURN;                                                  <<03573>>06870000
   END;                      <<password too long>>             <<03573>>06872000
                                                               <<03573>>06874000
   IF LEN = 0  THEN                                            <<03573>>06876000
   BEGIN                     <<password not found>>            <<03573>>06878000
      MOVE BENTRY'(PW) := "        ";                          <<03573>>06880000
      PASSF := PARSEPASS := TRUE;                              <<03573>>06882000
      RETURN;                                                  <<03573>>06884000
   END;                      <<password not found>>            <<03573>>06886000
                                                               <<03573>>06888000
   MOVE PARMPTR := PARMPTR WHILE AN,0;                         <<03573>>06890000
   @PT := TOS;                                                 <<03573>>06892000
   ASSEMBlE(DEL);                                              <<03573>>06894000
                                                               <<03573>>06896000
   IF (@PT - @PARMPTR) <> LEN THEN                             <<03573>>06898000
   BEGIN                     <<special chars>>                 <<03573>>06900000
      ERR := NOSPECHAR;                                        <<03573>>06902000
      CIERR(ERR,PT);                                           <<03573>>06904000
      RETURN;                                                  <<03573>>06906000
   END;                      <<special chars>>                 <<03573>>06908000
                                                               <<03573>>06910000
   MOVE BENTRY'(PW) := PARMPTR, (LEN);                         <<03573>>06912000
   PASSF := TRUE;                                              <<03573>>06914000
   PARSEPASS := TRUE;                                          <<03573>>06916000
END;                                                           <<03573>>06918000
                                                               <<03573>>06920000
                                                               <<03573>>06922000
$PAGE  "ERROR CHECKING UTILITIES"                              <<04162>>06924000
                                                               <<03573>>06926000
PROCEDURE MOVE'FROM'DSEG(TARGET,SEGMENT,OFFSET,COUNT);         <<03574>>06928000
   VALUE TARGET,SEGMENT,OFFSET,COUNT;                          <<03574>>06930000
   INTEGER TARGET,SEGMENT,OFFSET,COUNT;                        <<03574>>06932000
   OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                      <<03574>>06934000
                                                               <<04891>>06936000
BEGIN                                                          <<04891>>06938000
                                                               <<03574>>06940000
                                                               <<03574>>06948000
   TOS := TARGET;                                              <<03574>>06950000
   TOS := SEGMENT;                                             <<03574>>06952000
   TOS := OFFSET;                                              <<03574>>06954000
   TOS := COUNT;                                               <<03574>>06956000
   ASSEMBLE (MFDS 4);                                          <<03574>>06958000
                                                               <<03574>>06960000
                                                               <<03574>>06964000
END;                                                           <<03574>>06966000
                                                               <<03574>>06968000
                                                               <<03574>>06970000
                                                               <<03574>>06972000
$PAGE                                                          <<04162>>06974000
PROCEDURE MOVE'TO'DSEG(SEGMENT,OFFSET,SOURCE,COUNT);           <<03574>>06976000
   VALUE SEGMENT,OFFSET,SOURCE,COUNT;                          <<03574>>06978000
   INTEGER SEGMENT,OFFSET,SOURCE,COUNT;                        <<03574>>06980000
   OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                      <<03574>>06982000
                                                               <<03574>>06984000
BEGIN                                                          <<04891>>06986000
                                                               <<03574>>06990000
   TOS := SEGMENT;                                             <<03574>>06992000
   TOS := OFFSET;                                              <<03574>>06994000
   TOS := SOURCE;                                              <<03574>>06996000
   TOS := COUNT;                                               <<03574>>06998000
   ASSEMBLE (MTDS 4);                                          <<03574>>07000000
                                                               <<03574>>07002000
                                                               <<03574>>07006000
END;                                                           <<03574>>07008000
                                                               <<03574>>07010000
                                                               <<03574>>07012000
$PAGE                                                          <<04162>>07014000
LOGICAL PROCEDURE CHEKINDEX(BUFDST,ENUM);                      <<04891>>07016000
   VALUE ENUM;                                                 <<04891>>07018000
   INTEGER BUFDST,ENUM;                                        <<03574>>07020000
   OPTION PRIVILEGED,INTERNAL;                                 <<03574>>07022000
                                                               <<03574>>07024000
<< Checks value of the "INDEX" parameter for all intrinsics >> <<03574>>07026000
<< ENTRY:                                                   >> <<03574>>07028000
<<       BUFDST - offset into LOGTAB for the log process    >> <<04891>>07030000
<<       ENUM   - entry offset into LOGBUFF for the user    >> <<04891>>07032000
<<                                                          >> <<04891>>07034000
<< RETURNS:                                                 >> <<03574>>07036000
<<    FALSE - bad value of BUFDST or ENUM.                  >> <<04891>>07038000
<<     TRUE - all O.K.                                      >> <<04891>>07040000
<<     BUFDST - the dst# of the LOGBUFF                    >> <<<04891>>07042000
<<     ENUM   - unchanged.                                 >>  <<04891>>07044000
                                                               <<03574>>07046000
<< DB must be at stack.                                      >><<03574>>07048000
                                                               <<03574>>07050000
BEGIN                                                          <<03574>>07052000
                                                               <<03574>>07056000
   INTEGER                                                     <<03574>>07058000
      TABINDEX,                                                <<04891>>07060000
      MAX'USERS,      << Max # users per logging process >>    <<04891>>07062000
      MAX'PROCS,      << Max # user logging processes   >>     <<04891>>07064000
      TEMP;                                                    <<03574>>07066000
                                                               <<03574>>07068000
   ARRAY WLOGID'(0:4) = Q;                                     <<04891>>07070000
   BYTE ARRAY LOGID'(*) = WLOGID';                             <<04891>>07072000
                                                               <<04891>>07074000
                                                               <<04891>>07076000
CHEKINDEX := FALSE;                                            <<04891>>07078000
                                                               <<03574>>07080000
<< Make sure that BUFDST is really a valid offset into the  >> <<04891>>07082000
<< LOGTAB.                                                  >> <<04891>>07084000
                                                               <<04891>>07086000
TABINDEX := BUFDST;                                            <<04891>>07088000
MOVE'FROM'DSEG(@MAX'PROCS,LOGDST,MAXLOGPROCS,1);               <<04891>>07090000
                                                               <<04891>>07092000
IF (TABINDEX < TENTRYSIZE) OR (TABINDEX>(TENTRYSIZE*MAX'PROCS))<<04891>>07094000
   OR  (TABINDEX MOD TENTRYSIZE <> 0)   THEN RETURN;          <<<04891>>07096000
                                                               <<04891>>07100000
<< Make sure this entry is a valid entry. >>                   <<04891>>07102000
                                                               <<04891>>07104000
MOVE'FROM'DSEG(@WLOGID',LOGDST,LGNAME/2,4);                    <<04891>>07106000
                                                               <<04891>>07108000
IF LOGID' = "        " THEN RETURN;                            <<04891>>07110000
                                                               <<04891>>07112000
<< Looks O.K. Now get the dst # of the LOGBUFF >>              <<04891>>07114000
                                                               <<04891>>07116000
MOVE'FROM'DSEG(@TEMP,LOGDST,DST,1);                            <<04891>>07118000
                                                               <<04891>>07120000
IF TEMP = NULL  THEN  RETURN;                                  <<04891>>07122000
                                                               <<04891>>07124000
<< We've got the dst # of the LOGBUFF...keep it! >>            <<04891>>07126000
                                                               <<04891>>07128000
BUFDST := TEMP;                                                <<04891>>07130000
                                                               <<04891>>07132000
                                                               <<03574>>07134000
                                                               <<03574>>07138000
                                                               <<03574>>07140000
<< See if ENUM is a valid offset within the Logging Buffer. >> <<03574>>07142000
<< Offset range based on # entries allowed (MAX'USERS) and  >> <<03574>>07144000
<< length of Global area (BENTRYBASE).                      >> <<03574>>07146000
                                                               <<03574>>07148000
MOVE'FROM'DSEG(@MAX'USERS,BUFDST,MAXUSER',1);                  <<04889>>07150000
                                                               <<03574>>07152000
IF (ENUM < BENTRYBASE) OR                                      <<04891>>07154000
   (ENUM MOD BENTRYSIZE <> 0) OR                               <<03574>>07156000
   (ENUM >= BENTRYBASE+(MAX'USERS*BENTRYSIZE))  THEN  RETURN;  <<04891>>07158000
                                                               <<03574>>07162000
<< All tests passed ! >>                                       <<03574>>07164000
                                                               <<03574>>07166000
CHEKINDEX := TRUE;                                             <<04891>>07168000
END;                                                           <<03574>>07170000
                                                               <<03574>>07172000
$CONTROL SEGMENT=MAIN                                          <<03574>>07174000
END.                                                           <<03574>>07176000
