         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
INTRINSIC FFILEINFO, FCHECK;                                   << 9399>>01191000
                                                                        02401000
IF XDDH'FIRST'SUBENTRY = 0  THEN  << no entry in chain >>               02401100
   BEGIN                                                                02401200
   FOUND := FALSE ;                                                     02401300
   GO TO OUTL;                                                          02401400
   END;                                                                 02401500
OUTL:                                                                   02559000
                                                               <<A2171>>03830000
$EDIT VOID=04160000                                            <<A2171>>03832000
                                                               <<A2171>>03834000
INTEGER PROCEDURE DASCII (WORD, BASE, STRING);                 <<A2171>>03836000
   VALUE WORD, BASE;                                           <<A2171>>03838000
<<------------------------------------------------------->>    <<A2171>>03840000
<< FUNCTION:                                             >>    <<A2171>>03842000
<< CONVERT <WORD> TO ASCII.                              >>    <<A2171>>03844000
<<            PERFORM SIGNED DECIMAL CONVERSION          >>    <<A2171>>03846000
<<            (STRING(0) = "-", IF NECESSARY).           >>    <<A2171>>03848000
<<    BASE = 10  -- OUTPUT STRING WILL BE LEFT JUSTIFIED >>    <<A2171>>03850000
<<                  DECIMAL CONVERSION                   >>    <<A2171>>03852000
<<    BASE = -10 -- OUTPUT STRING WILL BE RIGHT JUSTIFIED>>    <<A2171>>03854000
<<                  DECIMAL CONVERSION                   >>    <<A2171>>03856000
<<    BASE = 8   -- OUTPUT STRING WILL BE LEFT JUSTIFIED >>    <<A2171>>03858000
<<                  OCTAL CONVERSION                     >>    <<A2171>>03860000
<<                                                       >>    <<A2171>>03862000
<< LAST MODIFIED 9/85                                    >>    <<A2171>>03864000
<<------------------------------------------------------->>    <<A2171>>03866000
                                                               <<A2171>>03868000
<< INPUT PARAMETERS: >>                                        <<A2171>>03870000
   DOUBLE WORD;              <<WORD TO BE CONVERTED>>          <<A2171>>03872000
   INTEGER BASE;             <<8 (OCTAL), OR       >>          <<A2171>>03874000
                             <<10 (SIGNED DECIMAL) >>          <<A2171>>03876000
<< OUTPUT PARAMETERS: >>                                       <<A2171>>03878000
   BYTE ARRAY STRING;        <<RESULT. PROVIDE ROOM  >>        <<A2171>>03880000
                             <<FOR AT LEAST 11 BYTES >>        <<A2171>>03882000
   OPTION PRIVILEGED;                                          <<A2171>>03884000
                                                               <<A2171>>03886000
BEGIN                                                          <<A2171>>03888000
   LOGICAL DASCIIHANG := [10/75, 6/4];                         <<A2171>>03890000
   BYTE ARRAY TEMP (0:10) = Q;                                 <<A2171>>03892000
   DOUBLE  WORDD = WORD,                                       <<A2171>>03894000
           DTEN := 10D;                                        <<A2171>>03896000
   LOGICAL FLAGS := 0;                                         <<A2171>>03898000
   DEFINE START = FLAGS.(15:1) #;                              <<A2171>>03900000
   DEFINE RTJUST = FLAGS.(14:1) #;                             <<A2171>>03902000
   INTEGER LENGTH = Q-8;                                       <<A2171>>03904000
   LOGICAL K=S-0;                                              <<A2171>>03906000
                                                               <<A2171>>03908000
SUBROUTINE CHEKIT (LEN);                                       <<A2171>>03910000
   VALUE LEN;                                                  <<A2171>>03912000
   INTEGER LEN;                                                <<A2171>>03914000
BEGIN                                                          <<A2171>>03916000
   TOS := CHEK (DASCIIHANG, %103, %61D);                       <<A2171>>03918000
      BEGIN                                                    <<A2171>>03920000
      TOS := (@STRING +S3 -1) & LSR(1);                        <<A2171>>03922000
      ASSEMBLE (DDUP, CMP);                                    <<A2171>>03924000
      IF < THEN TOS.(0:1) := 1;                                <<A2171>>03926000
      XREG := TOS;                                             <<A2171>>03928000
      IF NOT (TOS <= XREG <= TOS) THEN                         <<A2171>>03930000
         ERROREXIT (DASCIIHANG, 6, 3);                         <<A2171>>03932000
      END;                                                     <<A2171>>03934000
   END    <<SUBROUTINE CHELIT>>;                               <<A2171>>03936000
                                                               <<A2171>>03938000
<< MAIN CODE >>                                                <<A2171>>03940000
   ERRORON;                                                    <<A2171>>03942000
   IF BASE <> 8 THEN                                           <<A2171>>03944000
      BEGIN  << CHECK FOR BASE 10 REQUEST >>                   <<A2171>>03946000
      IF BASE <> 10 THEN                                       <<A2171>>03948000
         BEGIN    <<RT JUSTIFY REQUEST>>                       <<A2171>>03950000
         IF BASE <> -10 THEN << INVALID BASE >>                <<A2171>>03952000
            ERROREXIT (DASCIIHANG, 8, 2);                      <<A2171>>03954000
         RTJUST := TRUE;                                       <<A2171>>03956000
         BASE := 10;                                           <<A2171>>03958000
         END;                                                  <<A2171>>03960000
      IF WORDD < 0D THEN << NEG NUMBER >>                      <<A2171>>03962000
         BEGIN                                                 <<A2171>>03964000
         PUSH (STATUS);                                        <<A2171>>03966000
         ASSEMBLE (TRBC 2);                                    <<A2171>>03968000
         SET (STATUS);                                         <<A2171>>03970000
         WORDD := -WORDD;                                      <<A2171>>03972000
         IF OVERFLOW THEN                                      <<A2171>>03974000
            BEGIN                                              <<A2171>>03976000
            MOVE TEMP := "-2147483648";                        <<A2171>>03978000
            XREG := 0;                                         <<A2171>>03980000
            GOTO SETUP;                                        <<A2171>>03982000
            END;                                               <<A2171>>03984000
         START := TRUE; << NEG NUMBER INDICATOR >>             <<A2171>>03986000
         END;                                                  <<A2171>>03988000
      TOS := WORDD;                                            <<A2171>>03990000
      XREG := 11;                                              <<A2171>>03992000
      <<-------------------------------------------->>         <<A2171>>03994000
      << TOS  CONTAINS CONVERSION WORD              >>         <<A2171>>03996000
      << XREG USED AS POSITION INDEX FROM 10 TO 0   >>         <<A2171>>03998000
      <<  LOOP DIVIDES WORD BY 10 TAKES REMAINDER   >>         <<A2171>>04000000
      <<  ADDS %60 (MAKES WORD AN ASCII IMAGE OF THE>>         <<A2171>>04002000
      <<  NUMBER) AND MOVES IT TO THE OUTPUT STRING.>>         <<A2171>>04004000
      <<-------------------------------------------->>         <<A2171>>04006000
      DO BEGIN << BASE 10 CONVERSION LOOP >>                   <<A2171>>04008000
         TOS := DTEN;                                          <<A2171>>04010000
         ASSEMBLE (DDIV; DECX, NOP);                           <<A2171>>04012000
         TEMP(XREG) := TOS +%60;                               <<A2171>>04014000
         ASSEMBLE (DEL, dtst);                                 <<A2311>>04016000
         END                                                   <<A2171>>04018000
      UNTIL =;                                                 <<A2171>>04020000
      IF START THEN << SET OUTPUT NEGATIVE >>                  <<A2171>>04022000
         TEMP (XREG := XREG - 1) := "-";                       <<A2171>>04024000
SETUP:                                                         <<A2171>>04026000
      << XREG = LEFT BYTE OF RESULT IN TEMP >>                 <<A2171>>04028000
      LENGTH := 11 -XREG;                                      <<A2171>>04030000
      TOS := @STRING;    <<SETUP FOR MOVE>>                    <<A2171>>04032000
      TOS := @TEMP;                                            <<A2171>>04034000
      IF RTJUST THEN                                           <<A2171>>04036000
         BEGIN    <<RT JUSTIFICATION>>                         <<A2171>>04038000
         TOS := TOS +10;                                       <<A2171>>04040000
         TOS := -LENGTH;                                       <<A2171>>04042000
         TOS := S0 +2;    <<(FOR BOUND. CHECK)>>               <<A2171>>04044000
         END                                                   <<A2171>>04046000
      ELSE                                                     <<A2171>>04048000
         BEGIN    <<LEFT JUSTIFY>>                             <<A2171>>04050000
         TOS := TOS +XREG;                                     <<A2171>>04052000
         TOS := LENGTH;                                        <<A2171>>04054000
         TOS := S0;                                            <<A2171>>04056000
         END;                                                  <<A2171>>04058000
      << S-0 = LENGTH 4 BOUND. CHECK >>                        <<A2171>>04060000
      << (S-3):(S-1) = MOVE SETUP >>                           <<A2171>>04062000
      CHEKIT (*);                                              <<A2171>>04064000
      ASSEMBLE (MVB);                                          <<A2171>>04066000
      END                                                      <<A2171>>04068000
   ELSE                                                        <<A2171>>04070000
      BEGIN    <<OCTAL>>                                       <<A2171>>04072000
      CHEKIT (11);                                             <<A2171>>04074000
      XREG := 10;                                              <<A2171>>04076000
      LENGTH := 1;                                             <<A2171>>04078000
      TOS := WORD;                                             <<A2171>>04080000
      <<---------------------------------------->>             <<A2171>>04082000
      << TOS CONTAINS DOUBLE WORD FOR CONVERSION>>             <<A2171>>04084000
      << XREG IS OUTPUT BYTE COUNTER            >>             <<A2171>>04086000
      <<  LOOP TAKES LOWEST THREE BITS ADDS %60 >>             <<A2171>>04088000
      <<  (SEE ABOVE COMMENT) AND PUTS THE      >>             <<A2171>>04090000
      <<  ASCII CHARACTER IN THE OUTPUT STRING  >>             <<A2171>>04092000
      <<  A DOUBLE LEFT SHIFT IS DONE TO GET THE>>             <<A2171>>04094000
      <<  NEXT CHARACTER.                       >>             <<A2171>>04096000
      <<---------------------------------------->>             <<A2171>>04098000
      WHILE XREG >= 0 DO << BASE 8 CONVERSION >>               <<A2171>>04100000
         BEGIN                                                 <<A2171>>04102000
           TOS := K LAND 7;                                    <<A2171>>04104000
           IF <> THEN LENGTH := 11 -XREG;                      <<A2171>>04106000
           STRING (XREG) := TOS + %60;                         <<A2171>>04108000
            TOS := TOS & DLSR(3);                              <<A2171>>04110000
            XREG := XREG -1;                                   <<A2171>>04112000
         END                                                   <<A2171>>04114000
      END;                                                     <<A2171>>04116000
                                                               <<A2171>>04118000
   ERROREXIT (DASCIIHANG, 0, 0);                               <<A2171>>04120000
END  <<DASCII2>>;                                              <<A2171>>04122000
                                                               <<A2171>>04124000
                                                               <<A2171>>04126000
    FFILEINFO( TFILE,  5, DEVICETYPE,                          << 9399>>10420000
                      50, LDEV        );                       << 9399>>10421000
    TOS := ATTACHIO(LDEV,0,0,SBUFX,PTAPEFUNC,-32767,           <<02153>>10480000
                IF BCNT=255 THEN                               <<p2179>>10795000
                   begin                                       <<p2179>>10796000
                     fwrite(dfile,irbuf,-(bcnt+1),0);          <<p2179>>10797000
                     if <> then goto out4;                     <<p2179>>10798000
                     bcnt := 0;                                <<p2179>>10799000
                   end                                         <<p2179>>10799100
                else                                           <<p2179>>10799200
                   BCNT := BCNT + 1;                           <<p2179>>10800000
$EDIT                                                          << 9399>>10930000
   ECODE:=ERRORCODE.(7:9);                                     <<02154>>12565000
COMMENT                                                                 13151000
The logging buffer scheme is modified in April 86.  Prior to            13151100
this, the two DSTs %37 & %40 have the same size as the record           13151200
size of the logging files. When one of them is full, LOG is             13151300
awaken to write it out.                                                 13151400
The problem with it is, if some process is holding the FMAVT            13151500
SIR and the LOG BUF SIR, and waits for the LOG process to post          13151600
the buffers out.  In the meantime LOG needs to open a new log           13151700
file, and tries to get the FMAVT SIR: Deadlock.                         13151800
To minimize - but not entirely eliminate this problem - we              13151900
increased the number of buffers within each DST. Each will now          13152000
has 8 buffers instead of one (a buffer is one phyiscal log              13152100
record). Hopefully with this many buffers, we have virtually            13152200
wipe out the case where a process has to wait for a buffer,             13152300
which will prevent the deadlock from happening.                         13152400
Then if we do indeed hit the deadlock situation, we will                13152500
delay for 15 times (one second each), then skip the log                 13152600
record. This is better than hanging the entire system.                  13152700
;                                                                       13152800
      INTEGER BUFNUM;                                          << 2128>>13816000
      INTEGER DELAY'COUNT := 1;                                << 2128>>13817000
      IF ABSOLUTE(BUF0X+CB).STATE = FULL THEN                  << 2128>>15241000
         BEGIN                                                 << 2128>>15241100
         FULLF := TRUE;                                        << 2128>>15241200
         GO TO L'DELAY;                                        << 2128>>15241300
         END;                                                  << 2128>>15241400
      IF FREEP < BSIZE THEN                                    << 2128>>15246000
         BUFNUM := 1   << Freep is within the 1st buf >>       << 2128>>15246100
      ELSE                                                     << 2128>>15246200
         BUFNUM := (FREEP/BSIZE) + 1;  << bufnum within dst >> << 2128>>15246300
                                                               << 2128>>15246400
      IF (BX+1) <= (BUFNUM * BSIZE) - FREEP THEN  << room >>   << 2128>>15250000
         << enough room for this log record >>                 << 2128>>15251000
L'MOVE:  << move log record to log buffer >>                   << 2128>>15261000
         IF (BUFNUM * BSIZE) - FREEP > MINSIZE THEN            << 2128>>15515000
            << some room left for next person to log >>        << 2128>>15516000
$EDIT                                                          << 2128>>15530000
            GOTO RET;                                          << 2128>>15540000
            END                                                << 2128>>15541000
         ELSE << no room in current buf for next person >>     << 2128>>15542000
            BEGIN                                              << 2128>>15542100
            IF BUFNUM < 8 THEN << more bufs in current DST >>  << 2128>>15543000
               BEGIN    << point to next bufnum >>             << 2128>>15544000
               DISAPROC;                                       << 2128>>15545000
               ABSOLUTE (FREEX) := BUFNUM * BSIZE;             << 2128>>15546000
               BUFNUM := BUFNUM + 1;                           << 2128>>15547000
               RELSIR (BUFSIR,S);                              << 2128>>15547100
               IF ABSOLUTE (LOGINFO) THEN                      << 2128>>15547900
                  AWAKE (ABSOLUTE(LOGPINX),%20,0);             << 2128>>15548000
               ENAPROC;                                        << 2128>>15549000
               GOTO RET;                                       << 2128>>15550000
               END                                             << 2128>>15551000
            ELSE  << this is the last buf in current DST >>    << 2128>>15552000
               GOTO L2; << must switch buf DST >>              << 2128>>15553000
            END;                                               << 2128>>15553100
         END  << of enough room for this log record >>         << 2128>>15554000
      ELSE   << not enough room in current buf for me now >>   << 2128>>15555000
         IF BUFNUM < 8 THEN  << more bufs in current DST >>    << 2128>>15556000
            BEGIN                                              << 2128>>15557000
            ABSOLUTE (FREEX) := FREEP  := BUFNUM * BSIZE;      << 2128>>15558000
            BUFNUM := BUFNUM + 1;                              << 2128>>15559000
            IF ABSOLUTE (LOGINFO) THEN                         << 2128>>15559010
               AWAKE (ABSOLUTE(LOGPINX),%20,0);                << 2128>>15559100
            GOTO L'MOVE; << go back and do the move >>         << 2128>>15560000
            END                                                << 2128>>15561000
         ELSE                                                  << 2128>>15562000
            FULLF := TRUE; << current DST full, must switch >> << 2128>>15563000
$EDIT VOID=15580000                                            << 2128>>15565000
<< GET HERE ONLY IF CURRENT BUF DST IS FULL   >>               << 2128>>15586000
                                                               << 2128>>15587000
                                                               << 2019>>15595100
$EDIT VOID=15596000                                            << 2128>>15595200
$EDIT                                                          << 2128>>15615000
$EDIT                                                          << 2128>>15686000
L'DELAY:                                                       << 2128>>15694000
               END                                             << 2128>>15720000
            ELSE                                               << 2128>>15723000
               AWAKE (ABSOLUTE(LOGPINX),%20,0);                << 2128>>15724000
            DELAY'COUNT := DELAY'COUNT + 1;                    << 2128>>15726000
            IF DELAY'COUNT > 15 THEN                           << 2128>>15727000
               BEGIN                                           << 2128>>15727100
               RELSIR (BUFSIR,S);                              << 2128>>15727200
               GOTO RET;                                       << 2128>>15727300
               END;                                            << 2128>>15727400
            GO TO L5;                                          << 2128>>15735000
         ABSOLUTE(FREEX) := 0;      << set free ptr to 0 >>    << 2128>>15754000
         IF ABSOLUTE (LOGINFO) THEN                            << 2128>>15755900
            AWAKE (ABSOLUTE(LOGPINX),%20,0);                   << 2128>>15756000
         IF FULLF THEN GOTO L1;                                << 2128>>15760000
$EDIT VOID = 15821000                                          << 2128>>15760100
         RELSIR (BUFSIR,S);                                    << 2128>>15825000
         GOTO RET;                                             << 2128>>15830000
$PAGE "PROCEDURE JOBINFO"                                      << 9143>>15854900
LOGICAL ARRAY NBUFF(0:12);                                     << 9304>>17025000
BYTE    ARRAY NBUFFB(*) = NBUFF;                               << 9304>>17030000
BYTE    ARRAY BUFFB(0:25);                                     << 9304>>17035000
                                                               << 9379>>18674000
<< Get the DB location on the stack from PXGLOBAL area >>      << 9379>>18675000
        TOS := 1;                                              << 9379>>18705000
BUFFB := %40;                                                  << 9568>>18861000
MOVE BUFFB(1) := BUFFB,(25);                                   << 9568>>18862000
   ELSE IF((UCAPAM = 1)LAND(WACCT=TEMPACCT,(8))) THEN OK:=TRUE <<02094>>19070000
        ELSE IF ((TEMPUSER=WUSER,(8))LAND(TEMPACCT=WACCT,(8))) <<02094>>19075000
   IF ( ( JMATJOBSTATE = JOBEXEC )    LOR                      << 9379>>19385000
        ( JMATJOBSTATE = JOBSUSP ) )                           << 9379>>19390000
$EDIT                                                          << 9143>>19395000
           IF EXEC THEN                                        << 9379>>19895000
           IF EXEC OR JMATJOBSTATE = JOBCIINIT                 << 9516>>20325000
INTEGER PROCEDURE GETINFO (INFO,INFOLEN,PARM);                          22021000
BYTE ARRAY INFO; INTEGER INFOLEN,PARM;                                  22021020
OPTION PRIVILEGED,VARIABLE;                                             22021030
BEGIN                                                                   22021040
<< this is the intrinsic for retrieving the INFO= and PARM= >>          22021050
<< values in the :RUN command. The form of the call is:      >>         22021060
<<     Result   := GETINFO (info, infolen,parm) where:    >>            22021070
<< * Result: integer output. 0: no problem.                >>           22021080
<<              1: the infolen is negative or not specified  >>         22021090
<< * info : byte array, optional. If not provided, the INFO  >>         22021100
<<          will not be returned.                           >>          22021110
<< * infolen: integer , input and output, the len of info >>            22021120
<<           If < 1 or omitted, error #1 will be returned >>            22021130
<< * parm: integer variable to return the parm value.Optional>>         22021140
                                                                        22021150
  ARRAY QARRAY(*)=Q+0;                                                  22021160
  LOGICAL PXFIXEDLOC;                                                   22021170
  INTEGER S0=S-0;                                                       22021180
  POINTER QI;                                                           22021190
  BYTE POINTER INFOP;                                                   22021200
  INTEGER LEN;                                                          22021210
  LOGICAL OVMASK = Q-4; << option variable mask  >>                     22021220
  DEFINE LENNOTSPEC  = OVMASK.(14:1) = 0#,                              22021230
         WANTPARM    = OVMASK.(15:1)#,                                  22021240
         WANTINFO    = OVMASK.(13:1)#;                                  22021250
  LOGICAL GETINFOHANG := [10/87,6/4];                                   22021260
                                                                        22021270
  DOUBLE DBOUNDS;                                                       22021280
  INTEGER LOWBOUND = DBOUNDS;                                           22021290
  INTEGER UPBOUND = DBOUNDS+1;                                          22021300
                                                                        22021310
  ERRORON;                                                              22021320
                                                                        22021330
  DBOUNDS := CHEK (GETINFOHANG,%103,%53D,,%7);                          22021340
  GETINFO := 0;  << initialize the return to ok status >>               22021350
  PXFIXED;                                                              22021360
  @QI := PXFXQREG;  << location of initial Q markers >>                 22021370
  LEN := QI(-2);     << length of info  >>                              22021380
  @INFOP := QI(-1);   << Address of info string >>                      22021390
  IF WANTPARM THEN                                                      22021400
     PARM := QI;     << get the parm  >>                                22021410
  IF NOT WANTINFO THEN                                                  22021420
     GO TO PROC'EXIT;                                                   22021430
  IF INFOLEN < 1 OR LENNOTSPEC THEN << len invalid or omit >>           22021440
     BEGIN                                                              22021450
     GETINFO := 1;                                                      22021460
     GO TO PROC'EXIT;                                                   22021470
     END;                                                               22021480
  IF INFOLEN > LEN THEN  << if passed-in len > real len >>              22021490
     INFOLEN := LEN    << then return the actual length >>              22021500
  ELSE                                                                  22021510
     LEN := INFOLEN; <<else use the len passed in by caller>>           22021520
  IF LEN > 0 THEN                                                       22021530
     BEGIN                                                              22021540
      << check end addr of the info string for bounds >>                22021550
     TOS := (@INFO + LEN - 1) & LSR(1) ;  << word addr >>               22021560
     XREG := TOS;                                                       22021570
     IF NOT (LOWBOUND <= XREG <= UPBOUND) THEN                          22021580
        ERROREXIT (GETINFOHANG,6,1);                                    22021590
     MOVE INFO := INFOP,(LEN); << get the info string >>                22021600
     END;                                                               22021610
                                                                        22021620
PROC'EXIT:                                                              22021630
   ERROREXIT(GETINFOHANG,0,0);                                          22021640
END;                                                                    22021650
