         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
   Added functionality to AVREC and  RECOGNIZE  so  that  they <<S9201>>00890000
can be told not to do a REMRITENTRY call. The call AWAKEns the <<S9201>>00895000
user process.  If RECOGNIZE is called by PVPROC on behalf of a <<S9201>>00900000
serial disc coming on line, the user process runs  before  PV- <<S9201>>00901010
PROC has restored its serial disc environment to the LDTX. The <<S9201>>00901020
enhancement (a new entry, RECOGNIZE', and  support  in  AVREC) <<S9201>>00901030
bypasses  the  two REMRITENTRY calls and returns the user pro- <<S9201>>00901040
cess PIN to PVPROC, who will make the REMRITENTRY call when it <<S9201>>00901050
is safe.                                                       <<S9201>>00901060
   Fixed two minor bugs in LINKLABEL and CKFORLDEV--they  were <<S9201>>00901070
setting  CCL in their caller's stack marker, not in the proce- <<S9201>>00901080
dure itself.                                                   <<S9201>>00901090
   Made SETOWNED available outside Labseg.                     <<09418>>00901100
   Restricted VCB'DENSITY check in LINKLABEL to tapes (i.e.,   <<09418>>00901110
no SDISCs).                                                    <<09418>>00901120
   Made BUFFER of REELSWITCH a direct array, because comments  <<09418>>00901130
indicate DB can be anywhere (split-stack callable).            <<09418>>00901140
                                                               <<*1435>>00901150
  Repaired problem with accessing files which spans between    <<*1435>>00901160
reel two (2) and three (3).  This problem also affected        <<*1435>>00901170
accessing files on reels greater than reel two (2).            <<*1435>>00901180
                                                               <<*1435>>00901190
  Remove invalid setting of VCB reel number to one (1) on      <<*1435>>00901200
exiting NEXTTAPEFILE.                                          <<*1435>>00901210
                                                               <<*1435>>00901220
  Allow forward and backward searching for RESTORE.  This      <<*1435>>00901230
is required since the first reel mounted no longer has to      <<*1435>>00901240
be reel one (1).                                               <<*1435>>00901250
                                                               <<*1435>>00901260
  Enhanced AVREC to display the reel number for ANSI type      <<*1435>>00901270
labeled tapes.  This provision was not extended to IBM         <<*1435>>00901280
type labeled tapes because there was no way to create          <<*1435>>00901290
a tape set consisting of more than three (3) volumes with      <<*1435>>00901300
IBM type label.                                                <<*1435>>00901310
                                                               <<*1435>>00901320
  Enchanced REELSWITCH to display the expected reel number     <<*1435>>00901330
when prompting the operator for the next volume.               <<*1435>>00901340
                                                               <<*1435>>00901350
  Provided an exit for the operator prompt for another         <<*1435>>00901360
volume available when the wrong volume is mounted.             <<*1435>>00901370
                                                               <<*1435>>00901380
  Fix to allow User Logging to perform warmstart recovery      <<*1687>>00901390
without overwriting the volume label and ensuring reel number  <<*1687>>00901400
one (1) to be the first reel mounted.                          <<*1687>>00901410
                                                               <<*1687>>00901420
<< Resequenced source, August, 1984.                        >> <<S9201>>00911000
 VCB'FLAGS3 = VTBUFB (31)#,                                    <<*1687>>01181000
   VCB'UL'RECOV  = VCB'FLAGS3.(15:1)#, <<user log recovery>>   <<*1687>>01182000
      L1GENNUM =BTLABEL(35)#, <<only meaningful to IBM system>><<s9513>>01355100
      L1VERSIONNUM                                             <<s9513>>01355200
               =BTLABEL(39)#, <<only meaningful to IBM system>><<s9513>>01355300
PROCEDURE GETXDSW(TARGET,DSTN,OFFSET,WC);                      <<F2100>>02080100
   VALUE DSTN,OFFSET,WC;                                       <<F2100>>02080200
   INTEGER DSTN,OFFSET,WC;                                     <<F2100>>02080300
   ARRAY TARGET;                                               <<F2100>>02080400
   OPTION FORWARD;                                             <<F2100>>02080500
   OPTION PRIVILEGED, UNCALLABLE;                              <<09418>>02600000
   INTEGER LDT'INDEX, TYPE, SUBTYPE;                           <<F2100>>02691000
   LOGICAL ARRAY LDT(0:SIZE'OF'LDT'ENTRY-1);                   <<F2100>>02692000
   IF FUNC=9 THEN                                              <<F2100>>02695100
      BEGIN                                                    <<F2100>>02695200
      LDT'INDEX := 0;                                          <<F2100>>02695300
      GETXDSW (LDT, LDT'DST, LDEV*SIZE'OF'LDT'ENTRY,           <<F2100>>02695400
               SIZE'OF'LDT'ENTRY);                             <<F2100>>02695500
      TYPE := LDT'DEVICE'TYPE;                                 <<F2100>>02695600
      SUBTYPE := LPDT (LDEV*SIZE'OF'LPDT'ENTRY+1).(13:3);      <<F2100>>02695700
      IF NOT ((TYPE=LDT'MAG'TAPE) LOR ((TYPE=LDT'CS80'DEVICE)  <<F2100>>02695800
         LAND (SUBTYPE=0 LOR SUBTYPE=3 LOR SUBTYPE=6))) THEN   <<F2100>>02695900
         BEGIN                                                 <<F2100>>02696000
         CC := CCE;                                            <<F2100>>02696100
         GO EXIT;                                              <<F2100>>02696200
         END;                                                  <<F2100>>02696300
      END;                                                     <<F2100>>02696400
EXIT:                                                          <<F2100>>02721000
   MOVE L1GENNUM := "0001";       << default value >>          <<s9513>>05771000
   MOVE L1VERSIONNUM := "00";    <<default value >>            <<s9513>>05772000
   LOGICAL UL'RECOVERY; << identifies user logging recov call  <<*1687>>06536000
   IF ACCESS < 0 THEN  << Negative ACCESS means UL Recovery >> <<*1687>>06616000
      BEGIN                                                    <<*1687>>06617000
      UL'RECOVERY := TRUE; << Save flag for later processing >><<*1687>>06617500
      ACCESS := READ;      << Treat UL recovery as read acc. >><<*1687>>06618000
      END                                                      <<*1687>>06618500
   ELSE                                                        <<*1687>>06619000
      UL'RECOVERY := FALSE;                                    <<*1687>>06619500
   VCB'UL'RECOV := IF UL'RECOVERY THEN TRUE  << pass flag >>   <<*1687>>07471000
                                  ELSE FALSE;                  <<*1687>>07472000
   VCB'WRITE := IF ( ACCESS > READ ) OR ( UL'RECOVERY ) THEN   <<*1687>>07485000
                   1 ELSE 0;                                   <<*1687>>07486000
$EDIT VOID=08625000                                            <<S9201>>08570000
!   AVREC parses COUNT words in BUFF to see if the record is a <<S9201>>08571000
! tape label.  The action taken depends on the answer  and  on <<S9201>>08572000
! who called us:                                               <<S9201>>08573000
!   DEVREC reads a newly mounted tape, then passes the  record <<S9201>>08574000
! to us to admire. If it's a tape label, and there's a process <<S9201>>08575000
! waiting for that tape, the process is restarted  by  pulling <<S9201>>08576000
! its entry out of the Reply Information Table (RIT).          <<S9201>>08577000
!   LINKLABEL (for tapes) and PVPROC (for  serial  discs)  use <<S9201>>08578000
! RECOGNIZE to read their device.  RECOGNIZE passes us the re- <<S9201>>08579000
! cord it got.  For LINKLABEL, the behavior is the same as for <<S9201>>08580000
! DEVREC.  If this all started with PVPROC, we can't afford to <<S9201>>08581000
! wake the user process, because PVPROC has exchanged the user <<S9201>>08582000
! process SDISC environment (in the device's LDTX  entry)  for <<S9201>>08583000
! one of its own.  For this situation, the user process PIN is <<S9201>>08584000
! passed up to PVPROC, who will AWAKEn the process when it  is <<S9201>>08585000
! safe.                                                        <<S9201>>08586000
!   To constitute a match, both the volume label  and  a  user <<S9201>>08587000
! header label must match their counterparts in the Tape Label <<S9201>>08588000
! Table.  If the volume label fails to match, there is no rea- <<S9201>>08589000
! son to read a header label.  If a header label must be read, <<S9201>>08590000
! AVREC cannot do it. This is because we may be called by DEV- <<S9201>>08591000
! REC, which must not be blocked on our I/O.  Callers must  do <<S9201>>08592000
! any needed I/O.                                              <<S9201>>08593000
!                                                              <<S9201>>08594000
!   Inputs:   LDEV -- the device the record was read from.     <<S9201>>08595000
!             BUFF -- the array containing the record.         <<S9201>>08596000
!             COUNT -- significant words (> 0) in BUFF.        <<S9201>>08597000
!             CMD.(2:14) -- < 2, assume BUFF is volume label.  <<S9201>>08598000
!                           >=2, assume BUFF is header label.  <<S9201>>08599000
!             CMD.(1:1)  -- 0, call REMRITENTRY here if req'd. <<S9201>>08600000
!                           1, don't call, return PIN for  PV- <<S9201>>08601000
!                             PROC to use (new functionality). <<S9201>>08602000
!                                                              <<S9201>>08603000
!   Returns:  AVREC -- FALSE (0).  Processed volume label, and <<S9201>>08604000
!                        caller must  read  header  label  and <<S9201>>08605000
!                        call AVREC again.                     <<S9201>>08606000
!                      TRUE (-1).  Need not call  again.  Tape <<S9201>>08607000
!                        is  unlabeled  (processing volume la- <<S9201>>08608000
!                        bel), or header label has  been  pro- <<S9201>>08609000
!                        cessed.  CMD.(1:1)  was  0 -OR- there <<S9201>>08610000
!                        was no PIN to return to PVPROC.       <<S9201>>08611000
!                      >0 -- The PIN which PVPROC  should  use <<S9201>>08612000
!                        in its REMRITENTRY call. Returned on- <<S9201>>08613000
!                        ly if CMD.(1:1) is 1 -AND- the  local <<S9201>>08614000
!                        REMRITENTRY  call was skipped because <<S9201>>08615000
!                        of it.                                <<S9201>>08616000
!                                                              <<S9201>>08617000
!   The net result of all this is that  DEVREC  and  LINKLABEL <<S9201>>08618000
! continue   as  they  have,  RECOGNIZE  is  enhanced  to  set <<S9201>>08619000
! CMD.(1:1) if the alternate entry point (RECOGNIZE') is used, <<S9201>>08620000
! and PVPROC is enhanced to call RECOGNIZE'.                   <<S9201>>08621000
   INTEGER CURRENT'REEL;                                       <<*1435>>08721000
   RESULT := FALSE;                                            <<S9201>>08729000
      IF VCB'LDEV = 0 THEN VTADDR:= 0;                         <<*2116>>08781000
   IF CMD.(2:14) >= 2 THEN GO TRYH1;                           <<S9201>>08790000
         IF LOGICAL (CMD.(1:1)) THEN                           <<S9201>>09084000
            RESULT := VCB'PIN                                  <<S9201>>09085000
         ELSE REMRITENTRY (VCB'PIN);                           <<S9201>>09086000
   IF LCB'LABTYP = 3 THEN        << IBM TYPE LABEL? >>         <<*1435>>09181000
      GENMSG (1,285,%01000,@MSGB,LDEV,,,,0 )                   <<*1435>>09182000
   ELSE                                                        <<*1435>>09183000
      BEGIN   << NO, ID REEL BY REEL NUMBER >>                 <<*1435>>09183100
      CURRENT'REEL := BINARY' ( L1REEL, 4 );                   <<*1435>>09183200
      GENMSG (1,488,%10100,CURRENT'REEL,@MSGB,LDEV,,,0);       <<*1435>>09183300
      END;                                                     <<*1435>>09185000
   IF VCB'RSWAIT THEN                                          <<S9201>>09260000
      IF LOGICAL (CMD.(1:1)) THEN                              <<S9201>>09261000
         RESULT := VCB'PIN                                     <<S9201>>09262000
      ELSE REMRITENTRY (VCB'PIN);                              <<S9201>>09263000
$PAGE "RECOGNIZE, RECOGNIZE'"                                  <<S9201>>09275000
INTEGER PROCEDURE RECOGNIZE (LDEV);                            <<S9201>>09280000
$EDIT VOID=09310000                                            <<S9201>>09300000
!   RECOGNIZE, for tapes, is a DEVREC subsitute, used  when  a <<S9201>>09300200
! tape drive is on-line when the system comes up. In this case <<S9201>>09300400
! there is no interrupt to cause DEVREC to run,  so  LINKLABEL <<S9201>>09300600
! calls us and we read the tape instead. We then pass the con- <<S9201>>09300800
! tents to AVREC, just as DEVREC would have.                   <<S9201>>09301000
!   For serial discs it works differently.  At present,  there <<S9201>>09301200
! is  no  way  to handle a serial disc device which is on-line <<S9201>>09301400
! when the system comes up.  An on-line interrupt must  occur, <<S9201>>09301600
! at  which  time  DEVREC runs, wakes PVPROC, and PVPROC calls <<S9201>>09301800
! us.  The original design sought to make the  difference  be- <<S9201>>09302000
! tween  tapes  and serial discs as invisible to RECOGNIZE and <<S9201>>09302200
! AVREC as possible.  To do this, PVPROC set up a serial  disc <<S9201>>09302400
! environment so that RECOGNIZE could make standard ATTACHIO   <<S9201>>09302600
! tape calls and process whatever came back.  Trouble is,  PV- <<S9201>>09302800
! PROC  and  the  user process must share some serial disc re- <<S9201>>09303000
! sources, so the two processes must be carefully synchronized <<S9201>>09303200
! to make sure they don't step on each other.  This fix  takes <<S9201>>09303400
! care of one such problem. A REMRITENTRY call in AVREC caused <<S9201>>09303600
! the user process to run before PVPROC had replaced its seri- <<S9201>>09303800
! al disc environment.                                         <<S9201>>09304000
!   Making RECOGNIZE a functional procedure and adding the al- <<S9201>>09304200
! ternate entry point, RECOGNIZE', together  with  support  in <<S9201>>09304400
! AVREC,  solves this problem.  If RECOGNIZE' is called, AVREC <<S9201>>09304600
! omits the REMRITENTRY call, passing the associated PIN  back <<S9201>>09304800
! to  us  to  pass on to our caller (currently only PVPROC) in <<S9201>>09305000
! the functional result.  The caller is then  responsible  for <<S9201>>09305200
! doing the REMRITENTRY call when it is safe.                  <<S9201>>09305400
!   The functionality of RECOGNIZE and AVREC are  not  changed <<S9201>>09305600
! when the original entry point is used.                       <<S9201>>09305800
                                                               <<S9201>>09321000
ENTRY                                                          <<S9201>>09322000
   RECOGNIZE';                                                 <<S9201>>09323000
                                                               <<S9201>>09324000
   INTEGER RESULT = RECOGNIZE;                                 <<S9201>>09336000
   LOGICAL NOWAKE;                                             <<S9201>>09337000
                                                               <<S9201>>09346000
   NOWAKE := FALSE;                                            <<S9201>>09347000
   WHILE FALSE DO                                              <<S9201>>09348000
                                                               <<S9201>>09349000
RECOGNIZE':                                                    <<S9201>>09349100
                                                               <<S9201>>09349200
      NOWAKE := TRUE;                                          <<S9201>>09349300
   RESULT := 0;                                                <<S9201>>09349400
   IF NOWAKE THEN CMD.(1:1) := 1;                              <<S9201>>09541000
   RESULT := AVREC (LDEV, TLABEL, COUNT, CMD);                 <<S9201>>09640000
   IF RESULT = 0 THEN GO LOOP;                                 <<S9201>>09641000
                                                               <<S9201>>09644100
<< If AVREC is done, but with no PIN to wake, it returns -1 >> <<S9201>>09644200
<< (TRUE). Hide this from caller, so that the test there is >> <<S9201>>09644300
<< simply 0 or non-0.                                       >> <<S9201>>09644400
                                                               <<S9201>>09644500
   IF RESULT = -1 THEN RESULT := 0;                            <<S9201>>09645000
   RECOGNIZE := RESULT;                                        <<S9201>>09646000
$PAGE  " DEV'IS'REAL "                                         <<01862>>09870100
LOGICAL PROCEDURE DEV'IS'REAL (LDEV);                          <<01862>>09870200
   VALUE LDEV;                                                 <<01862>>09870300
   INTEGER LDEV;                                               <<01862>>09870400
   OPTION UNCALLABLE, PRIVILEGED;                              <<01862>>09870500
                                                               <<01862>>09870600
BEGIN                                                          <<01862>>09870700
   INTEGER LPDT'INDEX;                                         <<01862>>09870900
   LOGICAL RESULT=DEV'IS'REAL;                                 <<01862>>09871000
                                                               <<01862>>09871100
   RESULT := TRUE;                                             <<01862>>09871200
   IF LDEV < 1 OR LDEV > INTEGER(LPDT'MAX'ENTRIES) THEN        <<01862>>09871300
      RESULT := FALSE                                          <<01862>>09871400
   ELSE                                                        <<01862>>09871500
      BEGIN                                                    <<01862>>09871600
         LPDT'INDEX := LDEV*INTEGER(LPDT'ENTRY'SIZE);          <<01862>>09871700
         IF LPDT'VIRTUAL'DEVICE = 1 THEN                       <<01862>>09871800
            RESULT := FALSE                                    <<01862>>09871900
         ELSE                                                  <<01862>>09872000
            IF LPDT'DIT'PTR = 0 THEN                           <<01862>>09872100
               RESULT := FALSE                                 <<01862>>09872200
      END;                                                     <<01862>>09872300
END; << DEV'IS'REAL >>                                         <<01862>>09872400
   INTEGER SCODE, LDEV, REEL'NUM;                              <<*1687>>10025000
   INTEGER LDT'INDEX;                                          <<*1261>>10025100
   LOGICAL ARRAY LDT(0:SIZE'OF'LDT'ENTRY - 1);                 <<*1261>>10025200
   IF LOGICAL ( VCB'UL'RECOV ) THEN ACCESS := READ;            <<*1687>>10206000
   REEL'NUM := VCB'REEL;                    << which reel? >>  <<*1687>>10356000
   IF NOT LOGICAL ( VCB'UL'RECOV ) THEN                        <<*1687>>10370000
      GENMSG ( 1,287,0,@BBUF,,,,,0,%1404,@REPLY )              <<*1687>>10371000
   ELSE                                                        <<*1687>>10372000
      GENMSG ( 1,489,%10000,REEL'NUM,@BBUF,,,,0,%1404,@REPLY );<<*1687>>10373000
                                                               <<*1687>>10374000
   IF LDEV = 0 THEN                                            <<*2116>>10480000
                                                               <<*2116>>10480100
     BEGIN                                                     <<*2116>>10480200
     LDEV:= VCB'LDEV;                                          <<*2116>>10480300
     IF LDEV <> 0 THEN                                         <<*2116>>10480400
                                                               <<*2116>>10480500
       BEGIN                                                   <<*2116>>10480600
       LTADDR:= GETLDEV(LDEV,LTBUF);                           <<*2116>>10480700
       IF = THEN GO REJECTX;                                   <<*2116>>10480800
       END;                                                    <<*2116>>10480900
                                                               <<*2116>>10481000
     GO REJECT;                                                <<*2116>>10481100
     END;                                                      <<*2116>>10481200
                                                               <<*2116>>10481300
                                                               <<*1261>>10495100
   << CHECK IF SPECIFIED LDEV IS FOR A "REAL" DEVICE >>        <<*1261>>10495200
   <<    NOTE: COULD BE VIRTUAL OR NOT CONFIGURED.   >>        <<*1261>>10495300
   IF DEV'IS'REAL(LDEV) THEN                                   <<01862>>10495400
      BEGIN                                                    <<01862>>10495410
         LDT'INDEX := 0;                                       <<01862>>10495500
         GETXDSW(LDT, LDT'DST, LDEV*SIZE'OF'LDT'ENTRY,         <<01862>>10495600
                      SIZE'OF'LDT'ENTRY );                     <<01862>>10495700
         << CHECK IF DEVICE IS DOWN >>                         <<01862>>10495800
         IF NOT LDT'AVAIL'TO'SYS THEN                          <<01862>>10495900
            BEGIN                                              <<01862>>10496000
               RELSIR(TLTSIR, SCODE);                          <<01862>>10496001
               GO BUGOPR;                                      <<01862>>10496002
            END;                                               <<01862>>10496003
      END                                                      <<01862>>10496010
   ELSE                                                        <<01862>>10496100
      BEGIN                                                    <<01862>>10496200
         RELSIR(TLTSIR, SCODE);                                <<01862>>10496210
         GO BUGOPR;                                            <<01862>>10496220
      END;                                                     <<01862>>10496230
                                                               <<*1261>>10496300
      IF NOT LCB'TAPE THEN GO BUGOPR;  << Don't RECOG SDISC >> <<S9201>>10545000
      RECOGNIZE (LDEV);                                        <<S9201>>10550000
      IF TAPE'DEVICE THEN                                      <<09418>>10806000
         IF (LPDT'AUTO'SUBTYPE = HP7976) OR                    <<09418>>10810000
            (LPDT'AUTO'SUBTYPE = HP7978) THEN                  <<09418>>10815000
            VCB'DENSITY := LDT'DENSITY'6250                    <<09418>>10820000
         ELSE    << HP7974 or HP7970 (not used) >>             <<09418>>10825000
            VCB'DENSITY := LDT'DENSITY'1600;                   <<09418>>10830000
REJECTX:                                                       <<*2116>>10921000
                                                               <<01861>>11070001
<<********************************************************>>   <<01861>>11070002
<<*       ENTRY POINT CLEANLDEV' ADDED 7/31/85           *>>   <<01861>>11070003
<<*       ====================================           *>>   <<01861>>11070004
<<*                                                      *>>   <<01861>>11070005
<<*  CLEANLDEV' IS CALLED FROM FREEDEVICE WHEN DEALLO-   *>>   <<01861>>11070006
<<*  CATING A DEVICE (MODULE 54 - ALLOCATE).             *>>   <<01861>>11070007
<<*                                                      *>>   <<01861>>11070008
<<*                                                      *>>   <<*1298>>11070009
<<*  CLEANLDEV' WILL NOT SYSTEM FAIL (WITH A 86) IF      *>>   <<01861>>11070010
<<*  CALLED WITH AN LDEV THAT DOES NOT HAVE A LCB ENTRY. *>>   <<01861>>11070011
<<*                                                      *>>   <<01861>>11070012
<<********************************************************>>   <<01861>>11070013
                                                               <<01861>>11081000
   ENTRY CLEANLDEV';                                           <<01861>>11082000
                                                               <<01861>>11083000
   LOGICAL NO'SF86 := FALSE;                                   <<01861>>11091000
   IF NO'SF86 THEN                                             <<01861>>11096000
      CLEANLDEV' : NO'SF86 := TRUE;                            <<01861>>11097000
                                                               <<01861>>11098000
   GRAB'SIR : SCODE := GETSIR(TLTSIR);                         <<01861>>11100000
   IF < THEN   <<*** LDEV DOES NOT HAVE AN LCB ENTRY ***>>     <<01861>>11110000
      IF NO'SF86 THEN                                          <<01861>>11111000
         BEGIN                                                 <<01861>>11112000
            RELSIR(TLTSIR, SCODE);                             <<01861>>11113000
            RETURN;                                            <<01861>>11114000
         END                                                   <<01861>>11114100
      ELSE                                                     <<01861>>11114200
         TAPETROUBLE(TT15);                                    <<01861>>11114300
                                                               <<01861>>11114400
                                                               <<01861>>11126000
   << POSTVTENT WILL DO THE RELSIR AFTER ZEROING >>            <<01861>>11127000
   << OUT THE VCB ENTRY.                         >>            <<01861>>11128000
   INTEGER ARRAY BUFFER(0:30) = Q;                             <<09418>>11330000
   INTEGER EXPECTED'REEL;                                      <<*1435>>11351000
   IF RDWR = 1 THEN   << WRITE TO LABEL TAPE >>                <<*1435>>11640000
      VCB'REEL := VCB'REEL + 1                                 <<*1435>>11640100
   ELSE                                                        <<*1435>>11640500
      IF LCB'VSETID = VCB'VSETID, (6) AND   << CORRECT SET? >> <<*1435>>11641000
         ( LCB'REEL = VCB'REEL ) THEN                          <<*1435>>11641500
         BEGIN                                                 <<*1435>>11642000
         IF RESTOR THEN              << NUMBER OF NEXT VOL >>  <<*1435>>11642500
            VCB'REEL := VCB'REEL - 1                           <<*1435>>11643000
         ELSE VCB'REEL := VCB'REEL + 1;                        <<*1435>>11643100
         END;                                                  <<*1435>>11643200
   EXPECTED'REEL := VCB'REEL;  << IDENTIFY REEL BY NUMBER >>   <<*1435>>11672000
   IF VCB'LABTYP = 3 THEN   << IBM TYPE LABEL? >>              <<*1435>>11690000
      GENMSG ( 1, 288+RESTOR, %01000, @BBUF,  << YES, DON'T ID <<*1435>>11691000
               LDEV,,,, 0, %1404, @REPLY )    << BY REEL NUMBER<<*1435>>11692000
   ELSE                                                        <<*1435>>11693000
      GENMSG ( 1, 487, %10100, EXPECTED'REEL, << NO, ID REEL BY<<*1435>>11694000
               @BBUF,LDEV,,,0,%1404,@REPLY ); << REEL NUMBER.  <<*1435>>11694100
      IF (RDWR=2) OR ( LCB'REEL = VCB'REEL ) THEN              <<*1601>>11865000
         GO READIT                                             <<*1435>>11870000
      ELSE                                                     <<*1435>>11875000
         BEGIN                                                 <<*1435>>11879000
         GENMSG (1, 10, %10000, LDEV, , , , , 0, 1, @REPLY);   <<*1435>>11880000
         IF NOT LOGICAL ( REPLY ) THEN                         <<*1435>>11881000
            BEGIN                                              <<*1435>>11881500
            RELSIR ( TLTSIR, SCODE );                          <<*1435>>11882000
            ATTIOS ( 9 );        << UNLOAD TAPE >>             <<*1435>>11883000
            GO FLUSH;                                          <<*1435>>11883500
            END;                                               <<*1435>>11884000
         END;                                                  <<*1435>>11884500
   IF CKFORLDEV(LDEV) OR CKFOREXDATE(LDEV,1,1) THEN            <<s9948>>12305000
   IF ( AOPACTYPE <> 0 ) OR LOGICAL ( VCB'UL'RECOV ) THEN      <<*1687>>14290000
   IF LOGICAL ( VCB'UL'RECOV ) THEN AOPACTYPE := 0;            <<*1687>>14306000
      IF CKFOREXDATE(LDEV,-1,1) THEN ERREXIT(LBTUNEXP);        <<s9948>>14335000
            IF CKFOREXDATE(LDEV,-1,2) THEN ERREXIT(LBTUNEXP);  <<s9948>>14605000
            IF CKFOREXDATE(LDEV,-1,2) THEN ERREXIT(LBTUNEXP);  <<s9948>>14800000
         IF CKFOREXDATE(LDEV,-1,2) THEN ERREXIT(LBTUNEXP);     <<s9948>>14890000
         IF CKFOREXDATE(LDEV,-1,2) THEN ERREXIT(LBTUNEXP);     <<s9948>>14930000
      MOVE LCB'VSETID := VCB'VSETID,(6);                       <<s9948>>14995000
   VCB'UL'RECOV := FALSE;  << Normal process after 1st call >> <<*1687>>15506000
          - negative (e.g. -1, -2) if call from POSITION.      <<s9948>>15621000
                                                               <<s9948>>15715100
SUBROUTINE ATTIOS(FUNC);                                       <<s9948>>15716000
VALUE FUNC; INTEGER FUNC;                                      <<s9948>>15716100
                                                               <<s9948>>15716200
   BEGIN                                                       <<s9948>>15716300
   IF LDEV=0 THEN TAPETROUBLE(TT5);    << oops! >>             <<s9948>>15716400
   TOS := ATTACHIO(LDEV,0,0,0,FUNC,0,0,4,%11);                 <<s9948>>15716500
   DEL;                                                        <<s9948>>15716600
   IF S0.(13:3) > 2 THEN                                       <<s9948>>15716700
      BEGIN                                                    <<s9948>>15716800
      REPORT'IOERROR(LDEV,S0.(8:8));   << gripe >>             <<s9948>>15716900
      END;                                                     <<s9948>>15717000
   X := TOS;                                                   <<s9948>>15717100
   END;                                                        <<s9948>>15717200
      IF ACCESS <> 0 AND NOT(LBLED=2 LAND CALENDAR>LCB'EXDATE) <<s9948>>15775000
          END                                                  <<s9948>>15870000
        ELSE IF ACCESS > 0 THEN                                <<s9948>>15870100
          <<not calling from POSITION>>                        <<s9948>>15870110
          BEGIN   << REPLY 'N' >>                              <<s9948>>15870200
          ATTIOS(9);   << Rewind-unload >>                     <<s9948>>15870300
          SETOWNED (LDEV, 0);   << Enable AVR >>               <<s9948>>15870400
          << 283  Please Mount a different tape on ldev#\ >>   <<s9948>>15870401
          GENMSG(1, 283, %10000, LDEV,,,,,0);                  <<s9948>>15870405
          END;                                                 <<s9948>>15870500
      IF NOT LCB'TAPE THEN GO ERREXIT; << Don't RECOG SDISC >> <<S9201>>16055000
      RECOGNIZE (LDEV);                                        <<S9201>>16060000
$EDIT                                                          <<*1435>>16480000
