         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
INTEGER PROCEDURE GETSTACK (INITSIZE, MAXDATA);                <<02194>>05280000
   VALUE   INITSIZE, MAXDATA;                                  <<02194>>05285000
   INTEGER INITSIZE, MAXDATA;                                  <<02194>>05290000
  COMMENT -- Entry point to GETDATASEG, acquires a  data  seg- <<02194>>05290100
ment and marks it as a stack in the DST.  GETSTACK limits both <<02194>>05290200
parameters to 32764.  If MAXDATA < INITSIZE it is set to INIT- <<02194>>05290210
SIZE.                                                          <<02194>>05290220
      Result:  DST number of stack, or 0 if unable to acquire. <<02194>>05290300
                                                               <<02194>>05290400
      Condition code:  CCE -- O.K., you got it.                <<02194>>05290500
                       CCG -- No DST entry available.          <<02194>>05290600
                       CCL -- No swap region available.        <<02194>>05290700
;                                                              <<02194>>05290800
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02194>>05295000
                                                               <<02194>>05295100
PROCEDURE RELDATASEG (DSEG);                                   <<02194>>05295200
   VALUE   DSEG;                                               <<02194>>05295300
   INTEGER DSEG;                                               <<02194>>05295400
  COMMENT -- Releases DST number DSEG.  CC is  unchanged,  but <<02194>>05295500
the call can result in one of several system failures:         <<02194>>05295600
     SF124:  DSEG is a system data segment.                    <<02194>>05295700
     SF630:  DSEG is locked in memory.                         <<02194>>05295800
     SF631:  DSEG is I/O frozen.                               <<02194>>05295900
     SF632:  Problem releasing the swap region (bad  disc  ad- <<02194>>05296000
               address or virtual disc space bit map).         <<02194>>05296100
     SF634:  PDISABLE count > 1 at exit.                       <<02194>>05296200
;                                                              <<02194>>05296300
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02194>>05296400
INTEGER PROCEDURE XRETJTENTRY (FILE, GROUP, ACCOUNT, NODE,     <<A9767>>06160000
                               SIZE, INFO);                    <<A9767>>06165000
   BYTE ARRAY FILE, GROUP, ACCOUNT, NODE;                      <<A9767>>06180000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<A9767>>06185000
                                                               <<A9767>>06187500
                                                               <<02192>>06790100
PROCEDURE REMRITENTRY (PIN);                                   <<02192>>06790200
   VALUE   PIN;                                                <<02192>>06790300
   INTEGER PIN;                                                <<02192>>06790400
   OPTION  PRIVILEGED, UNCALLABLE, EXTERNAL;                   <<02192>>06790500
COMMENT -- Cancels a wait for an  operator  REPLY  by  pulling <<02192>>06790600
the RIT entry for process PIN out of the RIT and WAKEing PIN.  <<02192>>06790700
;                                                              <<02192>>06790800
                     PROGEN'PIN = 1,                           <<09988>>07262500
                     CRIT,                                     <<09988>>07297500
CRIT := SETCRITICAL;                                           <<09988>>07415555
<< The following monstrosity, preserved from MPE4 and  used >> <<02195>>07570000
<< until  now, is commented out but left in the listing for >> <<02195>>07570100
<< historical purposes.  In its place is a hard-coded  MAX- >> <<02195>>07570200
<< STACKSIZE.  There are three reasons for doing this:      >> <<02195>>07570300
<< 1.  No one presently supporting this code knows the ori- >> <<02195>>07570400
<<     gin of this expression or how  it  should  be  main- >> <<02195>>07570500
<<     tained as the spooler environment changes.           >> <<02195>>07570600
<< 2.  When today's numbers are plugged in, the value which >> <<02195>>07570700
<<     results (7552) is occasionally not enough to  handle >> <<02195>>07570800
<<     2680  error  processing  (many  stack  markers and a >> <<02195>>07570900
<<     large Environmental Status Block).                   >> <<02195>>07571000
<< 3.  We only need a short-term remedy, since we soon hope >> <<02195>>07571100
<<     to have a better way of handling the entire problem. >> <<02195>>07571200
<<     The hard-coded value chosen is  a  magic  number  in >> <<02195>>07571300
<<     that  there  is no data to support the choice.  How- >> <<02195>>07571400
<<     ever, it is a group decision, and represents a  com- >> <<02195>>07571500
<<     promise  between  avoiding  the SF310's due to stack >> <<02195>>07571600
<<     overflow and consuming too much virtual memory.      >> <<02195>>07571700
              <<  MAXSTACKSIZE := ((INITSTACKSIZE+127)&ASR(7)) <<02195>>07580000
              <<     & ASL(7) + 512 * (BLOCKS + 2);            <<02195>>07585000
                  MAXSTACKSIZE := 12000;                       <<02195>>07586000
                        MOVETODSEG (LDT'DST, DEVICE *          <<09988>>07690250
                           SIZE'OF'LDT'ENTRY, LDT,             <<09988>>07690500
                           SIZE'OF'LDT'ENTRY);                 <<09988>>07690750
                        RELSIR (LDT'SIR, SAVE'LDT'SIR);        <<09988>>07691000
                        ADOPT (SPPIN, PROGEN'PIN);             <<09988>>07695000
$EDIT VOID=07795000                                            <<09988>>07785000
                        BEGIN   << Give stack DS back.      >> <<02194>>07806000
                        RELDATASEG (SPSTACK);                  <<02194>>07807000
                        END;    << Give stack DS back.      >> <<02194>>07811000
IF ((INITIATESPOOLER := TOS) <> XOKAY) THEN                    <<09988>>07960000
   BEGIN            << Don't need to update LDT, was never  >> <<02194>>07962500
   IF UNWIND THEN   << written back, but must release SIR.  >> <<02194>>07962750
      BEGIN   << If here, must also clear LPDT ownership.   >> <<02194>>07965000
$EDIT VOID=07975000                                            <<02194>>07970000
      DISABLE;                                                 <<09988>>07980000
      LPDT'DEV'OWN'STATE := LPDT'NOT'OWNED;                    <<09988>>07985000
      ENABLE;                                                  <<09988>>07990000
$EDIT VOID=08000000                                            <<02194>>07995000
      END;    << If here, must also clear LPDT ownership.   >> <<02194>>08000062
   RELSIR (LDT'SIR, SAVE'LDT'SIR);                             <<09988>>08000625
   END;    << Don't need to update LDT...                   >> <<02194>>08005000
RESETCRITICAL (CRIT);                                          <<09988>>08015000
$EDIT VOID=08380000                                            <<09987>>08380000
         LPDT'INDEX := DEVICE * SIZE'OF'LPDT'ENTRY;            <<09987>>08431000
LOGICAL                                                        <<02193>>09975000
   INDEX := 0;          << Current index into SPOOFLE'BLOCK >> <<02193>>09980000
                                                               <<02193>>09981000
INTEGER                                                        <<02193>>09982000
<< The tests below must be performed in  the  order  shown, >> <<02193>>10000100
<< lest an invalid INDEX from a previous iteration cause us >> <<02193>>10000200
<< to access beyond the end of SPOOFLE'BLOCK  and  possibly >> <<02193>>10000300
<< our  stack,  resulting  in SF10 on PMBC machines.  Also, >> <<02193>>10000400
<< INDEX must be of type LOGICAL so that the first test  is >> <<02193>>10000500
<< valid even if invalid data causes INDEX(0:1) to be set.  >> <<02193>>10000600
                                                               <<02193>>10000700
WHILE INDEX <= END'OF'DATA AND                                 <<02193>>10005000
      (RECORD'LENGTH := SPOOFLE'BLOCK(INDEX)) <> -1 DO         <<02193>>10010000
      INDEX := INDEX + (LOGICAL (RECORD'LENGTH) + 3) & LSR(1); <<02193>>10035000
$EDIT VOID=16525000                                            <<09363>>16525000
      IF NOT OUT AND (G'DCT'INDEX < 0) THEN                    <<09363>>16530000
         ERROR (SHOWFINPTDEVCLS)  << No dev class on SHOWIN >> <<09363>>16535000
      ELSE IF G'ACCESS'TYPE <= 7 THEN                          <<09363>>16540000
         ERROR (SHOWFDACCESSDEV)   << Can't SHOWxx on discs >> <<09363>>16545000
      ELSE IF DSDEVICE (G'DCT'INDEX) THEN                      <<09363>>16550000
         ERROR (SHOWFDSDEVICE)     << Nor on DS devices.    >> <<09363>>16555000
      ELSE                                                     <<09363>>16560000
         BEGIN   << Looks fairly good.                      >> <<09363>>16565000
         DEVFLAG := TRUE;                                      <<09363>>16570000
         IF <> THEN                                            <<09363>>16575000
            BEGIN   << DEV= already specified.              >> <<09363>>16580000
            PARM := PARMS (PNUM-1);   << Back up for "^"    >> <<09363>>16585000
            ERROR (-SHOWFRDNTDEV);                             <<09363>>16590000
            PARM := PARMS(PNUM);      << As we were.        >> <<09363>>16595000
            END;    << DEV= already specified.              >> <<09363>>16600000
         DEV := G'DCT'INDEX;   << Any new DEV replaces old. >> <<09363>>16605000
         END;    << Looks fairly good.                      >> <<09363>>16610000
      END;    << Some string specified.                     >> <<09363>>16613000
   END;    << Have "=" sign.                                >> <<09363>>16630000
                  << SATISFIES CLASS >>                        <<09986>>20300000
                                                               <<09986>>20301000
<< XDD job number of 0 means :DATA file for :SHOWIN, mean-  >> <<09986>>20302000
<< ingless for :SHOWOUT, so filter latter out here.         >> <<09986>>20303000
                                                               <<09986>>20304000
                  IF XDDS'JOB'NUMBER <> 0    << Not 0, O.K. >> <<09986>>20304100
                     OR NOT OUT THEN      << 0 and IN, O.K. >> <<09986>>20304200
                  OR XDDS'JOB'NUMBER = 0 << READY/ACTV :DATA>> <<11563>>20310000
                                                               <<*1268>>25700100
   INTEGER ERROR'CODE;                                         <<*1268>>25701000
   EQUATE  LOCKWORD'VIOLATION = 92;                            <<*1268>>25702000
                                                               <<*1268>>25703000
      ELSE  << ** FOPEN FAILED ** >>                           <<01268>>26505000
      <<********************************************>>         <<*1268>>26505001
      << TO PROVIDE A CONSISTENT USER INTERFACE     >>         <<*1268>>26505010
      << WE SHOULD NOT PROMPT FOR A SECOND LOCKWORD >>         <<*1268>>26505020
      << IF THE FIRST ATTEMPT TO FOPEN THE INPUT    >>         <<*1268>>26505030
      << FILE FAILS B/C OF A LOCKWORD VIOLATION.    >>         <<*1268>>26505040
      <<********************************************>>         <<*1268>>26505050
         BEGIN                                                 <<*1268>>26505100
         FCHECK (0, ERROR'CODE);                               <<*1268>>26505200
         IF ERROR'CODE <> LOCKWORD'VIOLATION THEN              <<*1268>>26505300
            BEGIN                                              <<*1268>>26510000
            AOPTIONS.ACCESS'BITS := EX'ACC;                    <<*1268>>26515000
            FILENUMBER :=                                      <<*1268>>26520000
               FOPEN( FORMALDES, FOPTIONS, AOPTIONS );         <<*1268>>26525000
            IF = THEN OPENOK := TRUE;                          <<*1268>>26530000
            END;                                               <<*1268>>26535000
         END;                                                  <<*1268>>26536000
      IF XRETJTENTRY (ENVFILENAME(1), BLANK, BLANK, BLANK,     <<A9767>>28795000
                                                               <<02192>>39774000
<< LDT array may be accessed while in split-stack, so  must >> <<02192>>39774100
<< be direct array.                                         >> <<02192>>39774200
                                                               <<02192>>39774300
LOGICAL ARRAY LDT(0:SIZE'OF'LDT'ENTRY - 1) = Q;                <<02192>>39775000
      BEGIN                                                    <<02192>>40135000
      END                                                      <<02192>>40155000
   ELSE                                                        <<02192>>40155100
                                                               <<02192>>40155200
<<   For any command except RESUMESPOOL, the spooler may be >> <<02192>>40155300
<< in a RIT wait on a forms message.  If so, the AWAKE call >> <<02192>>40155400
<< below will be ignored unless we cancel the RIT wait with >> <<02192>>40155500
<< a REMRITENTRY call. There is no penalty for calling REM- >> <<02192>>40155600
<< RITENTRY with the process not in RIT wait, so  we  don't >> <<02192>>40155700
<< bother to test for it. Also, REMRITENTRY wakes the spec- >> <<02192>>40155800
<< ified PIN but does not cause us to  wait.  This  may  be >> <<02192>>40155900
<< significant  in that otherwise the high priority spooler >> <<02192>>40156000
<< might be able to print several lines  on  unknown  forms >> <<02192>>40156100
<< before it heard from us that it shouldn't do that.       >> <<02192>>40156200
                                                               <<02192>>40156300
      REMRITENTRY (LDT'SPOOLER'PIN);                           <<02192>>40156400
   DOUBLE  ARRAY XDD'DSUBENTRY(*) = XDD'SUBENTRY;              <<09985>>40366000
$EDIT VOID=40375000                                            <<09984>>40375000
                                                               <<09984>>40625010
                                                               <<09984>>40625020
SUBROUTINE DELETE'ACTIVE'FILE;                                 <<09984>>40625030
                                                               <<09984>>40625040
BEGIN COMMENT --                                               <<09984>>40625050
  Some common code for DELETESPOOLFILE <ldev>/#Onnn, where the <<09984>>40625060
file is ACTIVE.  In particular, this code (moved  from  #Onnn) <<09984>>40625070
assures  that the SPOOLFILE IS ACTIVE, DELETED message is dis- <<09984>>40625080
played when the <ldev> form is used.                           <<09984>>40625090
;                                                              <<09984>>40625100
DELETE'RETURN := DELETEDEVFILE (DFID, FALSE);                  <<09984>>40625110
IF DELETE'RETURN = 0 THEN                                      <<09984>>40625120
   BEGIN                                                       <<09984>>40625130
                                                               <<09984>>40625140
<< Why are these tests here? -- ACTIVE devicefiles are nei- >> <<09984>>40625150
<< ther virtual devices nor on the class chain.             >> <<09984>>40625160
                                                               <<09984>>40625170
   LPDT'INDEX := XDDS'DEVICE * SIZE'OF'LPDT'ENTRY;             <<09984>>40625180
   IF LPDT'VIRTUAL'DEVICE OR XDDS'CLASS THEN   << Null case >> <<09984>>40625190
      ELSE CIERR (-SPACTLDEV, FIRSTPARM, %10000, XDDS'DEVICE); <<09984>>40625200
   END                                                         <<09984>>40625210
ELSE CIERR (-SPACTLDEVNODEL, , %10000, XDDS'DEVICE);           <<09984>>40625220
END;    << of DELETE'ACTIVE'FILE.                           >> <<09984>>40625230
$EDIT VOID=40830000                                            <<09984>>40830000
        BEGIN   << Device is spooled, determine in or out.  >> <<09984>>40930000
        IF LDT'SPOOL'STATE = LDT'OUTPUT'SPOOLED THEN           <<09984>>40930100
           BEGIN                                               <<09984>>40930200
           OUT := TRUE;                                        <<09984>>40930300
           XDD'DST := ODD'DST;                                 <<09984>>40930400
           XDD'SIR := ODD'SIR;                                 <<09984>>40930500
           END                                                 <<09984>>40930600
        ELSE                                                   <<09984>>40930700
           BEGIN                                               <<09984>>40930800
           OUT := FALSE;                                       <<09984>>40930900
           XDD'DST := IDD'DST;                                 <<09984>>40931000
           XDD'SIR := IDD'SIR;                                 <<09984>>40931100
           END;                                                <<09984>>40931200
        SAVEXDD := GETSIR (XDD'SIR);                           <<09984>>40935000
           RELSIR (XDD'SIR, SAVEXDD);                          <<09984>>40950000
$EDIT VOID=41035000                                            <<09984>>40980000
        END;    << Device is spooler, determine in or out.  >> <<09984>>40985000
      IF OUT THEN SFINDODD (DFID, XDDEP)                       <<09984>>40990000
             ELSE SFINDIDD (DFID, XDDEP);                      <<09984>>40995000
      MOVEFROMDSEG (XDD'SUBENTRY, XDD'DST, XDDEP.(1:15),       <<09984>>41000000
                    SIZE'OF'XDD'SUBENTRY);                     <<09984>>41005000
      RELSIR (XDD'SIR, SAVEXDD);                               <<09984>>41010000
      RELSIR (LDT'SIR, SAVELDT);                               <<09984>>41015000
      DELETE'ACTIVE'FILE;                                      <<09984>>41020000
            IF XDDSD'DISC'LABEL = 0D THEN                      <<09985>>41291000
               ERRNUM := EXPSPFNAME                            <<09985>>41292000
            ELSE IF XDDS'SPOOL'STATE = XDDS'ACTIVE THEN        <<09985>>41295000
               BEGIN                                           <<09985>>41300000
                  ELSE DELETE'ACTIVE'FILE                      <<09984>>41335000
$EDIT VOID=41445000                                            <<09984>>41340000
   INTEGER CLASS'ADDRESS, CLASS'LENGTH, NEW'DEVICE, NUMDEVS,   <<09989>>41785000
           CURRENT'DEVICE, NUMPARMS, PRI;                      <<09989>>41790000
      JMATORIGJLIST := NEW'DEVICE                              <<09989>>42230000
   ELSE JMATJLISTDEV := NEW'DEVICE;                            <<09989>>42235000
   COPIES := NEW'DEVICE := 0;                                  <<09989>>42460000
            NEW'DEVICE := BINARY (PARMPTR, LEN);               <<09989>>43180000
               NEW'DEVICE := GETCLASSBUF(1);  << DCT index. >> <<09989>>43355000
                  (NEW'DEVICE, CLASS'ADDRESS);                 <<09989>>43365000
               NEW'DEVICE := VERIFY'RLDEV (PARMPTR, LEN,       <<09989>>43525000
                                ERRNUM, PARMNUM, 1);           <<09989>>43530000
               IF VERIFY'MASTEROP (NEW'DEVICE) THEN RETURN;    <<09989>>43545000
               IF NOT CHECKASS (NEW'DEVICE) AND                <<09989>>43550000
               MOVEFROMDSEG (LDT, LDT'DST, NEW'DEVICE *        <<09989>>43585000
$EDIT VOID=43925000                                            <<09989>>43920000
      SAVE'JMAT'SIR := GETSIR (JMATSIR);                       <<09989>>43930000
      SAVE'LDT'SIR  := GETSIR (LDT'SIR);                       <<09989>>43935000
      SAVE'ODD'SIR  := GETSIR (ODD'SIR);                       <<09989>>43940000
      IF COMMAND'ALLOWED OR ASS'DFID THEN                      <<09989>>43941000
         BEGIN   << User has access to command or device.   >> <<09989>>43942000
               IF WAKE'SPOOLER THEN                            <<09989>>44006000
                  CURRENT'DEVICE := XDDS'DEVICE;               <<09989>>44007000
               IF NEW'DEVICE <> 0 THEN                         <<09989>>44010000
                  XDDS'DEVICE := NEW'DEVICE;                   <<09989>>44020000
$EDIT VOID=44195000                                            <<09989>>44185000
$EDIT VOID=44245000                                            <<09989>>44245000
               SENDSPOOLERMSG (CURRENT'DEVICE, NEWDIRECTIVE,   <<09989>>44250000
                  SPOOFLING, SPOOLINFO, ERRNUM, PARMNUM);      <<09989>>44255000
$EDIT VOID=44290000                                            <<09989>>44260000
            END;    << Finish processing if no errors yet.  >> <<09989>>44305000
$EDIT VOID=44315000                                            <<09989>>44310000
         PARMNUM := 0;                                         <<09989>>44335000
         ERRNUM := OPCOMMNOTALLOW;                             <<09989>>44340000
      RELSIR (ODD'SIR, SAVE'ODD'SIR);                          <<09989>>44346000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<09989>>44347000
      RELSIR (JMATSIR, SAVE'JMAT'SIR);                         <<09989>>44348000
      IF ERRNUM <> 0 THEN                                      <<09989>>44348100
         IF PARMNUM = 0 THEN                                   <<09989>>44348200
            CIERR (ERRNUM)   << No "^" under error message. >> <<09989>>44348300
         ELSE                                                  <<09989>>44348400
            CIERR (ERRNUM, FIRSTPARM);                         <<09989>>44348500
   LOGIMAGE (M'STARTSPOOL, PARMSP);   << Log oprat command. >> <<L9176>>44740000
            CHECKALLOW(M'STOPSPOOL) THEN                       <<02196>>46705000
|  baddb             - -12|     and call SROOSTER.      |      <<11545>>58070000
  IF XDDS'DEVICE <> 0 THEN   << Should never be 0, but...   >> <<11545>>59101000
     SROOSTER (IF LOGICAL (XDDS'CLASS) THEN -XDDS'DEVICE       <<11545>>59102000
                             ELSE  XDDS'DEVICE);               <<11545>>59103000
