         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
<<   write ring is O.K. for such requests if write reqstd.  >> <<09475>>00215000
<< In DEALLOCATE, add NO'ATTACHIO bit to FLAGS parm word to >> <<09475>>00215001
<<   let caller (read "FOPEN") return device resources dur- >> <<09475>>00215002
<<   ing error backout.  DEALLOCATEs FCLOSE and FREEDEVICEs >> <<09475>>00215003
<<   Device Close cause some drivers  to  kill  the  system >> <<09475>>00215004
<<   (SF923) because no ATTACHIO FOPEN was sent first.      >> <<09475>>00215005
<< Make sure ASKOP is called for tapes or SDISC even if de- >> <<09431>>00215010
<<   vice is owned by a user or by DEVREC/PVPROC. Some tape >> <<09431>>00215020
<<   drives and cartridge tapes take a long time AVRing and >> <<09431>>00215030
<<   this fix prevents ALLOCATE from returning  DEVICE  UN- >> <<09431>>00215040
<<   AVAILABLE during AVR.                                  >> <<09431>>00215050
<<   Extend the concepts in A8986 to assume  a  write  ring >> <<09475>>00215060
<< for  labeled serial disc write requests.  Prevents SDISC >> <<09475>>00215070
<< from bothering the operator.                             >> <<09475>>00215080
<<   Add initialization of  OBTAIN/RELEASE  data  structure >> <<09564>>00215090
<< for serial disc Gap Table extra data segment.            >> <<09564>>00215100
<<   TERM'REALLOCATE now doesn't reallocate  console.  Also >> <<01015>>00215110
<< won't remove XDD entries if MORGUE did that while abort- >> <<01015>>00215120
<< ing process to which terminal was reallocated.           >> <<01015>>00215130
<< When deallocating a device hold the sir a bit more, and  >> <<01466>>00215140
<< set the LDT table as LOCKED (new bit), so when somebody  >> <<01466>>00215150
<< is trying to allocate a device it will be rejected if the>> <<01466>>00215160
<< LDT is locked.  This was done for tables being inconsis- >> <<01466>>00215170
<< tant (LDT and XDD) with each other.                      >> <<01466>>00215180
<<   The following comments for fix #1235 were inadvertent- >> <<01555>>00215190
<< ly overwritten:                                          >> <<01555>>00215200
<<   Added Mounted Volume Table $INCLUDE file, with expand- >> <<01555>>00215210
<< ed MVTAB entry.  Changes made to procedure DISKALLOC.    >> <<01555>>00215220
<<   The following comments for fix #1263 were inadvertent- >> <<01554>>00215230
<< ly overwritten:                                          >> <<01554>>00215240
<<   Make sure SDISC data buffer segments are  released  in >> <<01554>>00215250
<< FORS'XDS'DEALLOC if not already released in FREEDEVICE.  >> <<01554>>00215260
<<   Added subroutine to ALLOCATE to write  blanks  in  the >> <<01395>>00215300
<< first  spoolfile  extent  after  getting its disc space. >> <<01395>>00215310
<< Prevents warmstart recovery routines from mistaking  old >> <<01395>>00215320
<< data for current data (at least in the first extent).    >> <<01395>>00215330
<<   Prevents SF661 by ensuring  that  the  LDT'DEVICE'TYPE >> <<11406>>00215400
<< written  back to the LDT entry is always the same as the >> <<11406>>00215410
<< one originally obtained from the entry.                  >> <<11406>>00215420
<<     This fix addresses the line drop problem in the case >> <<01465>>00215500
<<  of terminal reallocation. Reallocation is redefined to  >> <<01465>>00215510
<<  be "adding another alternate owner for the terminal".   >> <<01465>>00215520
<<  If the line drops, only the original owner is aborted.  >> <<01465>>00215530
<<  The fix includes:  the addition of GETLDTX procedure,   >> <<01465>>00215540
<<  TERM'REALLOCATE re-designed, ALLOCATE change to check   >> <<01465>>00215550
<<  for the alternate owner, and DEALLOCATE changes to get  >> <<01465>>00215560
<<  rid of all XDD entries and zero out LDTX'ALTER'PIN when >> <<01465>>00215570
<<  the file'use'count gets down to zero.                   >> <<01465>>00215580
<<    Limits MOVE in GETDEVINFO to 8 chars  or  less.  Pre- >> <<01555>>00215590
<< vents  exceeding  bounds  of  local array DEV'CLASS if a >> <<01555>>00215600
<< longer string is passed in.                              >> <<01555>>00215610
<<   During final deallocation, don't call FORS'XDS'DEALLOC >> <<01554>>00215620
<< to release serial disc resources if it's a labeled tape. >> <<01554>>00215630
<< This leaves the media positioned properly for subsequent >> <<01554>>00215640
<< FOPENs by the same process.  The LABELLED test was acci- >> <<01554>>00215650
<< dentally deleted by fix #1263.                           >> <<01554>>00215660
<<   Fix 01466 inadvertently caused incorrect tape  density >> <<11672>>00215670
<< information  to be placed in the LDT during device deal- >> <<11672>>00215680
<< location by updating that field with old info after FREE->> <<11672>>00215690
<< DEVICE had cleared it.  This fix causes the  LDT  to  be >> <<11672>>00215700
<< managed properly.                                        >> <<11672>>00215710
<<   Fix 11672 still left one path by which you could  exit >> <<11690>>00215720
<< DEALLOCATE holding the LDT SIR.  This fix corrects that. >> <<11690>>00215730
<<   The following comments for fix #1396 were inadvertent- >> <<U1779>>00215740
<< ly omitted:                                              >> <<U1779>>00215750
<<   Make sure LDT entry is valid before calling SPUTXDD in >> <<U1779>>00215760
<< ALLOCATE.  This avoids SF353.  (Fix #1396)               >> <<U1779>>00215770
<<   If DEALLOCATE sets LDT'LOCKED (see fix  11672),  don't >> <<U1779>>00215780
<< set  device  unowned  or wake DEVREC in FREEDEVICE.  Let >> <<U1779>>00215790
<< DEALLOCATE do it after acquiring LDT'SIR again. Prevents >> <<U1779>>00215800
<< DEVICE'UNAVAILABLE to new processes  trying  to  acquire >> <<U1779>>00215810
<< the device.                                              >> <<U1779>>00215820
<<   Corrects bug inadvertently introduced into  FIND'ENTRY >> <<01851>>00215830
<< of DEALLOCATE by fix #01465.  If one DEALLOCENTRY causes >> <<01851>>00215840
<< XDD to shrink before next link is obtained, next link is >> <<01851>>00215850
<< garbage and causes SF354.                                >> <<01851>>00215860
<<   The following comments for fix #1850 were inadvertent- >> <<02198>>00215861
<< ly overwritten:                                          >> <<02198>>00215862
<<   Make sure tape/SDISC LCB is cleared by FREEDEVICE (ex- >> <<02198>>00215863
<< cept for temporary FCLOSE of labeled  file).  This  pre- >> <<02198>>00215864
<< vents  old  LCB  contents  from influencing a subsequent >> <<02198>>00215865
<< FOPEN, causing anything from being able to write  on  an >> <<02198>>00215866
<< unexpired  labeled  tape without asking the operator, to >> <<01850>>00215870
<< SF86.                                                    >> <<01850>>00215880
<<   Avoid duplicate DFID numbers when system has  been  up >> <<02198>>00215890
<< long enough to start DFID's over at 1.                   >> <<02198>>00215900
<<   Preload operator response in ASKOP to 0 so the request >> <<02197>>00215910
<< fails if someone wakes the caller via REMRITENTRY.       >> <<02197>>00215920
<<   Limit alignment rack in FORMSALIGN to 132  characters, >> <<02199>>00215930
<< even if device is configured with a greater record width.>> <<02199>>00215940
<<   Prevent SF353 caused by reassigning LDEV of  spoolfile >> <<12131>>00215950
<< opened  by SPOOK for COPYing.  Problem caused by call to >> <<12131>>00215960
<< SRELINKODD while file is OPENED by FSOPEN -- virtual de- >> <<12131>>00215970
<< vice in subentry is no longer valid but is used by  SRE- >> <<12131>>00215980
<< LINKODD anyway.  If the virtual device has been acquired >> <<12131>>00215990
<< by another C.I.'s $STDIN, its LDT'XDD'HEAD'INDEX may  be >> <<12131>>00216000
<< redirected  to  the  class chain, which causes SF353 the >> <<12131>>00216010
<< next time the C.I. reopens $STDIN to RUN anything.       >> <<12131>>00216020
<<   This fix adds another variable that needs to  be  ini- >> <<12247>>00216100
<< tialized for Serial Disc.                                >> <<12247>>00216110
<<   Fixes bug introduced by Fix 02198.  SFINDODD no longer >> <<12292>>00216120
<< returns TRUE even if DFID not found.                     >> <<12292>>00216130
$EDIT VOID=00325000                                            <<01235>>00310000
$INCLUDE INCLMVTB                                              <<01235>>00386000
      END #,                                                   <<01395>>00785100
                                                               <<01395>>00785200
   DEF'MOVEDSEG =                                              <<01395>>00785300
      MOVEDSEG   (TARGET'DST, TARGET'OFFSET,                   <<01395>>00785400
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT);       <<01395>>00785500
         VALUE   TARGET'DST, TARGET'OFFSET,                    <<01395>>00785600
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT;        <<01395>>00785700
         LOGICAL TARGET'DST, TARGET'OFFSET,                    <<01395>>00785800
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT;        <<01395>>00785900
      BEGIN                                                    <<01395>>00786000
      X := TOS;                                                <<01395>>00786100
      ASSEMBLE (MDS 0);                                        <<01395>>00786200
      TOS := X;                                                <<01395>>00786300
PROCEDURE CLEANLDEV' (LDEV);                                   <<01850>>01025100
   VALUE   LDEV;                                               <<01850>>01025200
   INTEGER LDEV;                                               <<01850>>01025300
   OPTION  UNCALLABLE, EXTERNAL;                               <<01850>>01025400
  COMMENT -- Removes label info from the Logical Control Block <<01850>>01025500
(LCB) of the Tape Label Table (TLT) entry for LDEV.  CLEANLDEV <<01850>>01025600
causes SF86 if LDEV is not a tape or serial  disc.  CLEANLDEV' <<01850>>01025700
(an alternate entry point) does not.                           <<01850>>01025800
;                                                              <<01850>>01025900
$PAGE "   ***   SFINDDFID   ***"                               <<02198>>05385050
$CONTROL SEGMENT = ALLOCUTIL                                   <<02198>>05385100
                                                               <<02198>>05385150
LOGICAL PROCEDURE SFINDDFID (DFID);                            <<02198>>05385200
   VALUE   DFID;                                               <<02198>>05385250
   INTEGER DFID;                                               <<02198>>05385300
   OPTION  PRIVILEGED, UNCALLABLE;                             <<02198>>05385350
                                                               <<02198>>05385400
BEGIN COMMENT --                                               <<02198>>05385450
  SFINDDFID returns the XDD  segment-relative  offset  of  the <<02198>>05385500
subentry  which corresponds to DFID, or 0 if the subentry does <<02198>>05385550
not exist.  It has been extracted  from  SFINDODD/SFINDIDD  so <<02198>>05385600
that SPUTXDD can also use it to avoid duplicate DFID numbers.  <<02198>>05385650
                                                               <<02198>>05385700
Inputs:   DFID.(1:15).  The input or output devicefile ID num- <<02198>>05385750
          ber whose corresponding subentry is to be found.     <<02198>>05385800
                                                               <<02198>>05385850
          DFID.(0:1).  Must be 0.  IDD/ODD  is  determined  by <<02198>>05385900
          location of DB on entry (see Special considerations).<<02198>>05385950
                                                               <<02198>>05386000
Returns:  Result:  The XDD  segment-relative  address  of  the <<02198>>05386050
          subentry corresponding to DFID, or 0 if the subentry <<02198>>05386100
          could not be found.                                  <<02198>>05386150
                                                               <<02198>>05386200
          The condition code is not affected.                  <<02198>>05386250
                                                               <<02198>>05386300
Special considerations:  DB must be at the IDD or ODD  on  en- <<02198>>05386350
                         try and the corresponding SIR must be <<02198>>05386400
                         locked, same at exit.                 <<02198>>05386450
;                                                              <<02198>>05386500
INTEGER                                                        <<02198>>05386550
   MAX'WORD'ADDRESS;   << Last segment-relative address  in >> <<02198>>05386600
                       << currently-allocated  segment that >> <<02198>>05386650
                       << a subentry can start in.          >> <<02198>>05386700
                                                               <<02198>>05386750
LOGICAL ARRAY                                                  <<02198>>05386800
   XDD(*) = DB + 0;    << Required by XDD $INCLUDE file.    >> <<02198>>05386850
                                                               <<02198>>05386900
LOGICAL POINTER                                                <<02198>>05386950
   XDD'SUBENTRY;       << Required by XDD $INCLUDE file.    >> <<02198>>05387000
                                                               <<02198>>05387050
                                                               <<02198>>05387100
MAX'WORD'ADDRESS := XDD0'CURRENT'SECTORS * WORDS'PER'SECTOR    <<02198>>05387150
                    - XDD0'SUBENTRY'LENGTH;                    <<02198>>05387200
@XDD'SUBENTRY := XDD0'SUBENTRY'AREA;                           <<02198>>05387250
WHILE @XDD'SUBENTRY <= MAX'WORD'ADDRESS DO                     <<02198>>05387300
      IF XDD'SUBENTRY <> XDDS'UNUSED'SUBENTRY                  <<02198>>05387350
         AND INTEGER (XDDS'DFID'NUMBER) = DFID THEN            <<02198>>05387400
         BEGIN   << Found our subentry.                     >> <<02198>>05387450
         SFINDDFID := LOGICAL (@XDD'SUBENTRY);                 <<02198>>05387500
         RETURN;                                               <<02198>>05387550
         END                                                   <<02198>>05387600
      ELSE @XDD'SUBENTRY := @XDD'SUBENTRY +                    <<02198>>05387650
         INTEGER (XDD0'SUBENTRY'LENGTH);   << Try next.     >> <<02198>>05387700
SFINDDFID := 0;   << Fell through with no match.            >> <<02198>>05387750
END;    << of SFINDDFID                                     >> <<02198>>05387800
                 headache  --  we have to move the LDEV/Device <<02198>>05670000
   WHILE SFINDDFID (XDD0'NEXT'DFID) <> 0 DO                    <<02198>>06125100
      BEGIN   << This loop avoids duplicating DFID's.       >> <<02198>>06125200
      XDD0'NEXT'DFID := XDD0'NEXT'DFID + 1;                    <<02198>>06125300
      IF XDD0'NEXT'DFID = 0 THEN XDD0'NEXT'DFID := 1;          <<02198>>06125400
      END;    << This loop avoids duplicating DFID's.       >> <<02198>>06125500
  The bulk of the work is done in procedure SFINDDFID.         <<02198>>06655100
Inputs:   DFID.(1:15).  The input or output devicefile ID num- <<02198>>06665000
$EDIT VOID=06800000                                            <<02198>>06790000
$EDIT VOID=06830000                                            <<02198>>06830000
$EDIT VOID=06865000                                            <<02198>>06840000
$EDIT VOID=06920000                                            <<02198>>06920000
$EDIT VOID=07075000                                            <<02198>>07005000
                                                               <<02198>>07010000
<<   We want to return the result of SFINDDFID  to  XDD'AD- >> <<02198>>07015000
<< DRESS, but can't do so directly because DB is at the XDD >> <<02198>>07020000
<< now.  Use TOS until DB is back at the stack.             >> <<02198>>07025000
                                                               <<02198>>07030000
TOS := SFINDDFID (DFID);                                       <<12292>>07035000
IF XDD'ADDRESS <> 0 THEN                                       <<12292>>07090100
   XDD'ADDRESS := LOGICAL (XDD'ADDRESS) LOR (ODD & LSL(15));   <<12292>>07090200
SFINDODD := XDD'ADDRESS <> 0;                                  <<02198>>07091000
$PAGE "***  GETLDTX and PUTLDTX  ***"                          <<01465>>10790200
LOGICAL PROCEDURE GETLDTX(LDEV,BUF);                           <<01465>>10790300
VALUE LDEV;                                                    <<01465>>10790400
INTEGER LDEV; INTEGER ARRAY BUF;                               <<01465>>10790500
OPTION PRIVILEGED,UNCALLABLE;                                  <<01465>>10790600
                                                               <<01465>>10790610
COMMENT --                                                     <<01465>>10790620
  This procedure gets or puts (entry point PUTLDTX) the LDTX   <<01465>>10790630
  entry of the specified LDEV into/from BUF. It returns        <<01465>>10790640
  TRUE if it succeeds.  DB must be at stack and the caller     <<01465>>10790650
  should acquire the LDT sir if it is deemed necessary.        <<01465>>10790660
;   << end comment >>                                          <<01465>>10790670
                                                               <<01465>>10790680
BEGIN                                                          <<01465>>10790700
LOGICAL GET;                                                   <<01465>>10790800
LOGICAL ARRAY LDT (0:SIZE'OF'LDT'ENTRY -1);                    <<01465>>10790900
ENTRY PUTLDTX;                                                 <<01465>>10791000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<01465>>10791100
SUBROUTINE DEF'MOVETODSEG;                                     <<01465>>10791200
                                                               <<01465>>10791300
GET := TRUE;                                                   <<01465>>10791400
GO START;                                                      <<01465>>10791500
                                                               <<01465>>10791600
PUTLDTX:  GET := FALSE;                                        <<01465>>10791700
START:                                                         <<01465>>10791800
MOVEFROMDSEG (@LDT, LDT'DST, 0, SIZE'OF'LDT'ENTRY);            <<01465>>10791900
IF LDEV < 0 OR LDEV > INTEGER (LDT'NUM'ENTRIES) THEN           <<01465>>10792000
   RETURN; << INVALID LDEV; RETURN FALSE >>                    <<01465>>10792100
                                                               <<01465>>10792200
IF GET THEN                                                    <<01465>>10792300
   MOVEFROMDSEG (@BUF, LDT'DST, LDTX'BASE +                    <<01465>>10792400
      LDEV * SIZE'OF'LDTX'ENTRY, SIZE'OF'LDTX'ENTRY)           <<01465>>10792500
ELSE                                                           <<01465>>10792600
    MOVETODSEG (LDT'DST, LDTX'BASE +                           <<01465>>10792700
            LDEV * SIZE'OF'LDTX'ENTRY, @BUF,                   <<01465>>10792800
            SIZE'OF'LDTX'ENTRY);                               <<01465>>10792900
GETLDTX := TRUE;                                               <<01465>>10793000
END;                                                           <<01465>>10793100
   NAME'LENGTH := (MOVE DEVICE := DEVICE WHILE AN);            <<01555>>11285000
   IF NAME'LENGTH > 8 THEN                                     <<01555>>11290000
   MOVE DEV'CLASS := DEVICE WHILE ANS;                         <<01555>>11311000
   ;ARRAY MVTAB (0:SIZE'OF'MVTAB'ENTRY-1) = Q                  <<01235>>12585000
        ,MVTABX      << index into MVTAB >>                    <<01235>>12660000
        ,VOL'INDEX   << offset into MVTAB >>                   <<01235>>12661000
      SAVE'MVTAB'SIR := GETSIR (MVTAB'SIR);                    <<01235>>13390000
      MOVEFROMDSEG (@MVTAB, MVTAB'DST, MVTABX *                <<01235>>13410000
                    SIZE'OF'MVTAB'ENTRY, SIZE'OF'MVTAB'ENTRY); <<01235>>13415000
      HVOL:=MVTAB'VS'HVOL;     << highest volume index >>      <<01235>>13420000
      CYCP:=MVTAB'VS'CYCL;                                     <<01235>>13605000
      VOL'INDEX := SIZE'OF'MVTAB'VS'HEAD +                     <<01235>>13646000
                   (SIZE'OF'VOL'ENTRY * CYCP);                 <<01235>>13647000
      LDEV:=MVTAB'VOL'LDEV;                                    <<01235>>13650000
      IF PVALLOC THEN RELSIR (MVTAB'SIR, SAVE'MVTAB'SIR);      <<01235>>13750000
         BEGIN                                                 <<01235>>13971000
         VOL'INDEX := SIZE'OF'MVTAB'VS'HEAD +                  <<01235>>13972000
                      (SIZE'OF'VOL'ENTRY * V);                 <<01235>>13973000
         IF (MVTAB'VOL'LDEV = LOGICAL(LDEV) LAND               <<01235>>13975000
         END;                                                  <<01235>>13981000
         MVTAB'VS'CYCL := CYCP;                                <<01235>>14085000
         MOVETODSEG (MVTAB'DST, MVTABX * SIZE'OF'MVTAB'ENTRY,  <<01235>>14090000
                     @MVTAB, 1);                               <<01235>>14091000
   IF PVALLOC THEN RELSIR (MVTAB'SIR, SAVE'MVTAB'SIR);         <<01235>>14155000
         BEGIN                                                 <<01235>>14216000
         VOL'INDEX := SIZE'OF'MVTAB'VS'HEAD +                  <<01235>>14217000
                      (SIZE'OF'VOL'ENTRY * V);                 <<01235>>14218000
         IF (MVTAB'VOL'LDEV = LOGICAL(LDEV) LAND               <<01235>>14220000
         END;                                                  <<01235>>14226000
$EDIT VOID = 15175000                                          <<01465>>14729000
!------------------------------------------------------------  <<01465>>14730000
! This procedure is used mainly by TIP to reallocate a termnl  <<01465>>14731000
! to another CI. This is done so that the application Monitor  <<01465>>14732000
! can FOPEN the  terminal owned by TIP.  What it basically     <<01465>>14733000
! does is adding an other owner, by keeping the new CI'PIN in  <<01465>>14734000
! the LDTX, so that ALLOCATE will allow both sessions to open  <<01465>>14735000
! the terminal.                                                <<01465>>14736000
! If the NEW'CI'PIN is 0, then the procedure will get rid of   <<01465>>14737000
! the second owner. It also have to remove the extra XDD       <<01465>>14738000
! entries created by ALLOCATE for the second session.          <<01465>>14739000
! This procedure was originally written in V/E  and completely <<01465>>14740000
! re-written in UMIT. The way it worked before was it replaced <<01465>>14741000
! the LDT'MAIN'PIN with the new PIN. This lead to problem when <<01465>>14742000
! the modem line dropped, the whole apllication aborted.      <<<01465>>14743000
! Now when this happens,the TIP session will abort and the     <<01465>>14744000
! application process will get FREAD/FWRITE CCL return.        <<01465>>14745000
!------------------------------------------------------------  <<01465>>14746000
                                                               <<01465>>14747000
BEGIN                                                          <<01465>>14748000
INTEGER LDT'INDEX := 0,                                        <<01465>>14749000
        LDTX'INDEX := 0,                                       <<01465>>14750000
        CI'SESSION,          ! The session # of "other owner"  <<01465>>14751000
        SAVE'LDT'SIR;        ! return parm of GETSIR           <<01465>>14752000
LOGICAL ARRAY                                                  <<01465>>14753000
        LDT(0:SIZE'OF'LDT'ENTRY-1),                            <<01465>>14754000
        LDTX(0:SIZE'OF'LDTX'ENTRY-1);                          <<01465>>14755000
EQUATE  JPXREF'DST = %62;                                      <<01465>>14756000
                                                               <<01465>>14757000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<01465>>14758000
                                                               <<01465>>14759000
IF TERM'LDEV = SYSCONSLDEVNM THEN                              <<01465>>14760000
   RETURN; << can't fool around with console >>                <<01465>>14761000
SAVE'LDT'SIR := GETSIR (LDT'SIR);                              <<01465>>14762000
GETDEV (TERM'LDEV,LDT'DST,LDT); << get the ldev ldt >>         <<01465>>14763000
GETLDTX (TERM'LDEV, LDTX);                                     <<01465>>14764000
IF NEW'CI'PIN = 0 OR NEW'CI'PIN = INTEGER(LDT'MAIN'PIN) THEN   <<01465>>14765000
   BEGIN   << get rid of alternate owner >>                    <<01465>>14766000
   IF LDTX'ALTER'PIN <> 0 THEN                                 <<01465>>14767000
      BEGIN  << we do currently have an alternate owner >>     <<01465>>14768000
      MOVEFROMDSEG (@CI'SESSION, JPXREF'DST,                   <<01465>>14769000
         LDTX'ALTER'PIN,1); << get his session number >>       <<01465>>14770000
      REMOVE'FROM'XDD(LDT'XDD'HEAD'INDEX,CI'SESSION);          <<01465>>14771000
      LDTX'ALTER'PIN := 0;                                     <<01465>>14772000
      END;                                                     <<01465>>14773000
   END                                                         <<01465>>14774000
ELSE    << assign a new alternate owner >>                     <<01465>>14775000
   LDTX'ALTER'PIN := NEW'CI'PIN;                               <<01465>>14776000
PUTLDTX(TERM'LDEV,LDTX);                                       <<01465>>14777000
RELSIR(LDT'SIR,SAVE'LDT'SIR);                                  <<01465>>14778000
END;                                                           <<01465>>14779000
                                                               <<02199>>15236000
   EQUATE                                                      <<02199>>15237000
      MAX'PRINT'WIDTH = 66;   << words.                     >> <<02199>>15238000
         IBUF(0:MAX'PRINT'WIDTH-1),                            <<02199>>15250000
        IF RSIZE >  MAX'PRINT'WIDTH THEN                       <<02199>>15366000
           RSIZE := MAX'PRINT'WIDTH;                           <<02199>>15367000
         ANSWER := 0,   << To allow for REMRITENTRY.        >> <<02197>>15860000
            IF ACCESS <> 0 THEN   << 2 -- retn is Y/N ==> Y >> <<09475>>17090000
               IOUTBUF := TRUE;   <<      iff write request >> <<09475>>17091000
            IF LABELED = 1 AND SYSTAPEAVR = 1 THEN             <<09475>>17915000
               BEGIN   << If lbld SDISC wrt, wrt ring O.K.  >> <<09475>>17916000
               IF PTYPE = 2 AND ACCESS <> 0 THEN               <<09475>>17917000
                  IOUTBUF := TRUE;                             <<09475>>17917100
               GO TO LABOK;                                    <<09475>>17918000
               END;                                            <<09475>>17919000
   LOGICAL                                                     <<09564>>18720000
          SORFDISC := FALSE,   << Alloc. serial/foreign dsc >> <<09564>>18721000
          WRITE'RING;          << For S/FDISC, set by ASKOP >> <<09564>>18722000
   EQUATE INITARRAYSIZE = 10;                                  <<12247>>18725000
$EDIT VOID=18770000                                            <<09564>>18750000
         OWNEDBYCALLER = (JMPIN = INTEGER(LDT'MAIN'PIN) OR     <<01465>>18925000
                          JMPIN = INTEGER(LDTX'ALTER'PIN))     <<01465>>18926000
                          AND                                  <<01465>>18927000
                                                               <<01395>>19095050
<< These symbols are used by subroutine GET'1ST'EXTENT.     >> <<01395>>19095100
                                                               <<01395>>19095150
   EQUATE                                                      <<01395>>19095200
      SECTORS'PER'XDS = 128,                                   <<01395>>19095250
      SEGMENT'SIZE    = SECTORS'PER'XDS * WORDS'PER'SECTOR,    <<01395>>19095300
      WRITE           = 1;   << P'ATTACHIO function code.   >> <<01395>>19095350
                                                               <<01395>>19095400
   DOUBLE                                                      <<01395>>19095450
      DISC'ADDR;   << Current write address in extent.      >> <<01395>>19095500
                                                               <<01395>>19095550
   INTEGER                                                     <<01395>>19095600
      BLANKS     := "  ",                                      <<01395>>19095650
      DISC'ADDR'0 = DISC'ADDR,                                 <<01395>>19095700
      DISC'ADDR'1 = DISC'ADDR + 1,                             <<01395>>19095750
      LOOP'LIMIT,    << # of SEGMENT'SIZE writes in extent. >> <<01395>>19095800
      SHORT'WRITE;   << What's left over afterward.         >> <<01395>>19095850
SUBROUTINE DEF'MOVEDSEG;                                       <<01395>>19135250
      WRITE'RING) THEN                                         <<09564>>19830000
         IF NOT WRITE'RING AND                                 <<09564>>19855000
   IF LDT'AVAIL'TO'SYS AND                                     <<01466>>20130000
      NOT LDT'DOWN'PENDING AND                                 <<01466>>20131000
      NOT LDT'LOCKED THEN                                      <<01466>>20132000
      ELSE   << ASKOP for tape, SDISC even if owned/DEVREC. >> <<09431>>20305000
         IF LDT'DEVICE'TYPE = LDT'MAG'TAPE OR                  <<09431>>20310000
            LDT'DEVICE'TYPE = LDT'SERIAL'DISC THEN             <<09431>>20315000
$PAGE "   ***   ALLOCATE -- Subroutine GET'1ST'EXTENT   ***"   <<01395>>20335005
LOGICAL SUBROUTINE GET'1ST'EXTENT;                             <<01395>>20335010
                                                               <<01395>>20335015
BEGIN COMMENT --                                               <<01395>>20335020
  If ALLOCATE determines  that  the  devicefile  the  user  is <<01395>>20335025
FOPENing should in fact be a spoolfile it calls GET'1ST'EXTENT <<01395>>20335030
to acquire and initialize the disc space for the first extent. <<01395>>20335035
The file system will handle any other  disc  requirements  for <<01395>>20335040
the  file, including any additional extents which may be need- <<01395>>20335045
ed as the file is written.                                     <<01395>>20335050
  GET'1ST'EXTENT acquires an extent of  SYSSPEXTNTSEC  sectors <<01395>>20335055
(found in SYSGLOB),  then  initializes  it  to  ASCII  blanks. <<01395>>20335060
Should the system crash after the file label is posted but be- <<01395>>20335065
fore any data is  written,  the  initialization  prevents  the <<01395>>20335070
WARMSTART spoolfile recovery routines from mistaking previous- <<01395>>20335075
ly printed data in the same disc space for a current file.     <<01395>>20335080
  Spoolfile extents can be rather large (I've seen up to  2048 <<01395>>20335085
sectors).  To minimize the time needed to initialize this much <<01395>>20335090
disc space, we allocate a 16K extra data segment, fill it with <<01395>>20335095
blanks, then write this data segment as many times  as  needed <<01395>>20335100
to  fill  the extent (the last write may be shorter).  For our <<01395>>20335105
2K sector example, we need 32 such disc  writes.  Assuming  50 <<01395>>20335110
msec  per  disc  write, we could add one to two seconds to the <<01395>>20335115
time needed to complete the FOPEN.  Thus the tradeoff is  time <<01395>>20335120
versus  security  and  robust performance of the recovery rou- <<01395>>20335125
tines.                                                         <<01395>>20335130
;                                                              <<01395>>20335135
GET'1ST'EXTENT := FALSE;                                       <<01395>>20335140
                                                               <<01395>>20335145
<< Try to get a disc extent.                                >> <<01395>>20335150
                                                               <<01395>>20335155
IF DISKALLOC (0 <<spoolfile>>, 1 <<# extents>>,                <<01395>>20335160
   XDDSD'DISC'LABEL <<address>>, 0 <<not PV>>) <> 0 THEN       <<01395>>20335165
   RETURN;   << No space, or some other error.              >> <<01395>>20335170
                                                               <<01395>>20335175
<< Try to get an extra data segment.  Use an XDS  to  avoid >> <<01395>>20335180
<< increasing the user's stack requirements.                >> <<01395>>20335185
                                                               <<01395>>20335190
SEGNUM := GETDATASEG (SEGMENT'SIZE, SEGMENT'SIZE);             <<01395>>20335195
IF <> THEN                                                     <<01395>>20335200
   BEGIN   << Can't get the XDS, return the extent.         >> <<01395>>20335205
   SEGNUM := 0;   << Always leave this at 0 if we fail.     >> <<01395>>20335210
   DISKDEALLOC (0, 0, %201, XDDSD'DISC'LABEL);                 <<01395>>20335215
   RETURN;                                                     <<01395>>20335220
   END;                                                        <<01395>>20335225
                                                               <<01395>>20335230
<< Fill the segment with blanks.                            >> <<01395>>20335235
                                                               <<01395>>20335240
MOVETODSEG (SEGNUM, 0, @BLANKS, 1);               <<1st word>> <<01395>>20335245
MOVEDSEG (SEGNUM, 1, SEGNUM, 0, SEGMENT'SIZE-1);  <<The rest>> <<01395>>20335250
                                                               <<01395>>20335255
<< The following expression (SYSSPEXTNTSEC)  **  WORDS'PER' >> <<01395>>20335260
<< SECTOR  //  SEGMENT'SIZE)  calculates  how many times we >> <<01395>>20335265
<< have to write a full extra data segment (LOOP'LIMIT) and >> <<01395>>20335270
<< how much is left over (SHORT'WRITE).  Forgive the  TOS's >> <<01395>>20335275
<< and ASSEMBLE statement, but there's no other way to pre- >> <<01395>>20335280
<< vent SPL from deleting either the remainder or the  quo- >> <<01395>>20335285
<< tient,  and  there's  really  no  need to calculate this >> <<01395>>20335290
<< twice.  Remember this is a subroutine, so  be  sure  you >> <<01395>>20335295
<< manage  TOS  correctly lest you get a rude surprise when >> <<01395>>20335300
<< you exit.                                                >> <<01395>>20335305
                                                               <<01395>>20335310
TOS := SYSSPEXTNTSEC ** WORDS'PER'SECTOR;                      <<01395>>20335315
TOS := SEGMENT'SIZE;                                           <<01395>>20335320
ASSEMBLE (LDIV);                                               <<01395>>20335325
SHORT'WRITE := TOS;   << The remainder, or MODD function.   >> <<01395>>20335330
LOOP'LIMIT := TOS;    << The quotient.                      >> <<01395>>20335335
                                                               <<01395>>20335340
<< We can't modify the disc address in the XDD entry, so we >> <<01395>>20335345
<< use a local variable.  Using true double-length arithme- >> <<01395>>20335350
<< tic also solves the problem of incrementing over a  word >> <<01395>>20335355
<< boundary.                                                >> <<01395>>20335360
                                                               <<01395>>20335365
TOS := XDDS'MSW'LABEL;                                         <<01395>>20335370
TOS := XDDS'LSW'LABEL;                                         <<01395>>20335375
DISC'ADDR := TOS;                                              <<01395>>20335380
I := -1;                                                       <<01395>>20335385
WHILE (I := I + 1) < LOOP'LIMIT DO                             <<01395>>20335390
   BEGIN   << Write out one XDS.  1st parm is still LDEV.   >> <<01395>>20335395
   TOS := P'ATTACHIO (XDDS'SPOOFLE'VT'INDEX, 0, SEGNUM, 0,     <<01395>>20335400
          WRITE, SEGMENT'SIZE, DISC'ADDR'0, DISC'ADDR'1, 1);   <<01395>>20335405
   DEL;   << Never mind the transmission log.               >> <<01395>>20335410
   IF TOS.(13:3) <> 1 THEN GO RETURN'EXTENT;                   <<01395>>20335415
   DISC'ADDR := DISC'ADDR + DOUBLE (SECTORS'PER'XDS);          <<01395>>20335420
   END;                                                        <<01395>>20335425
IF SHORT'WRITE <> 0 THEN                                       <<01395>>20335430
   BEGIN   << Fractional XDS left over, write it here.      >> <<01395>>20335435
   TOS := P'ATTACHIO (XDDS'SPOOFLE'VT'INDEX, 0, SEGNUM, 0,     <<01395>>20335440
          WRITE, SHORT'WRITE, DISC'ADDR'0, DISC'ADDR'1, 1);    <<01395>>20335445
   DEL;                                                        <<01395>>20335450
   IF TOS.(13:3) = 1 THEN                                      <<01395>>20335455
      GET'1ST'EXTENT := TRUE                                   <<01395>>20335460
   ELSE                                                        <<01395>>20335465
                                                               <<01395>>20335470
RETURN'EXTENT:                                                 <<01395>>20335475
                                                               <<01395>>20335480
      DISKDEALLOC (0, 0, %201, XDDSD'DISC'LABEL);              <<01395>>20335485
   END     << Fractional XDS left over, write it here.      >> <<01395>>20335490
ELSE                                                           <<01395>>20335495
   GET'1ST'EXTENT := TRUE;   << All done w/o short write.   >> <<01395>>20335500
RELDATASEG (SEGNUM);                                           <<01395>>20335505
SEGNUM := 0;                                                   <<01395>>20335510
END;    << of GET'1ST'EXTENT                                >> <<01395>>20335515
                                                               <<09883>>20880100
<<   When opening an AdvancedNet reverse virtual  terminal, >> <<09883>>20880200
<< we are always supplied a job number and type of 0 and 0. >> <<09883>>20880300
<< Thus, if such a terminal is already allocated to one  DS >> <<09883>>20880400
<< server process and an unrelated DS server tries to allo- >> <<09883>>20880500
<< cate it again, the above checks will (incorrectly) allow >> <<09883>>20880600
<< it.  To prevent this, the next statement checks for  the >> <<09883>>20880700
<< job  number  0  condition.  This test assumes that no DS >> <<09883>>20880800
<< server will ever want to re-open its own terminal.       >> <<09883>>20880900
<<   The only other legal file with a job number  and  type >> <<09883>>20881000
<< of  0  is a :DATA file, and that only while it is READY. >> <<09883>>20881100
<< Once it has been OPENed, its XDD entry assumes  the  job >> <<09883>>20881200
<< number and type of the job/session which opened it. Thus >> <<09883>>20881300
<< this code will not stumble over such a file.             >> <<09883>>20881400
                                                               <<09883>>20881500
      IF JNUM = 0 THEN GO TO NEXT'LINK;                        <<09883>>20881600
      IF LDT'LOCKED THEN                                       <<01466>>21701000
         BEGIN                                                 <<01466>>21702000
         ALLOCATE := DEVICE'UNAVAILABLE;                       <<01466>>21703000
         GO BAD2;                                              <<01466>>21704000
         END;                                                  <<01466>>21704100
            IF NOT GET'1ST'EXTENT THEN                         <<01395>>23425000
$EDIT VOID=23900000                                            <<09564>>23885000
            MOVE TEMPDESC := (-1,      << JUSTALLOCATED     >> <<09564>>23886000
                               0,      << For WRITE'RING    >> <<09564>>23887000
                               0,      << FATALERROR        >> <<09564>>23888000
                               0,      << VOLUME'FATAL      >> <<09564>>23889000
                               0,      << NON'VOL'SPECIFIC  >> <<12247>>23889100
                              MEMSIZE, << Size of GPT XDS   >> <<09564>>23890000
                              4(0));   << OBTN/RLS struct.  >> <<09564>>23891000
            TEMPDESC(1) := WRITE'RING;  << There we are.    >> <<09564>>23892000
$EDIT VOID=24125000                                            <<01396>>23965000
$EDIT VOID=24275000                                            <<11406>>24275000
         GETLDT'LPDT (TRYDEV);   << Refills LDT, sets LPDT. >> <<11406>>24280000
<< Update LDT so that SPUTXDD (below) has a valid  LDT'XDD' >> <<01396>>24400100
<< HEAD'INDEX.  Don't set LDT'MAIN'PIN and LDT'FILE'USE'CNT >> <<01396>>24400200
<< yet.  These have to wait to  see  if  SPUTXDD  succeeds. >> <<01396>>24400300
<< This means another call to PUTDEV later.  Tough.         >> <<01396>>24400400
                                                               <<01396>>24400500
         PUTDEV (ALLOCDEV, LDT'DST, LDT);                      <<01396>>24400600
                                                               <<01396>>24400700
$EDIT VOID=24435000                                            <<U1779>>24435000
   IF UPDATEXDD THEN                                           <<01396>>24470100
      BEGIN   <<NEW OR ALTERED ENTRY>>                         <<01396>>24470200
      IF @XDD'ADDRESS = 0 THEN                                 <<01396>>24470300
         BEGIN   << Add new subentry.                       >> <<01396>>24470400
                                                               <<01396>>24470500
<< SPUTXDD allocates space for our new subentry in the XDD, >> <<01396>>24470600
<< then links it in.  It needs to know:  IDD or ODD (OLDREQ >> <<01396>>24470700
<< means IDD) (1st parm), and whether to link it to an LDEV >> <<01396>>24470800
<< chain or to the class chain (2nd parm, > 0 ==> LDEV, < 0 >> <<01396>>24470900
<< ==> class).  It also needs the new subentry image  (XDD' >> <<01396>>24471000
<< SUBENTRY).  It  returns the XDD segment-relative address >> <<01396>>24471100
<< where the subentry was linked  in  XDD'ADDRESS.  SPUTXDD >> <<01396>>24471200
<< also assigns the devicefile ID (DFID) number.            >> <<01396>>24471300
                                                               <<01396>>24471400
         IF SPUTXDD ((NOT OLDREQ), IF XDDS'CLASS THEN          <<01396>>24471500
                    -XDDS'DEVICE ELSE XDDS'DEVICE,             <<01396>>24471600
                    XDD'SUBENTRY, XDD'ADDRESS) <> 0 THEN       <<01396>>24471700
            BEGIN                                              <<01396>>24471800
            ALLOCATE := NO'ROOM'IN'XDD;                        <<01396>>24471900
            GO BADEXIT;                                        <<01396>>24472000
            END;                                               <<01396>>24472100
                                                               <<01396>>24472200
<< SPUTXDD returns ODD/IDD as 1/0 in @XDD'ADDRESS.(0:1). We >> <<01396>>24472300
<< can't use it, so we must remove it.                      >> <<01396>>24472400
                                                               <<01396>>24472500
         @XDD'ADDRESS := @XDD'ADDRESS & LSL(1) & LSR(1);       <<01396>>24472600
         END                                                   <<01396>>24472700
      ELSE                                                     <<01396>>24472800
         BEGIN   << SPUTXDD linked new, we move modified.   >> <<01396>>24472900
         MOVETODSEG (XDD'DST, @XDD'ADDRESS, @XDD'SUBENTRY,     <<01396>>24473000
                     SIZE'OF'XDD'SUBENTRY);                    <<01396>>24473100
         END;                                                  <<01396>>24473200
      IF INITIAL AND NOT REALD THEN                            <<U1779>>24473210
         LPDT'XDD'SUBENTRY'PTR := @XDD'ADDRESS;                <<U1779>>24473220
      END;   <<NEW OR ALTERED ENTRY>>                          <<01396>>24473300
   IF SAVETYPE=LDT'TERMINAL AND JMPIN=INTEGER(LDTX'ALTER'PIN)  <<01465>>24474600
      THEN                                                     <<01465>>24474700
      << alternate CI temporarily owns the terminal >>         <<01465>>24474800
   ELSE                                                        <<01465>>24474900
      LDT'MAIN'PIN := JMPIN; << put owner PIN in LDT >>        <<01465>>24475000
$EDIT VOID=24540000                                            <<11406>>24540000
   LDT'DEVICE'TYPE := SAVETYPE;   << Restore hardware type. >> <<11406>>24545000
$PAGE   "   ***   TEST'RE'LOGON   ***"                        <<<U1779>>25137010
$CONTROL SEGMENT = ALLOCUTIL                                   <<U1779>>25137020
LOGICAL PROCEDURE TEST'RE'LOGON (LDEV);                        <<U1779>>25137030
   VALUE   LDEV;                                               <<U1779>>25137040
   INTEGER LDEV;                                               <<U1779>>25137050
   OPTION  PRIVILEGED, UNCALLABLE, INTERNAL;                   <<U1779>>25137060
                                                               <<U1779>>25137070
BEGIN COMMENT --                                               <<U1779>>25137080
  In MPE it is not required that a user log off explicitly via <<U1779>>25137090
:EOJ or :BYE -- s/he may also do so implicitly by  logging  on <<U1779>>25137100
to  a new job or session (:JOB or :HELLO) or entering :DATA to <<U1779>>25137110
turn the device into a data file.  In these situations the de- <<U1779>>25137120
vice is deallocated for the old C.I., then  reopened  for  the <<U1779>>25137130
new one (or the data file). TEST'RE'LOGON is called as part of <<U1779>>25137140
device deallocation and returns TRUE if the end-of-file condi- <<U1779>>25137150
tion which caused it is a logon  condition  (:JOB,  :HELLO  or <<U1779>>25137160
:DATA),  because in this case our caller must AWAKEn DEVREC to <<U1779>>25137170
process the logon after the device is  fully  deallocated  for <<U1779>>25137180
the current C.I.                                               <<U1779>>25137190
  The strange code which follows has been extracted from FREE- <<U1779>>25137200
DEVICE because conditions sometimes require DEALLOCATE to call <<U1779>>25137210
it as well.  Better this kind of code in one place than  many. <<U1779>>25137220
It causes TEST'RE'LOGON to return TRUE iff:                    <<U1779>>25137230
1.  A :DATA, :HELLO or :JOB has been detected (the  EOF  field <<U1779>>25137240
    in the LPDT is even -- very table-dependent), -OR-         <<U1779>>25137250
2.  The device is not interactive but is job or data accepting <<U1779>>25137260
    (say, a spooled input device).                             <<U1779>>25137270
;                                                              <<U1779>>25137280
DEFINE                                                         <<U1779>>25137290
   LPDT'INDEX = LDEV * INTEGER (LPDT'ENTRY'SIZE)#;             <<U1779>>25137300
                                                               <<U1779>>25137310
TEST'RE'LOGON := FALSE;                                        <<U1779>>25137320
DISABLE;                                                       <<U1779>>25137330
IF LPDT'EOF'TYPE <> 0 AND NOT LPDT'EOF'TYPE                    <<U1779>>25137340
   OR NOT LPDT'INTERACTIVE AND                                 <<U1779>>25137350
      (LPDT'JOB'ACCEPT OR LPDT'DATA'ACCEPT) THEN               <<U1779>>25137360
   TEST'RE'LOGON := TRUE;                                      <<U1779>>25137370
ENABLE;                                                        <<U1779>>25137380
END;    << of TEST'RE'LOGON                                 >> <<U1779>>25137390
PROCEDURE FREEDEVICE (LDEV, WAIT, FLAGS);                      <<01850>>25155000
   VALUE   WAIT, LDEV, FLAGS;                                  <<01850>>25160000
   LOGICAL FLAGS;                                              <<01850>>25175000
                     RE'LOGON := FALSE;                        <<U1779>>25295000
   LOGICAL           QFLAGS := FALSE;                          <<01850>>25305000
<< The following DEFINEs must change if their  counterparts >> <<01850>>25310100
<< in DEALLOCATE change.                                    >> <<01850>>25310200
                                                               <<01850>>25310300
   DEFINE            << INPUT PARAMETER BREAKDOWN: >>          <<01850>>25310400
                     LABELLED    = QFLAGS.(3:1) #,             <<01850>>25310500
                     NO'ATTACHIO = QFLAGS.(1:1) #;             <<01850>>25310600
   IF Q4.(15:1) = 1 THEN QFLAGS := FLAGS;                      <<01850>>25355000
      RE'LOGON := TEST'RE'LOGON (LDEV);                        <<U1779>>25420000
$EDIT VOID=25495000                                            <<U1779>>25425000
   IF RE'LOGON THEN                                            <<U1779>>25530000
                                                               <<U1779>>25530100
<<   If we are called from DEALLOCATE, the  LDT'LOCKED  bit >> <<U1779>>25530200
<< may be set. If so, we should bypass the code below which >> <<U1779>>25530300
<< AWAKEns DEVREC.  This is because DEVREC would immediate- >> <<U1779>>25530400
<< ly cause UCOP to try to allocate this device for  a  new >> <<U1779>>25530500
<< C.I.  while  we (the old C.I.) still have it locked, and >> <<U1779>>25530600
<< the allocation would fail.  For  this  case,  DEALLOCATE >> <<U1779>>25530700
<< must  repeat the TEST'RE'LOGON we did earlier, then wake >> <<U1779>>25530800
<< DEVREC if necessary. >>                                     <<U1779>>25530900
                                                               <<U1779>>25531000
      IF NOT LDT'LOCKED THEN                                   <<U1779>>25531100
         BEGIN                                                 <<U1779>>25535000
         DISABLE;                                              <<U1779>>25540000
         LPDT'DEV'OWN'STATE := LPDT'SERVICE'REQ;               <<U1779>>25545000
         LPDT'SERV'REQ'COUNT := LPDT'SERV'REQ'COUNT + 1;       <<U1779>>25550000
         ENABLE;                                               <<U1779>>25555000
         AWAKE (SYSDEVRECPCB, JUNKWAIT, 0);                    <<U1779>>25560000
         END                                                   <<U1779>>25565000
      ELSE    << LDT is LOCKED -- null ELSE clause.         >> <<U1779>>25566000
      BEGIN   << Not RE'LOGON -- normal cleanup.            >> <<U1779>>25575000
         IF NOT LABELLED THEN                                  <<01850>>25585000
<<   Close device (unless it hasn't been fully opened).     >> <<01850>>25630000
                                                               <<01850>>25630100
            IF NOT NO'ATTACHIO THEN                            <<01850>>25634000
               ATTACHIO(LDEV,0,0,0,4,0,0,0,IF WAIT THEN 1      <<01850>>25635000
                                                   ELSE %17);  <<01850>>25640000
            CLEANLDEV' (LDEV);   << Clear tape/SDISC LCB.   >> <<01850>>25641000
                                                               <<U1779>>25645100
<<   If we are called from DEALLOCATE, the  LDT'LOCKED  bit >> <<U1779>>25645200
<< may be set.  If so, we should not set the device unowned >> <<U1779>>25645300
<< here because other routines, relying on this field,  may >> <<U1779>>25645400
<< try  to allocate such a device while it is still locked, >> <<U1779>>25645500
<< and the allocation will fail.  For this case, DEALLOCATE >> <<U1779>>25645600
<< must manage the ownership field and also wake UCOP.      >> <<U1779>>25645700
                                                               <<U1779>>25645800
      IF NOT LDT'LOCKED THEN                                   <<U1779>>25645900
         BEGIN                                                 <<U1779>>25646000
         DISABLE;                                              <<U1779>>25650000
         LPDT'DEV'OWN'STATE := LPDT'NOT'OWNED;                 <<U1779>>25655000
         ENABLE;                                               <<U1779>>25660000
         IF NOT (NOWOFFLINE) THEN                              <<U1779>>25665000
            BEGIN                                              <<U1779>>25670000
            DISABLE;                                           <<U1779>>25710000
            SYSDEVAVAIL := TRUE;                               <<U1779>>25715000
            TOS := SYSWAITFORDEV;                              <<U1779>>25720000
            SYSWAITFORDEV := FALSE;                            <<U1779>>25725000
            ENABLE;                                            <<U1779>>25730000
            IF TOS THEN AWAKE (SYSUCOPPCB, JUNKWAIT, 0);       <<U1779>>25735000
            END;    << NOT (NOWOFFLINE)                     >> <<U1779>>25736000
         END;       << NOT LDT'LOCKED                       >> <<U1779>>25740000
      END;    << Not RE'LOGON -- normal cleanup.            >> <<U1779>>25745000
$EDIT VOID=25965000                                            <<01263>>25965000
$EDIT VOID=26160000                                            <<01263>>26100000
                                                               <<01263>>26102000
COMMENT --                                                     <<01263>>26104000
  The Gap Table extra data segment exists only if  the  device <<01263>>26106000
is  being used as a serial disc, but the Foreign Disc Facility <<01263>>26108000
uses the LDTX entry as well.  Thus  the  LDTX  entry  must  be <<01263>>26110000
cleared  in  any  case.  In addition, the Serial Disc Facility <<01263>>26112000
(SDISC) acquires and manages two data buffer  segments.  These <<01263>>26114000
have  normally  already been returned via the Device Close AT- <<01263>>26116000
TACHIO function call in FREEDEVICE.  However, if the  original <<01263>>26118000
device FOPEN fails, the Device Close call bypassed (the NO'AT- <<01263>>26120000
TACHIO flag in DEALLOCATE) to avoid SF923's  on  some  DataCom <<01263>>26122000
devices.  If  so, SDISC still has its data buffers, so we must <<01263>>26124000
return them here.                                              <<01263>>26126000
;                                                              <<01263>>26128000
IF LDTX'SDISC'GPT'XDS > 1 THEN                                 <<01263>>26130000
   BEGIN   << Serial disc, release all XDS's, clear LPDT.   >> <<01263>>26132000
   IF LDTX'SDISC'DBUFS'ALLOC THEN                              <<01263>>26134000
      BEGIN   << Still have data buffers, return them now.  >> <<01263>>26136000
      ATTACHIO (LDEV, 0, 0, 0, 10, 0, 0, 0, 1);                <<01263>>26138000
      LDTX'SDISC'DBUFS'ALLOC := 0;   << Clear local copy.   >> <<01263>>26140000
      END;                                                     <<01263>>26142000
   RELDATASEG (LDTX'SDISC'GPT'XDS);                            <<01263>>26144000
   END;    << Serial disc, release all XDS's, clear LPDT.   >> <<01263>>26180000
LDTX'SERIAL'OR'FOREIGN := FALSE;                               <<01263>>26181000
LDTX'SDISC'GPT'XDS := 0;                                       <<01263>>26182000
MOVETODSEG (LDT'DST, LDTX'BASE + LDEV *                        <<01263>>26183000
            SIZE'OF'LDTX'ENTRY, @LDTX, SIZE'OF'LDTX'ENTRY);    <<01263>>26184000
                                                               <<09389>>26310250
<<   The NO'ATTACHIO bit should be set whenever we want  to >> <<09389>>26310500
<< give back resources acquired by ALLOCATE but do not want >> <<09389>>26310750
<< to perform the various I/O calls associated with  normal >> <<09389>>26311000
<< device deallocation.  FOPEN will usually be the only one >> <<09389>>26311250
<< to use this feature, when it  has  called  ALLOCATE  but >> <<09389>>26311500
<< then finds itself unable to complete the FOPEN.          >> <<09389>>26311750
                     NO'ATTACHIO =     DEVPARM0.(1:1) #,       <<09389>>26392500
$PAGE "   ***   DEALLOCATE - subroutines ATACHIO, SET'UNOWNED" <<U1779>>26545000
DOUBLE SUBROUTINE ATACHIO (LDEV, QMISC, DSTX, OFFSET,          <<09389>>26545250
                           FUNCTION, COUNT, P1, P2, FLAGS);    <<09389>>26545500
   VALUE   LDEV, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1, P2, <<09389>>26545750
           FLAGS;                                              <<09389>>26546000
   INTEGER LDEV, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1, P2, <<09389>>26546250
           FLAGS;                                              <<09389>>26546500
                                                               <<09389>>26546750
BEGIN COMMENT --                                               <<09389>>26547000
  A shell for the real ATTACHIO calls in DEALLOCATE, this sub- <<09389>>26547250
routine allows us to filter out the NO'ATTACHIO calls here in- <<09389>>26547500
stead of throughout the procedure.  If ATTACHIO is called, the <<09389>>26547750
subroutine returns that procedure's status.  If  the  call  is <<09389>>26548000
skipped, a normal completion (1, 0) is returned.               <<09389>>26548250
;                                                              <<09389>>26548500
ATACHIO := [16/1, 16/0]D;   << Normal (no error) return.    >> <<09389>>26548750
IF NOT NO'ATTACHIO THEN                                        <<09389>>26549000
   ATACHIO := ATTACHIO (LDEV, QMISC, DSTX, OFFSET, FUNCTION,   <<09389>>26549250
                        COUNT, P1, P2, FLAGS);                 <<09389>>26549500
END;   << of ATACHIO.                                       >> <<09389>>26549750
SUBROUTINE SET'UNOWNED'WAKE'UCOP;                              <<U1779>>26550100
                                                               <<U1779>>26550200
BEGIN COMMENT --                                               <<U1779>>26550300
  Some common code to free LDT'LOCKED  real  devices  and  all <<U1779>>26550400
virtual devices.                                               <<U1779>>26550500
;                                                              <<U1779>>26550600
DISABLE;                                                       <<U1779>>26550700
LPDT'DEV'OWN'STATE := LPDT'NOT'OWNED;                          <<U1779>>26550800
                                                               <<U1779>>26550900
  COMMENT -- We communicate with UCOP  through  some  bits  in <<U1779>>26551000
SYSGLOB.  We set a bit saying we are freeing up a device. Then <<U1779>>26551100
we see if UCOP is waiting for a device to become free (another <<U1779>>26551200
bit).  If so we AWAKEn UCOP, because we have just freed one it <<U1779>>26551300
may be able to use.  We also clear the UCOP wait bit.          <<U1779>>26551400
;                                                              <<U1779>>26551500
SYSDEVAVAIL := TRUE;                                           <<U1779>>26551600
TOS := SYSWAITFORDEV;                                          <<U1779>>26551700
SYSWAITFORDEV := FALSE;                                        <<U1779>>26551800
ENABLE;                                                        <<U1779>>26551900
IF TOS THEN AWAKE (SYSUCOPPCB, JUNKWAIT, 0);                   <<U1779>>26552000
END;    << SET'UNOWNED'WAKE'UCOP                            >> <<U1779>>26552100
$PAGE "   ***   DEALLOCATE - subroutine FIND'ENTRY   ***"      <<U1779>>26554900
This fix is to put in a loop for removing XDD entries. It is   <<01465>>26615100
neccessary because now that we permit a terminal to have an    <<01465>>26615200
alternate owner (see procedure TERM'REALLOCATE), we may have   <<01465>>26615300
more than one ODD or IDD entries. So, in the final deallocatn  <<01465>>26615400
we need to clean up all of them.                               <<01465>>26615500
            OR NOT ALLOCED AND XDDS'SPOOL'STATE = XDDS'READY   <<09389>>26670000
FIND'ENTRY := @XDD'SUBENTRY; << return what we found >>        <<01465>>26686000
IF REMOVE THEN                                                 <<01465>>26694000
   WHILE @XDD'SUBENTRY <> XDDS'END'OF'CHAIN                    <<01465>>26695000
   DO                                                          <<01465>>26700000
   TOS := XDDS'NEXT'SUBENTRY;   << Save during DEALLOCENTRY >> <<01851>>26706000
   @XDD'SUBENTRY := TOS;   << Use next link saved earlier.  >> <<01851>>26721000
$PAGE "   *** DEALLOCATE - procedure body   ***"               <<09389>>26745000
             ATACHIO (LDEV, 0, 0, 0, 3, 0, 0, 0, 7);           <<09389>>26945000
              RELSIR (LDT'SIR, SAVE'LDT'SIR);                  <<09389>>26975000
              ATACHIO (LDEV, 0, 0, 0, 3, 0, 1, 0, 1);          <<09389>>26980000
              SAVE'LDT'SIR := GETSIR (LDT'SIR);                <<09389>>26985000
                ATACHIO (LDEV, 0, 0, 0, 3, 0, 0, 0, %17);      <<09389>>27015000
               BEGIN                                           <<01465>>27134000
               LDTX'ALTER'PIN := 0;                            <<01465>>27136100
               PUTLDTX(LDEV,LDTX);                             <<01465>>27136200
               END;                                            <<01465>>27136300
$EDIT VOID=27160000                                            <<01466>>27150000
$EDIT VOID=27180000                                            <<11672>>27165000
                                                               <<11672>>27225010
  COMMENT -- LDT'LOCKED is a secondary semaphore used by  this <<11672>>27225020
procedure  and ALLOCATE.  While this bit is set, ALLOCATE will <<11672>>27225030
report DEVICE UNAVAILABLE even if other MPE  tables  disagree. <<11672>>27225040
The  reason  is that at this point the ODD and LDT entries for <<11672>>27225050
LDEV are inconsistent, and we cannot hold the LDT  SIR  around <<11672>>27225060
the  ATACHIO  calls  below.  LDT'LOCKED prevents ALLOCATE from <<11672>>27225070
misinterpreting the inconsistent table entries.                <<11672>>27225080
;                                                              <<11672>>27225100
                  LDT'LOCKED := TRUE;                          <<11672>>27226000
                  MOVETODSEG (LDT'DST, LDEV*SIZE'OF'LDT'ENTRY, <<11672>>27227000
                              @LDT, SIZE'OF'LDT'ENTRY);        <<11672>>27228000
                  RELSIR (LDT'SIR, SAVE'LDT'SIR);              <<11672>>27229000
                     ATACHIO (LDEV,0,0,0,186,0,0,0,1);         <<09389>>27295000
                     ATACHIO (LDEV,0,0,0,145,0,0,0,1);         <<09389>>27320000
                     ATACHIO (LDEV,0,0,0,  3,0,0,0,1);         <<09389>>27325000
                                                               <<11672>>27331000
  COMMENT -- Good programming practice ordinarily  would  dic- <<11672>>27332000
tate our reacquiring the LDT SIR here, since we released it at <<11672>>27333000
this level.  However, this would require holding it during the <<11672>>27334000
FREEDEVICE and FORS'XDS'DEALLOC calls  below,  each  of  which <<11672>>27334010
calls ATTACHIO.  FREEDEVICE can also update the LDT. So we put <<11672>>27334020
off the LDT activity until after that.                         <<11672>>27334030
;                                                              <<11672>>27334040
                  END    << IF PRIMED...                    >> <<11672>>27335000
               ELSE                                            <<11672>>27336000
                  BEGIN   << Not primed, just update LDT.   >> <<11672>>27337000
                  MOVETODSEG (LDT'DST, LDEV*SIZE'OF'LDT'ENTRY, <<11672>>27338000
                              @LDT, SIZE'OF'LDT'ENTRY);        <<11672>>27338100
                  RELSIR (LDT'SIR, SAVE'LDT'SIR);              <<11672>>27338200
                  END;                                         <<11672>>27338300
               << REMOVE ODD entry or entries      >>          <<01465>>27339000
               FIND'ENTRY (ODD'DST, ODD'SIR, TRUE);            <<01465>>27340000
$EDIT VOID = 27350000                                          <<01465>>27345000
               END                                             <<11690>>27355000
            ELSE                                               <<11690>>27355100
               BEGIN   << No trailer/ODD, just update LDT.  >> <<11690>>27355200
               MOVETODSEG (LDT'DST, LDEV*SIZE'OF'LDT'ENTRY,    <<11690>>27355300
                           @LDT, SIZE'OF'LDT'ENTRY);           <<11690>>27355400
               RELSIR (LDT'SIR, SAVE'LDT'SIR);                 <<11690>>27355500
               END;                                            <<11690>>27355600
<<   The call to FREEDEVICE must precede the release of any >> <<01850>>27380000
<<   In the DEVPARM0 parameter, only the LABELLED  and  NO' >> <<01850>>27410100
<< ATTACHIO bits are used by FREEDEVICE.                    >> <<01850>>27410200
                        DEVPARM0);                             <<01850>>27425000
                                                               <<01554>>27429000
<<   The NOT LABELLED test below prevents deallocating  se- >> <<01554>>27429100
<< rial  disc  resources  if a labeled serial disc is being >> <<01554>>27429200
<< FCLOSEd with disposition 2 or 3.  It also leaves the me- >> <<01554>>27429300
<< dia positioned properly for a subsequent  FOPEN  by  the >> <<01554>>27429400
<< same process.  It is LABSEG's responsibility to clean up >> <<01554>>27429500
<< (via its own FORS'XDS'DEALLOC call) if the process  ter- >> <<01554>>27429600
<< minates without FCLOSEing the device with some permanent >> <<01554>>27429700
<< disposition.                                             >> <<01554>>27429800
                                                               <<01554>>27429900
            IF LDTX'SERIAL'OR'FOREIGN AND NOT LABELLED THEN    <<01554>>27430000
$EDIT VOID=27435000                                            <<01263>>27435000
                                                               <<11672>>27440100
<< Unlock LDT'LOCKED only if it was locked earlier.         >> <<11672>>27440200
                                                               <<11672>>27440300
            IF LDT'LOCKED THEN                                 <<11672>>27440400
               BEGIN                                           <<11672>>27440500
               SAVE'LDT'SIR := GETSIR (LDT'SIR);               <<11672>>27440600
               MOVEFROMDSEG (@LDT, LDT'DST, LDEV *             <<11672>>27440700
                   SIZE'OF'LDT'ENTRY, SIZE'OF'LDT'ENTRY);      <<11672>>27440800
               LDT'LOCKED := FALSE;                            <<11672>>27441000
               MOVETODSEG (LDT'DST, LDEV * SIZE'OF'LDT'ENTRY,  <<11672>>27442000
                           @LDT, SIZE'OF'LDT'ENTRY);           <<11672>>27443000
               IF TEST'RE'LOGON (LDEV) THEN                    <<U1779>>27443010
                                                               <<U1779>>27443020
<<   This is a terminal or spooled input device  trying  to >> <<U1779>>27443030
<< re-logon.  Normally  this  is  handled by the FREEDEVICE >> <<U1779>>27443040
<< call above, which AWAKEns  DEVREC.  However,  FREEDEVICE >> <<U1779>>27443050
<< noticed  that  LDT'LOCKED  was set and skipped that step >> <<U1779>>27443060
<< because it would start a chain of events by  which  UCOP >> <<U1779>>27443070
<< could  try to allocate this device for a new C.I. before >> <<U1779>>27443080
<< we had unlocked it, causing the  allocation  (hence  the >> <<U1779>>27443090
<< logon) to fail.  Since we've unlocked the device now, we >> <<U1779>>27443100
<< wake DEVREC here.                                        >> <<U1779>>27443110
                                                               <<U1779>>27443120
                  BEGIN                                        <<U1779>>27443130
                  DISABLE;                                     <<U1779>>27443140
                  LPDT'DEV'OWN'STATE := LPDT'SERVICE'REQ;      <<U1779>>27443150
                  LPDT'SERV'REQ'COUNT := LPDT'SERV'REQ'COUNT+1;<<U1779>>27443160
                  ENABLE;                                      <<U1779>>27443170
                  AWAKE (SYSDEVRECPCB, JUNKWAIT, 0);           <<U1779>>27443180
                  END     << Device re-logging on.          >> <<U1779>>27443190
               ELSE       << Normal deallocation.           >> <<U1779>>27443200
                  SET'UNOWNED'WAKE'UCOP;                       <<U1779>>27443210
               RELSIR (LDT'SIR, SAVE'LDT'SIR);                 <<11672>>27444000
               END;                                            <<11672>>27444100
                  XDDS'VIRTUAL'LDEV := 0;                      <<12131>>27546000
            SET'UNOWNED'WAKE'UCOP;                             <<U1779>>27680000
$EDIT VOID=27745000                                            <<U1779>>27685000
