$CONTROL MAP,CODE,USLINIT                                               00005000
<<SDISC - MODULE 87>>                                                   00010000
<< HP32002C MPE SOURCE C.00.00 >>                                       00015000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00020000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00025000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00030000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00035000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00040000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00045000
$CONTROL SEGMENT=SDISC,MAIN=SDISC                                       00050000
$CONTROL USLINIT, MAP, CODE                                    <<03522>>00055000
BEGIN   << Serial Disc Interface, SDISC.                    >> <<03522>>00060000
$PAGE  "SDISC -- FIX HISTORY"                                  <<03522>>00065000
COMMENT --                                                     <<03522>>00070000
  This fix number encompasses two changes:                     <<00189>>00075000
1.  Makes the Gap Table memory-resident.                       <<00189>>00080000
2.  Only asks once for operator to O.K. "write ring".          <<00189>>00085000
  This fix allows REWIND or REWIND  AND  UNLOAD  to  the  disc <<00212>>00090000
after  it  has  already  been  unloaded, without requiring the <<00212>>00095000
operator to toggle the RUN/LOAD switch.                        <<00212>>00100000
  This fix installs FATALERROR flag to prevent further use  of <<00239>>00105000
SDISC following an error. It also prevents calling DECLAREHOLE <<00239>>00110000
if a write error occurs because the Read Only switch is set.   <<00239>>00115000
  This fix enlarges the extra data segment for  a  larger  Gap <<00467>>00120000
Table  for  the  7925.  Forward  Space File is also sped up by <<00467>>00125000
starting the Gap Table search at the current entry rather than <<00467>>00130000
the beginning.                                                 <<00467>>00135000
  Major rewrite to install debug/dump code and correct bugs in <<00494>>00140000
backspacing algorithms.                                        <<00494>>00145000
  A fatal error message is now printed only once.              <<00513>>00150000
  Deletes all PRINT'FILE'INFO calls.                           <<00823>>00155000
  Changes to support Foreign Disc Facility.                    <<01115>>00160000
  Install four retries in case of write error.                 <<01598>>00165000
  Install CTRLSDISC function code 15 (Physical Status Request) <<01958>>00170000
  Correctly handle End of Data when reading.                   <<02025>>00175000
  Install CS80 disc (including LINUS) support.  Also the  fol- <<03522>>00180000
lowing fixes:                                                  <<03522>>00185000
1.  READBLOCK now skips contiguous  blocks/holes  larger  than <<03522>>00190000
    RECBUFF.                                                   <<03522>>00195000
2.  Numerous BACKBLOCKREAD problems relating  to  blocks/holes <<03522>>00200000
    and finding the load point while backspacing.              <<03522>>00205000
3.  Users can no longer write EOF's beyond End of Tape  unless <<03522>>00210000
    P2 bit 13 is set.                                          <<03522>>00215000
4.  Gap Table length now varies with the device and is  calcu- <<03522>>00220000
    lated from quantities in the label sector.  The 7920 ratio <<03522>>00225000
    of entries to address space is used on  the  7925  and  on <<03522>>00230000
    LINUS.  We  can't use it on the 7935, since the length re- <<03522>>00235000
    quired (45,400 words) is more than  the  largest  possible <<03522>>00240000
    data  segment.  For the 7935, we restrict the Gap Table to <<03522>>00245000
    what fills the largest possible data segment, allowing for <<03522>>00250000
    RECBUFF and the other segment-resident variables.          <<03522>>00255000
5.  An early warning End of Tape status is now  returned  when <<03522>>00260000
    the user is within 10 Gap Table entries of the end.        <<03522>>00265000
6.  A write request of 0 length now only checks for write ring.<<03522>>00270000
7.  Load point sensing and reporting is now handled properly.  <<03522>>00275000
8.  ACTUAL'ADDRESS installed to determine proper disc  address <<03522>>00280000
    when reading or spacing.                                   <<03522>>00285000
9.  A Backspace Record at a location containing  two  or  more <<03522>>00290000
    file marks now backspaces over only one.                   <<03522>>00295000
10. The EOT flag is now cleared if the user backspaces over it.<<03522>>00300000
11. The EOT burst is no longer written to  the  disc,  but  is <<03522>>00305000
    still  detected and ignored (for compatibility with exist- <<03522>>00310000
    ing serial disc packs) when reading or spacing.            <<03522>>00315000
  This fix prevents reading a just >SERIALized pack.           <<03535>>00320000
  DB now handled properly at entry and  exit  to  SDISCIO  and <<03558>>00325000
FINDSDISCGAP.  Fixed CURRENTGPTENT bug from <<03535>>.         <<03558>>00330000
  Allow 0 length write when closing contiguous block.  Put the <<03606>>00335000
REW'UNLOAD function in XDS (not Q-) during Device Close.    >> <<03606>>00340000
1.  Update comments at beginning.                              <<03640>>00345000
2.  Make SDERR 30 non-fatal.                                   <<03640>>00350000
3.  Solve 7935 Unlock problem by always reading label sector.  <<03640>>00355000
  Check for mounted disc (WAITFORDISC) in  SDISCIO.  Can  then <<03680>>00360000
delete  UN/LOCK'CS80'DEVICE  calls  from WAITFORDISC, which in <<03680>>00365000
turn makes all FORCE'ATACHIO references unnecessary. Fix #3 of <<03680>>00370000
MPE Fix #03640 is also deleted, since this fix makes it  unne- <<03680>>00375000
cessary.                                                       <<03680>>00380000
  Allow function code %3001 for priv mode programs. Writes EOD <<03733>>00385000
to media using EOTSECTR address. Allows user logging recovery. <<03733>>00390000
  Allow CLOSE'DEVC after FATALERROR, else CS80 device can't be <<03733>>00395000
UNLOCKed.                                                      <<03733>>00400000
  Initialize TAPEREWOUND in SDISCIO when starting new  "reel". <<03733>>00405000
Make sure it gets cleared when we move off of Load Point.      <<03733>>00410000
1.  Partially cancels #11 of Fix 03522.  The EOT burst is  now <<04249>>00415000
    written  on a floppy disc when EOTSECTR is detected.  INI- <<04249>>00420000
    TIAL needs it to know when to change system area volumes.  <<04249>>00425000
2.  Beginning-of-block is now entered in the  Gap  Table  just <<04249>>00430000
    before  End-of-block.  This  prevents  a  hole  entry from <<04249>>00435000
    splitting a BOB/EOB entry pair, which  caused  a  bug.  In <<04249>>00440000
    addition,  DECLAREHOLE  was  changed  to make a hole entry <<04249>>00445000
    extend from RECBUFFSA  or  CONTIGSTARTSECT  (whichever  is <<04249>>00450000
    less)  to  the last sector of the current track.  The pre- <<04249>>00455000
    vious starting address was the first sector of the current <<04249>>00460000
    track or CONTIGSTARTSECT (whichever was less), which  pro- <<04249>>00465000
    duced a corrupt Gap Table if a previously-written contigu- <<04249>>00470000
    ous block ended on the current track.                      <<04249>>00475000
Q-MIT fixes:                                                   <<04742>>00480000
1.  Prevent system failures from random  record  lengths  when <<04742>>00485000
    reading.                                                   <<04742>>00490000
2.  Prevent SDISCIO function execution when the  label  sector <<04742>>00495000
    has not been read to initialize parts of the XDS.          <<04742>>00500000
3.  (UN)LOCK'CS80'DEVICE now calls ATTACHIO with LENGTH = 0.   <<04742>>00505000
4.  Don't update Gap Table if operator doesn't allow writing.  <<04742>>00510000
5.  Replace ATTACHIO call with P'ATTACHIO in ATACHIO.          <<04742>>00515000
  Modify P'ATTACHIO declaration for new parms, O-V.            <<04828>>00520000
  1.  Incorporate MPEV $INCLUDE files  for  LDT,  LPDT,  LDTX, <<06745>>00525000
PCB  and  PXGLOBAL.  Note:  LDT  and LDTX are in the same data <<06745>>00530000
segment, hence in the same $INCLUDE file.                      <<06745>>00535000
  2.  Incorporate the MOVETODSEG and MOVEFROMDSEG subroutines. <<06745>>00540000
  3.  No longer allow use of system buffers (report error).    <<06745>>00545000
  4.  Make OPTION INTERNAL all procedures except  SDISCIO  and <<06745>>00550000
FINDSDISCGAP.                                                  <<06745>>00555000
  Add the double-buffering enhancement to SDISC.               <<07114>>00560000
  Add the fast gap table enhancement + BUFFALO support.        <<07114>>00565000
  1.  Fix bad EOD detection in SDISC'FINDGAP.                  <<M7491>>00570000
  2.  Allow system buffer flag if no data actually sent.       <<M7491>>00575000
  Force migration of buffer data segments to bank boundaries.  <<L8989>>00580000
Start with 32 Kbyte buffers (not 64K) in 512 Kbyte systems.    <<L8989>>00585000
;                                                              <<03522>>00590000
$PAGE "SDISC - STRUCTURE AND OPERATION"                        <<03522>>00595000
COMMENT --                                                     <<03522>>00600000
INTRODUCTION:                                                  <<03522>>00605000
  This is the Serial Disc Interface (SDI or SDISC), Module  87 <<03522>>00610000
of  MPE.  The  purpose of the SDI is to simulate magnetic tape <<03522>>00615000
operations on a direct access device.  As of the  current  re- <<03522>>00620000
lease, the following peripherals may be used as serial discs:  <<03522>>00625000
                                                               <<03522>>00630000
       HP7920      50-megabyte hard disc                       <<03522>>00635000
       HP7925     120-megabyte hard disc                       <<03522>>00640000
       HP7935     404-megabyte hard disc                       <<03522>>00645000
       HP7902 or      Floppy                                   <<03522>>00650000
       HP9895           discs                                  <<03522>>00655000
       HP9110      17- or 65-megabyte integrated cartridge     <<03640>>00660000
                      tape (ICT).                              <<03640>>00665000
                                                               <<03522>>00670000
The ICT is supported only as a serial disc.                    <<03640>>00675000
  Both labelled and unlabelled tape operations are  supported, <<03522>>00680000
although the differences are invisible at the SDI level.       <<03522>>00685000
  SDISC may be thought of as a logical driver  for  the  above <<03522>>00690000
physical  devices.  It  is  invoked  by FOPENing a device in a <<03522>>00695000
serial disc class.  Such a device must be in the direct access <<03522>>00700000
hardware type group (type = 0-7), have a valid subtype for its <<03522>>00705000
type, and have a device class type = %37 (stored in the Device <<03522>>00710000
Class Table).  This class type is entered in the DCT  whenever <<03522>>00715000
the SYSDUMP or INITIAL user responds "yes" to "IS xxxx A SERI- <<03522>>00720000
AL DISC CLASS".  The reason for the special device class  type <<03522>>00725000
and user question is twofold:                                  <<03522>>00730000
1.  A serial disc differs from most other MPE disc devices  in <<03522>>00735000
    that it is owned (non-sharable), and therefore must be al- <<03522>>00740000
    located like a magnetic tape.                              <<03522>>00745000
2.  The HP7920 or HP7925 may also be supported  as  a  private <<03522>>00750000
    volume  in  the non-system domain.  In this mode of opera- <<03522>>00755000
    tion the device is sharable and is therefore not owned.    <<03522>>00760000
Use of a serial disc class name tells MPE to allocate the  de- <<03522>>00765000
vice as non-sharable.                                          <<03522>>00770000
  Labelled tape operations to a serial disc behave in the same <<03522>>00775000
fashion as they would to a magnetic tape.  Consult  the  docu- <<03522>>00780000
mentation on labelled tapes for further details.               <<03522>>00785000
$PAGE                                                          <<03522>>00790000
OPERATION -- Overview:                                         <<03522>>00795000
                                                               <<03522>>00800000
  SDI is entered via the uncallable procedure SDISCIO,  called <<03522>>00805000
only  from  the  general  I/O system entry procedure ATTACHIO. <<03522>>00810000
(Another procedure, FINDSDISCGAP, is called by  SYSDUMP.  More <<03522>>00815000
on this later).  ATTACHIO calls SDISCIO if and only if:        <<03522>>00820000
1.  The device is of a type and subtype supported as a  serial <<03522>>00825000
    disc, -AND-                                                <<03522>>00830000
2.  The device is owned (that is, has been allocated as a non- <<03522>>00835000
    sharable device), -AND-                                    <<03522>>00840000
3.  Bit 10 of the FLAGS parameter of ATTACHIO is 0.            <<03522>>00845000
                                                               <<03522>>00850000
Condition 2 is met if the DRSTATE field of the LPDT entry  for <<03522>>00855000
the device (word 1, bits 0:2) equals 1.  Consult the I/O chap- <<03522>>00860000
ter of the MPE Tables Manual for further details.              <<03522>>00865000
  The parameter list of SDISCIO is identical to  that  of  AT- <<03522>>00870000
TACHIO. It is a double procedure whose return fields are iden- <<03522>>00875000
tical to those of ATTACHIO.  It works like this:               <<03522>>00880000
  The File System (say) calls ATTACHIO with parameters  appro- <<03522>>00885000
priate to a magnetic tape I/O request, but with FLAGS.(10:1) = <<03522>>00890000
0.  ATTACHIO tests the above 3 conditions and  calls  SDISCIO, <<03522>>00895000
passing on all the parameters of its own call.  SDISCIO massa- <<03522>>00900000
ges the parameters and fashions its own ATTACHIO call, if  ne- <<03522>>00905000
cessary,  with  parameters  appropriate to a disc I/O request. <<03522>>00910000
Most importantly, it sets FLAGS.(10:1) = 1, so that  we  don't <<03522>>00915000
loop  forever.  ATTACHIO  handles the disc I/O request and re- <<03522>>00920000
turns two words to SDISCIO in  normal  fashion.  SDISCIO  pro- <<03522>>00925000
cesses this so that its two word return is appropriate for mag <<03522>>00930000
tape completion status.  The outer ATTACHIO call returns these <<03522>>00935000
two words to the original caller, in our example the File Sys- <<03522>>00940000
tem.                                                           <<03522>>00945000
$PAGE                                                          <<03522>>00950000
OPERATION -- Details:                                          <<03522>>00955000
                                                               <<03522>>00960000
  Data structures -- Data records and end-of-files:            <<03522>>00965000
                                                               <<03522>>00970000
  The primary purpose of  SDISC  is  to  adapt  the  undefined <<03522>>00975000
length  transfers  characteristic  of  mag  tape  to the fixed <<03522>>00980000
length environment of a disc or ICT.  To accomplish this, data <<03640>>00985000
is buffered within SDISC.  The buffer is an integral number of <<03522>>00990000
sectors (blocks for the ICT) long.  Files always  start  on  a <<03640>>00995000
sector  boundary, but data records within files may start any- <<03522>>01000000
where and straddle sector boundaries.  A record in the  buffer <<03522>>01005000
is structured as follows:                                      <<03522>>01010000
                                                               <<03522>>01015000
     +---------+-----------------------------+---------+       <<03522>>01020000
     | record  |                             | record  |       <<03522>>01025000
     | length  |             data            | length  |       <<03522>>01030000
     | (bytes) |                             | (bytes) |       <<03522>>01035000
     +---------+-----------------------------+---------+       <<03522>>01040000
                                                               <<03522>>01045000
The record length is always a  one-word  positive  byte  count <<03522>>01050000
which  includes  only  the data portion of the record, not the <<03522>>01055000
length words themselves. Records within a file might be stored <<03522>>01060000
on the disc as follows:                                        <<03522>>01065000
                                                               <<03522>>01070000
     +----+---------------------------+---       -----         <<03522>>01075000
     | RL |///////////////////////////|            ^           <<03522>>01080000
     +----+------+----+----+----------+            |           <<03522>>01085000
     |///////////| RL | RL |//////////|            |           <<03522>>01090000
     +-----------+----+--+-+--+----+--|       Sector N-1       <<03522>>01095000
     |///////////////////| RL | RL |//|            |           <<03522>>01100000
     +-------------------+----+----+--|            |           <<03522>>01105000
     |////////////////////////////////|            v           <<03522>>01110000
     +---+----+----+------------------+---       -----         <<03522>>01115000
     |///| RL | RL |//////////////////|            ^           <<03522>>01120000
     +---+----+--+-+--+----+----------+            |           <<03522>>01125000
     |///////////| RL | RL |//////////|            |           <<03522>>01130000
     +-----------+----+----++----+----+       Sector N         <<03522>>01135000
     |//////////////////////| RL | RL |            |           <<03522>>01140000
     +----------------------+----+----+            |           <<03522>>01145000
     |////////////////////////////////|            v           <<03522>>01150000
     +-----+----+----+----------------+---       -----         <<03522>>01155000
     |/////| RL | RL | .....          |                        <<03522>>01160000
     +-----+----+----+----------------+                        <<03522>>01165000
                                                               <<03522>>01170000
The reason for the trailing byte count is to implement an easy <<03522>>01175000
way to backspace records.                                      <<03522>>01180000
$PAGE                                                          <<03522>>01185000
  Since files always start on a sector  boundary,  it  follows <<04249>>01190000
that they also end on one.  End of files consist of a 0 record <<04249>>01195000
length and 0-fill to the end of the current sector as follows: <<04249>>01200000
                                                               <<04249>>01205000
     +--------------------------------+                        <<04249>>01210000
     |//////////////////////// RL RL /|                        <<04249>>01215000
     |////////////////////////////////|                        <<04249>>01220000
     |//////// RL RL /////////////////|       Sector N         <<04249>>01225000
     |                    +-----------+                        <<04249>>01230000
     |///////////////| RL | 0         |                        <<04249>>01235000
     +--------------------+           |                        <<04249>>01240000
     |                                |                        <<04249>>01245000
     |          Zero fill             |                        <<04249>>01250000
     +--------------------------------+---                     <<04249>>01255000
$PAGE                                                          <<04249>>01260000
  Data structures -- End-of-tape:                              <<04249>>01265000
                                                               <<04249>>01270000
  (Note: The function of the EOT reflector, described  in  the <<04249>>01275000
next  paragraph,  no  longer holds fully.  The mechanism below <<04249>>01280000
mistakenly assumed that a running MPE was  interested  in  the <<04249>>01285000
EOT reflector while reading.  In fact, the only time a running <<04249>>01290000
MPE cares about EOT is while writing, and SDISC can detect and <<04249>>01295000
manage the EOT condition while writing without writing a  spe- <<04249>>01300000
cial mark to the disc.  However, INITIAL needs the EOT reflec- <<04249>>01305000
tor when the system area (first two files) it  is  loading  is <<04249>>01310000
contained  on  two  or more volumes.  INITIAL uses the EOT re- <<04249>>01315000
flector to tell it when to request the next volume.  The stan- <<04249>>01320000
dard end-of-volume convention (two  EOF's)  cannot  be  easily <<04249>>01325000
used  because INITIAL gets confused and thinks it has detected <<04249>>01330000
the end of the system area (that is, the  start  of  any  user <<04249>>01335000
files).                                                        <<04249>>01340000
  Currently the only serial disc medium  which  requires  more <<04249>>01345000
than  one  volume  for  the  system  area  is the floppy disc. <<04249>>01350000
Therefore, the -2 mechanism described below  is  written  only <<04249>>01355000
when  the  serial  medium  is a floppy disc.  Code in SDISC to <<04249>>01360000
detect and ignore record lengths and  fill  characters  of  -2 <<04249>>01365000
while  reading has been retained for compatibility with serial <<04249>>01370000
discs written with this field.  The explanation below has been <<04249>>01375000
left in for historical purposes).                              <<04249>>01380000
  There were several considerations affecting  the  format  of <<04249>>01385000
the  EOT  reflector.  On  a tape drive, there is room to write <<04249>>01390000
beyond the reflector, so it was determined that the first sec- <<04249>>01395000
tor of the last track should trigger the EOT mechanism  during <<04249>>01400000
a  write  operation.  On a read cycle, it is critical that the <<04249>>01405000
same record that triggered the EOT mechanism on  write  do  it <<04249>>01410000
here.  As  all records are buffered, and the physical write of <<04249>>01415000
the buffer is what triggers the EOT on write, it was  impossi- <<04249>>01420000
ble  to tell which record in the buffer should have the honor. <<04249>>01425000
For this reason, a marker like the EOF mark was implemented to <<04249>>01430000
represent the EOT reflector.  This marker is like the  EOF  in <<04249>>01435000
every way except that the reclength is -2. When a read detects <<04249>>01440000
a record count of -2, the end of tape condition is returned to <<04249>>01445000
the user.                                                      <<04249>>01450000
                                                               <<04249>>01455000
             +--------------------------------+                <<04249>>01460000
             |//////////////////////// RL RL /|                <<04249>>01465000
             |////////////////////////////////|                <<04249>>01470000
             |//////// RL RL /////////////////|       Sector N <<04249>>01475000
             |                    +-----------+                <<04249>>01480000
             |///////////////| RL | -2        |                <<04249>>01485000
             +--------------------+           |                <<04249>>01490000
             |                                |                <<04249>>01495000
             |           -2 fill              |                <<04249>>01500000
             +--------------------------------+---             <<04249>>01505000
$PAGE                                                          <<04249>>01510000
  Data structures -- Contiguous blocks:                        <<03522>>01515000
                                                               <<03522>>01520000
  So much for data records.  But a serial disc, if it  can  do <<03522>>01525000
everything a mag tape can do, must also be a cold-load device. <<03522>>01530000
This means that machine microcode must be able to read a boot- <<03522>>01535000
strap channel program and the  resident  segments  of  INITIAL <<03522>>01540000
from the disc into memory.  The microcode and channel programs <<03522>>01545000
cannot deal with the record length words which surround stand- <<03522>>01550000
ard data records, so for them we have a  structure,  called  a <<03522>>01555000
CONTIGUOUS BLOCK, which has the data without the length words. <<03522>>01560000
Information as to the length of  each  contiguous  block  must <<03522>>01565000
therefore  be  kept  elsewhere, so there is a Gap Table (about <<03522>>01570000
which more later), which holds the beginning and ending sector <<03522>>01575000
addresses of each contiguous block.  This  implies  that  each <<03522>>01580000
block  must  begin  and end on a sector boundary.  In this way <<03522>>01585000
they are similar to data files.  To set contiguous blocks  off <<03522>>01590000
from  normal  data,  and  to reach a sector boundary, a record <<03522>>01595000
length and fill character = %177777 is used, as follows:       <<03522>>01600000
                                                               <<03522>>01605000
     +-------------------------------+---       -----          <<03522>>01610000
     |/////// Previous records //////|            ^            <<03522>>01615000
     |///////////////////////////////|            |            <<03522>>01620000
     |             +-----------------+            |            <<03522>>01625000
     |////////| RL | -1              |        Sector N-1       <<03522>>01630000
     +-------------+                 |            |            <<03522>>01635000
     |                               |            |            <<03522>>01640000
     |            -1 fill            |            |            <<03522>>01645000
     |                               |            v            <<03522>>01650000
     +-------------------------------+---       -----          <<03522>>01655000
     |                               |            ^            <<03522>>01660000
     |         Contiguous block      |        Sector N         <<03522>>01665000
     |                               |            v            <<03522>>01670000
     |                               +---       -----          <<03522>>01675000
     |                               |            ^            <<03522>>01680000
     |                +--------------+            |            <<03522>>01685000
     |                |              |        Sector N+1       <<03522>>01690000
     +----------------+              |            |            <<03522>>01695000
     |            -1 fill            |            v            <<03522>>01700000
     +-------------------------------+---       -----          <<03522>>01705000
$PAGE                                                          <<03522>>01710000
  Data structures -- Holes:                                    <<03522>>01715000
                                                               <<03522>>01720000
  Another fact of serial disc life  is  the  HOLE,  supposedly <<03522>>01725000
generated  while  writing  to the disc to avoid defective disc <<03522>>01730000
areas.  In reality, any I/O error  other  than  the  Read-Only <<03522>>01735000
switch  being  on will cause SDISC to generate a hole, even if <<03522>>01740000
the error had nothing to do with  a  disc  defect.  Holes  are <<03640>>01745000
generated only when the device is an HP7920, HP7925, HP7902 or <<03640>>01750000
HP9895.  The ICT and its physical  driver  automatically  deal <<03640>>01755000
with  media  defects found while writing.  The HP7935 does not <<03640>>01760000
detect media defects when writing,  so  the  hole  concept  is <<03640>>01765000
meaningless for this device and is not supported by the SDI.   <<03640>>01770000
  A hole consists of at least one track, and  always  consists <<03522>>01775000
of  an  integral number of tracks unless a contiguous block is <<03522>>01780000
involved (more on that in a moment).  If a write error is  de- <<03522>>01785000
tected on a given track, data already written on that track is <<03522>>01790000
transferred to the next track (repeatedly, if additional  err- <<03522>>01795000
ors are detected), until a good track is found or the simulat- <<03522>>01800000
ed End of Tape reflector is passed.  The "defective" track  is <<03522>>01805000
then  given  a beginning-end entry pair in the Gap Table so it <<03522>>01810000
will not be used again, and writing continues.                 <<03522>>01815000
  If the data in the defective track is part of  a  contiguous <<03522>>01820000
block,  the  entire  block is relocated even if it began on an <<03522>>01825000
earlier track, and the logical beginning address of the defec- <<03522>>01830000
tive area in the Gap Table  is  moved  back  to  the  original <<03522>>01835000
starting  address of the contiguous block.  In this case only, <<03522>>01840000
a hole might include the latter  part  of  an  otherwise  good <<03522>>01845000
track.  Thus  a  contiguous  block  is guaranteed to really be <<03522>>01850000
physically contiguous on the disc.                             <<03522>>01855000
  Holes are generated  automatically  by  SDISC  whenever  re- <<03522>>01860000
quired.  Contiguous  blocks may be written by any program run- <<03522>>01865000
ning in privileged mode.  A  carriage-control  code  of  %1001 <<03522>>01870000
tells SDISC to start a contiguous block, while a CCTL of %2001 <<03522>>01875000
ends it.  A CCTL of %1001 while already in a contiguous  block <<03522>>01880000
closes  that block and opens another.  A CCTL of %2001 without <<03522>>01885000
an earlier %1001 is an error.  While in the contiguous  block, <<03522>>01890000
no  special  CCTL  codes are needed.  In practice, SYSDUMP and <<03640>>01895000
its cousins SDUP and TPSTOMP are the only programs  which  use <<03640>>01900000
this  feature,  since they write all the channel microcode re- <<03640>>01905000
quired for cold-loading.                                       <<03640>>01910000
$PAGE                                                          <<03522>>01915000
  Data structures -- Gap Table:                                <<03522>>01920000
                                                               <<03522>>01925000
  Now what about this Gap Table we've been reading about. It's <<03522>>01930000
a series of two-word device address entries.  A permanent copy <<03522>>01935000
lives on the device, starting in sector  4,  while  a  working <<03522>>01940000
copy  lives  in  main memory.  The copy in memory is posted to <<03522>>01945000
the disc only when a backspace or rewind operation occurs  af- <<03522>>01950000
ter  writing.  The length is device-dependent according to the <<03522>>01955000
table below:                                                   <<03522>>01960000
                                                               <<03522>>01965000
         Device           Number of sectors (or ICT blocks)    <<03640>>01970000
         ------           ---------------------------------    <<03640>>01975000
                                                               <<03522>>01980000
         HP7920           44                                   <<03522>>01985000
         HP7925           106                                  <<03522>>01990000
         HP7935           219                                  <<03522>>01995000
         HP7902/9895      26                                   <<03522>>02000000
         ICT              4 blocks (Small cart), 15 (Large)    <<06745>>02005000
                                                               <<03522>>02010000
  SDISC calculates the length for a given device using parame- <<03522>>02015000
ters kept in the label sector. These parameters are calculated <<03522>>02020000
by the VINIT subsystem according to device and are  placed  in <<03522>>02025000
the label sector when SERIAL <ldev> is entered.  The layout of <<03522>>02030000
a serial disc in general, and the label sector in  particular, <<03522>>02035000
is described later on.  Here we'll just say that  the  alloca- <<03522>>02040000
tion  of  Gap  Table and data space on the disc is not optimal <<03522>>02045000
and can result in the Gap Table expanding so much that it runs <<03522>>02050000
into the data space.  When this happens, SDISC terminates with <<03522>>02055000
an error and a very unhappy user.  So the user  can't  say  we <<03522>>02060000
didn't warn him/her, we have implemented an early warning sys- <<03522>>02065000
tem with the current release.  When we are within ten  entries <<03522>>02070000
of  the end of the Gap Table, we return End of Tape (EOT) sta- <<03522>>02075000
tus, just as we would if we were actually running out of  data <<03522>>02080000
space.  Users who ignore this warning get the same fatal error <<03522>>02085000
as before.                                                     <<03522>>02090000
  The reason for the wide disparity in Gap  Table  lengths  is <<03522>>02095000
because  the  Gap Table is a sector (or ICT block) address ta- <<03640>>02100000
ble.  Its length is therefore related to the address space  of <<03522>>02105000
the device as well as the sector (block) length.  The 7920 Gap <<03522>>02110000
Table can hold 2814 entries (44 sectors * 128 words - 4  words <<03522>>02115000
of  header,  all  divided  by  2  words/entry) to take care of <<03522>>02120000
195552 sector addresses (815 logical  cylinders  *  5  tracks/ <<03522>>02125000
cylinder  - 1 track for the label, Gap Table, etc., all multi- <<03522>>02130000
plied by 48 sectors per track).  Users have experienced no Gap <<03522>>02135000
Table overflow with the 7920, so the 7920's ratio  of  address <<03522>>02140000
space to Gap Table entries (69.44) has been taken as a  figure <<03522>>02145000
of merit to determine the Gap Table length for the other devi- <<03522>>02150000
ces.  Those of you who are mathematically inclined  can  check <<03522>>02155000
this out.                                                      <<03522>>02160000
  The HP7935 is an exception.  With 404 Mbytes of  storage  it <<03522>>02165000
is  so  large that the Gap Table called for by the above ratio <<03522>>02170000
requires 355 sectors, or 45.4 Kwords.  This is more  than  the <<03522>>02175000
largest  MPE data segment can hold (32K).  Time constraints on <<03522>>02180000
the current  release  prevented  implementation  of  a  paging <<03522>>02185000
scheme  or  multiple  extra  data  segments,  so the Gap Table <<03640>>02190000
length has been arbitrarily set to 28,000 words.  This  allows <<03522>>02195000
for  the  other  storage which must also live in the data seg- <<03522>>02200000
ment.  This means the early warning mentioned above will occur <<03522>>02205000
when the HP7935 is about 5/8 full (assuming  the  magic  69.44 <<03522>>02210000
sectors/Gap Table entry ratio).                                <<03522>>02215000
                                                               <<03522>>02220000
The Gap Table looks like this:                                 <<03522>>02225000
                                                               <<03522>>02230000
    +---------------------------+                              <<03522>>02235000
  0 | sector addr of load point |\                             <<03522>>02240000
  1 |          unused           | \                            <<03522>>02245000
  2 |          unused           | Gap Table header             <<03522>>02250000
  3 |          unused           |/                             <<03522>>02255000
    +------+--------------------+                              <<03522>>02260000
    | type |                    |                              <<03522>>02265000
    +------+   Sector address   |   Entry (two words)          <<03522>>02270000
    |                           |                              <<03522>>02275000
    +------+--------------------+                              <<03522>>02280000
    | type |                    |                              <<03522>>02285000
    +------+   Sector address   |   Entry (two words)          <<03522>>02290000
    |                           |                              <<03522>>02295000
    +---------------------------+                              <<03522>>02300000
                  .                                            <<03522>>02305000
                  .                                            <<03522>>02310000
                  .                                            <<03522>>02315000
                                                               <<03522>>02320000
The type field is bits 0, 1 and 2  of  the  first  word.   The <<03522>>02325000
eight possible types are:                                      <<03522>>02330000
                                                               <<03522>>02335000
0.  End of File.  The associated sector address  contains  one <<03522>>02340000
    or  more  end of file fill characters (0) to fill out that <<03522>>02345000
    sector.  In the worst case (the previous record ended  ex- <<03522>>02350000
    actly  at the end of the previous sector), the end of file <<03522>>02355000
    sector contains all zeros.                                 <<03522>>02360000
1.  End of data.  The associated sector address  is  the  last <<03522>>02365000
    address  of  valid  data  plus 1, in other words, the next <<03640>>02370000
    available address.  In practice, such an entry is  usually <<03640>>02375000
    preceded  by  an end-of-file entry, since the EOD entry is <<03640>>02380000
    written when you stop writing, and the  file  system  will <<03522>>02385000
    not  let  you  backspace  or  rewind after writing without <<03522>>02390000
    sending a Write End of File.  An EOD entry is also written <<03640>>02395000
    at the beginning of the Gap  Table  when  new  (unwritten) <<03640>>02400000
    media  is  inserted.  This  prevents  erroneous reading of <<03640>>02405000
    blank media.                                               <<03640>>02410000
2.  Beginning of Hole.  The starting address of a  "defective" <<03522>>02415000
    area of the disc.  Usually on a track boundary, but may be <<03522>>02420000
    in mid-track if a contiguous block was being written  when <<03522>>02425000
    the "defect" was encountered.                              <<03522>>02430000
3.  End of Hole.  The corresponding ending address of the "de- <<03522>>02435000
    fective" area.  Always at a track  boundary.  The  end  of <<03640>>02440000
    hole  type must always be one larger than the beginning of <<03522>>02445000
    hole type, or else procedure SDISCFINDGAP will not work.   <<03522>>02450000
4.  Beginning of (contiguous) Block.  The starting address  of <<03522>>02455000
    a  contiguous  block,  exclusive of the -1 fill characters <<03522>>02460000
    which may have been required to get us to a sector bounda- <<03522>>02465000
    ry.  Unlike the End of File fill  characters,  there  need <<03522>>02470000
    not be any -1 characters if the previous record or contig- <<03522>>02475000
    uous block (with or without the trailing length word) end- <<03522>>02480000
    ed exactly on a sector boundary.                           <<03522>>02485000
$PAGE                                                          <<03522>>02490000
5.  End of (contiguous) Block.  The address of the last sector <<03522>>02495000
    containing contiguous block  data.  The  sector  may  also <<03522>>02500000
    contain -1 fill characters to get us to a sector boundary, <<03522>>02505000
    but as with the beginning of block they are  not  required <<03522>>02510000
    if the contiguous block ends exactly on a sector boundary. <<03522>>02515000
    The end of block type must always be one larger  than  the <<03522>>02520000
    beginning  of  block  type, or else procedure SDISCFINDGAP <<03522>>02525000
    will not work.                                             <<03522>>02530000
6.  End of Tape mark.  The sector address of the simulated End <<03522>>02535000
    of Tape reflector.  This type is currently used  only  for <<04249>>02540000
    floppy  discs  so that INITIAL can handle volume switching <<04249>>02545000
    while cold-loading from a multiple volume floppy disc set. <<04249>>02550000
7.  End of Gap Table.  No associated sector  address.  If  you <<03522>>02555000
    hit  this  while  scanning  the Gap Table, you've gone too <<03522>>02560000
    far.  In practice, this type is created whenever  the  Gap <<03522>>02565000
    Table is cleared, by the simple device of initializing the <<03640>>02570000
    table to -1.                                               <<03640>>02575000
                                                               <<03522>>02580000
  Data structures -- RECBUFF:                                  <<03522>>02585000
                                                               <<03522>>02590000
  To increase performance, the Serial Disc Interface maintains <<03522>>02595000
and manages a data buffer (called RECBUFF), exclusive  of  any <<03522>>02600000
File System buffers which might also be in use.  Caller I/O is <<03522>>02605000
to and from this buffer.  A full buffer while  writing  or  an <<03522>>02610000
empty one while reading cause SDISC to generate an actual disc <<03522>>02615000
I/O request to satisfy  the  problem.  This  I/O  is  blocked, <<03522>>02620000
meaning that the caller's process is waited until the I/O com- <<03522>>02625000
pletes.  SDISC also posts RECBUFF to the  disc  (even  if  not <<03522>>02630000
full) whenever a backspace or rewind occurs after writing.  As <<03522>>02635000
mentioned before, the File System guarantees that  we  have  a <<03522>>02640000
trailing  end  of  file  before the backspace or rewind is al- <<03522>>02645000
lowed.  RECBUFF is usually 4096 words long, since  performance <<03522>>02650000
measurements  have shown this to be the optimum compromise be- <<03522>>02655000
tween too small a buffer and hogging large amounts of contigu- <<03522>>02660000
ous main memory on small  systems.  Performance  and  lifetime <<03522>>02665000
constraints  of  the  ICT require a larger RECBUFF, so for the <<03640>>02670000
ICT a 16K-word RECBUFF is used.                                <<03640>>02675000
$PAGE                                                          <<03522>>02680000
  Data structures -- extra data segment:                       <<03522>>02685000
                                                               <<03522>>02690000
  You've been waiting for the other shoe to drop -- well  here <<03522>>02695000
it is!  With insignificant exceptions, SDISC operates entirely <<03522>>02700000
in split-stack mode, that is, using an extra data segment  for <<03522>>02705000
its  working  storage.  Since SDISCIO runs on the user's stack <<03522>>02710000
(under the File System and ATTACHIO), it really wouldn't do to <<03522>>02715000
have the user support a 16K RECBUFF (for an ICT)  or  a  13.6K <<03640>>02720000
Gap Table (for a 7925) on his stack.                           <<03522>>02725000
  Although SDISCIO spends most of its time communicating  with <<03522>>02730000
its  extra  data segment, it may be called with DB anywhere (a <<03522>>02735000
stack, another extra data segment, or SYSGLOB (%1000).  It re- <<03558>>02740000
turns with DB set as it was on entry.                          <<03522>>02745000
  The extra data segment is usually acquired by  the  external <<03522>>02750000
procedure  ALLOCATE  when  the serial disc device is first as- <<03522>>02755000
signed to a user as part of an FOPEN.  The external  procedure <<03522>>02760000
DEALLOCATE  makes the XDS go away as part of its processing of <<03522>>02765000
the final FCLOSE against the device. The system program PVPROC <<03522>>02770000
may also acquire and release an XDS so  that  the  tape  label <<03522>>02775000
routines in LABSEG may also use SDISC for their work when DEV- <<03522>>02780000
REC processes a device on-line interrupt.                      <<03522>>02785000
  In addition to the RECBUFF and Gap Table already  described, <<03522>>02790000
the  XDS contains SDISC's global storage area and a small buf- <<03522>>02795000
fer (called WORKTABLE) used to hold data while moving it  from <<03522>>02800000
a  "defective"  disc  area  to its new location as part of the <<03522>>02805000
process of creating a hole.  WORKTABLE also holds the contents <<03522>>02810000
of the Serial Disc label sector when SDISC reads it in as part <<03522>>02815000
of its self-configuration.  This is done in  GPTMOD,  function <<03522>>02820000
2, and further comments may be found there.                    <<03522>>02825000
  The three arrays in the XDS (WORKTABLE, RECBUFF and GPT (Gap <<03522>>02830000
Table) are all dynamically configured by SDISC as vanilla  in- <<03522>>02835000
direct  arrays,  such  as  might have been constructed by SPL. <<03522>>02840000
This is done by declaring the array names  as  pointers,  then <<03522>>02845000
inserting  appropriately computed element-0 addresses in them. <<03522>>02850000
The pointers used to reside immediately after XMITLOG,  which  <<03522>>02855000
was  the  last simple variable declared.  The first condition  <<03522>>02860000
was a holdover from when we actually used fixed length arrays  <<03522>>02865000
constructed by SPL.  With the present scheme the pointers may  <<03522>>02870000
live anywhere in the XDS, but XMITLOG must still be the  last  <<03522>>02875000
variable  so that we know where "secondary DB" starts for the  <<03522>>02880000
arrays.                                                        <<03522>>02885000
                                                               <<03522>>02890000
  The extra data segment is organized as follows:              <<03522>>02895000
                                                               <<03522>>02900000
    +-------------------+   These twelve words are reserved    <<03522>>02905000
  0 | WORDSPERSECTR     |   for use by ALLOCATE when the data  <<03522>>02910000
    |. . . . . . . . . .|   segment is created.  However, AL-  <<03522>>02915000
  1 | SECTORSPERTRAK    |   LOCATE only stuffs the last five   <<03522>>02920000
    |. . . . . . . . . .|   of them.  We fill the first seven  <<03522>>02925000
  2 | STARTADDRESS (BOT)|   ourselves with information we get  <<03522>>02930000
    |. . . . . . . . . .|   from the label sector.             <<03522>>02935000
  3 | EOTSECTR (disc    |                                      <<03522>>02940000
    | address of simu-  |                                      <<03522>>02945000
  4 | lated end of tape)|                                      <<03522>>02950000
    |. . . . . . . . . .|                                      <<03522>>02955000
$PAGE                                                          <<03522>>02960000
    |. . . . . . . . . .|                                      <<03522>>02965000
  5 | EODSECTR (last    |                                      <<03522>>02970000
    | sector of disc)   |   Simulates tape runoff.             <<03522>>02975000
  6 |                   |                                      <<03522>>02980000
    |. . . . . . . . . .|                                      <<03522>>02985000
  7 | JUSTALLOCATED     |   Tells us to initialize SDISC       <<03522>>02990000
    |. . . . . . . . . .|     parameters to BOT if true.       <<03522>>02995000
  8 | WRITERING         |   Simulation of tape write ring.     <<03522>>03000000
    |. . . . . . . . . .|                                      <<03522>>03005000
  9 | FATALERROR        |   Disables SDISC when true.          <<03522>>03010000
    |. . . . . . . . . .|                                      <<03522>>03015000
 10 | LPERRORLOG        |   Dumps XDS and user stack to LP     <<03522>>03020000
    |                   |     if true and FATALERROR occurs.   <<03522>>03025000
    |                   |     Currently may be set only in     <<03522>>03030000
    |. . . . . . . . . .|     DEBUG.                           <<03522>>03035000
 11 | MAX'DSEG'SIZE     |   Max size of our XDS, so we can     <<03522>>03040000
    +-------------------+     check that it's big enough.      <<03522>>03045000
    | SDISC global vari-|                                      <<03522>>03050000
    |   ables, including|                                      <<03522>>03055000
    |   array pointers. |                                      <<03522>>03060000
    +-------------------+                                      <<03522>>03065000
    | W                 |                                      <<03522>>03070000
    |   O               |   Length is WORDSPERSECTR *          <<03522>>03075000
    |     R             |     PORT'SECT'LEN.                   <<03522>>03080000
    |       K           |                                      <<03522>>03085000
    |         T         |                                      <<03522>>03090000
    |           A       |                                      <<03522>>03095000
    |             B     |                                      <<03522>>03100000
    |               L   |                                      <<03522>>03105000
    |                 E |                                      <<03522>>03110000
    +-------------------+                                      <<03522>>03115000
    | R                 |                                      <<03522>>03120000
    |   E               |   Length is RECBUFFLEN, which is     <<03522>>03125000
    |     C             |     calculated as 32 * WORDSPER-     <<03522>>03130000
    |       B           |     SECTR (32 blocks if ICT).        <<03640>>03135000
    |         U         |                                      <<03522>>03140000
    |           F       |                                      <<03522>>03145000
    |             F     |                                      <<03522>>03150000
    +-------------------+                                      <<03522>>03155000
    | G                 |   Length is GPTLEN, which is cal-    <<03522>>03160000
    |   A               |     culated as (STARTADDRESS -       <<03522>>03165000
    |     P             |     GPT'START) * WORDSPERSECTR.      <<03522>>03170000
    |                   |     Currently GPT'START is EQUATEd   <<03522>>03175000
    |         T         |     to 4.                            <<03522>>03180000
    |           A       |                                      <<03522>>03185000
    |             B     |                                      <<03522>>03190000
    |               L   |                                      <<03522>>03195000
    |                 E |                                      <<03522>>03200000
    +-------------------+                                      <<03522>>03205000
$PAGE                                                          <<03522>>03210000
  Data structures -- disc (or cartridge tape) organization:    <<03522>>03215000
                                                               <<03522>>03220000
  The disc is organized as follows:                            <<03522>>03225000
                                                               <<03522>>03230000
    +-------------------+                                      <<03522>>03235000
    | Label sector      |   0   See expanded view below.       <<03522>>03240000
    +-------------------+                                      <<03522>>03245000
    | Defective Trk Tbl |   1   Maintained by disc driver, not <<03640>>03250000
    +-------------------+         used by SDISC.               <<03640>>03255000
    | Cold load         |   2   HP-IB cold load channel prog.  <<03522>>03260000
    +-------------------+                                      <<03522>>03265000
    | Soft dump         |   3   SOFTDUMP channel program.      <<03522>>03270000
    +-------------------+                                      <<03522>>03275000
    | Gap Table         |   4 to STARTADDRESS - 1.             <<03522>>03280000
    |     .             |                                      <<03522>>03285000
    |     .             |                                      <<03522>>03290000
    +-------------------+                                      <<03522>>03295000
    | Data              |   STARTADDRESS                       <<03522>>03300000
    |     .             |        .                             <<03522>>03305000
    |     .             |        .                             <<03522>>03310000
    |     .             |        to                            <<03522>>03315000
    |. . . . . . . . . .|        .                             <<03522>>03320000
    |     .             |   EOTSECTR                           <<03522>>03325000
    |. . . . . . . . . .|        .                             <<03522>>03330000
    |     .             |        to                            <<03522>>03335000
    |. . . . . . . . . .|        .                             <<03522>>03340000
    | Last data sector  |   EODSECTR                           <<03522>>03345000
    +-------------------+                                      <<03522>>03350000
                                                               <<03522>>03355000
  Because the length of the Gap Table is fixed for a  specific <<03522>>03360000
device,  it  is  possible  for it to fill up (bump against the <<03522>>03365000
data area) before the data  area  does.  Currently  when  this <<03522>>03370000
happens SDISC generates a FATALERROR and dies.  A current  en- <<03640>>03375000
hancement  warns  the  user when the Gap Table is running low. <<03640>>03380000
An even better enhancement would be to  move  STARTADDRESS  to <<03522>>03385000
sector  4  and run the Gap Table backward from the last sector <<03522>>03390000
on the device.  This way the device may run out of data  space <<03522>>03395000
or  out of Gap Table, but would always be fully utilized.  The <<03522>>03400000
first enhancement was relatively easy, but the second is quite <<03640>>03405000
difficult.                                                     <<03522>>03410000
$PAGE                                                          <<03522>>03415000
  The label sector of a serial disc looks like this:           <<03522>>03420000
                                                               <<03522>>03425000
    +-------------------------------+                          <<03522>>03430000
  0 |                               |   0                      <<03522>>03435000
    |         0 (:STORE)            |                          <<03522>>03440000
  1 |                               |   1                      <<03522>>03445000
    |              or               |                          <<03522>>03450000
  2 |                               |   2                      <<03522>>03455000
    |   Cold-load SIO channel       |                          <<03522>>03460000
  3 |   program (non-HPIB machines  |   3                      <<03522>>03465000
    |   only)                       |                          <<03522>>03470000
  4 |                               |   4                      <<03522>>03475000
    |                    1 1 1 1 1 1|                          <<03522>>03480000
  5 |0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5|   5                      <<03522>>03485000
    +-+-+-+-----+-----------+-------+                          <<03522>>03490000
  6 |0|0|1|/////|   TYPE    |SUBTYPE|   6   Bit 0 = 1 ==>      <<03522>>03495000
    +-+-+-+-----+-----------+-------+         Scratch Volume   <<03522>>03500000
  7 |                               |   7   Bit 1 = 1 ==>      <<03522>>03505000
    |              0                |         Master Volume    <<03522>>03510000
 10 |                               |   8     of PV set.       <<03522>>03515000
    |                               |       Bit 2 = 1 ==>      <<03522>>03520000
 11 |                               |   9     Serial Disc.     <<03522>>03525000
    +---------------+---------------+                          <<03522>>03530000
 12 |      "S"      |      "E"      |  10 \                    <<03522>>03535000
    +---------------+---------------+      \                   <<03522>>03540000
 13 |      "R"      |      "D"      |  11   |  Volume          <<03522>>03545000
    +---------------+---------------+       |   name:          <<03522>>03550000
 14 |      "I"      |      "S"      |  12   |    "SERDISC "    <<03640>>03555000
    +---------------+---------------+      /                   <<03522>>03560000
 15 |      "C"      |      " "      |  13 /                    <<03522>>03565000
    +---------------+---------------+                          <<03522>>03570000
 16 |         WORDSPERSECTR         |  14                      <<03522>>03575000
    +-------------------------------+                          <<03522>>03580000
 17 |         SECTORSPERTRAK        |  15                      <<03522>>03585000
    +-------------------------------+                          <<03522>>03590000
 20 |          STARTADDRESS         |  16                      <<03522>>03595000
    +-------------------------------+                          <<03522>>03600000
 21 |                               |  17                      <<03522>>03605000
    |            EOTSECTR           |                          <<03522>>03610000
 22 |                               |  18                      <<03522>>03615000
    +-------------------------------+                          <<03522>>03620000
 23 |                               |  19                      <<03522>>03625000
    |            EODSECTR           |                          <<03522>>03630000
 24 |                               |  20                      <<03522>>03635000
    +-------------------------------+                          <<03522>>03640000
 25 | Reserved for WCS image        |  21                      <<03522>>03645000
  . |   address pairs.              |   .                      <<03522>>03650000
177 +-------------------------------+ 127                      <<03522>>03655000
$PAGE                                                          <<03522>>03660000
OPERATION -- FINDSDISCGAP:                                     <<03522>>03665000
                                                               <<03522>>03670000
  FINDSDISCGAP is a procedure currently called  only  by  SYS- <<03522>>03675000
DUMP.  It  scans  the  Gap Table and returns the starting disc <<03522>>03680000
address and the length of the contiguous block  whose  ordinal <<03522>>03685000
position  is passed in.  Since it does return information (re- <<03522>>03690000
ference parameters), it must be called with DB at  the  stack, <<03522>>03695000
although  it  operates  in  split-stack.  FINDSDISCGAP has two <<03522>>03700000
reasons for existence:                                         <<03522>>03705000
1.  SYSDUMP must know the starting address of  the  contiguous <<03522>>03710000
    blocks  the  cold-load  channel program is to read.  FIND- <<03522>>03715000
    SDISCGAP removes the need for SYSDUMP  to  keep  track  of <<03522>>03720000
    these addresses while it is writing the blocks.            <<03522>>03725000
2.  Even if SYSDUMP were trying to keep track of its own block <<03522>>03730000
    addresses, SDISC might relocate some blocks in the process <<03522>>03735000
    of generating holes.  SYSDUMP would not know of  this  and <<03522>>03740000
    would, therefore, build an incorrect channel program.      <<03522>>03745000
So SYSDUMP builds its cold-load contiguous block  areas,  then <<03522>>03750000
calls  FINDSDISCGAP  repeatedly until it has determined all of <<03522>>03755000
their locations and lengths.  It then stuffs this  information <<03522>>03760000
in the various parts of the channel program that require it.   <<03522>>03765000
                                                               <<03522>>03770000
AND NOW, ON-A WIT-A DA SHOW ...                                <<03522>>03775000
;                                                              <<03522>>03780000
                                                               <<06745>>03785000
                                                               <<06745>>03790000
                                                               <<06745>>03795000
       <<------------------------>>                                     03800000
       <<SYSTEM TABLES AND VALUES>>                                     03805000
       <<------------------------>>                                     03810000
$SET X8 = ON                                                   <<06745>>03815000
$INCLUDE INCLSYSG                                              <<L8989>>03820000
$INCLUDE INCLLDT5                                              <<06745>>03825000
$INCLUDE INCLLPDT                                              <<06745>>03830000
$PAGE "MPE TABLE ACCESS:  PCB"                                 <<06745>>03835000
$INCLUDE INCLPCB5                                              <<06745>>03840000
$PAGE "MPE TABLE ACCESS:  PXGLOBAL"                            <<06745>>03845000
$INCLUDE INCLPXG                                               <<06745>>03850000
$PAGE "MPE TABLE ACCESS:  DISC INFO VALUES (1/2)"              <<07114>>03855000
$INCLUDE INCDISC1                                              <<07114>>03860000
$PAGE "SDISC - Global Declarations"                            <<07114>>03865000
EQUATE                                                         <<M7478>>03870000
   JUNKWAIT = %20,       << Process wait code.              >> <<M7478>>03875000
   STACK    =   0;       << EXCHANGEDB parameter.           >> <<M7478>>03880000
                                                               <<M7478>>03885000
DEFINE                                                         <<06745>>03890000
   DISABLE     = ASSEMBLE (SED 0)#,                            <<06745>>03895000
   ENABLE      = ASSEMBLE (SED 1)#,                            <<06745>>03900000
   PDISABLE    = ASSEMBLE (PSDB) #,                            <<M7478>>03905000
   PENABLE     = ASSEMBLE (PSEB) #;                            <<M7478>>03910000
                                                               <<06745>>03915000
       <<--------------------->>                                        03920000
       <<GAP TABLE ENTRY TYPES>>                                        03925000
       <<--------------------->>                                        03930000
EQUATE                                                                  03935000
       EOFTYPE         =0,   <<END OF FILE MARK IN GPT>>                03940000
       EODTYPE         =1,   << Last valid data mark >>        <<03522>>03945000
       BOHTYPE         =2,   <<BEGINNING OF HOLE MARK IN GPT>>          03950000
       EOHTYPE         =3,   <<END OF HOLE MARK IN GPT>>                03955000
       BOBTYPE         =4,   <<START OF CONTIGUOUS BLOCK>>              03960000
       EOBTYPE         =5,   <<END OF CONTIGUOUS BLOCK>>                03965000
       EOTTYPE         =6,   << EOT reflector >>               <<03522>>03970000
       ENDOFTABLETYPE  =7;                                              03975000
       <<*************************************>>                        03980000
       <<**                                 **>>                        03985000
       << "END OF HOLE" and "END OF BLOCK"    >>                        03990000
       << entrytypes must be one larger than  >>                        03995000
       << corresponding "START OF ..." entry- >>                        04000000
       << types for SDISCFINDGAP to operate.  >>                        04005000
       <<**                                 **>>                        04010000
       <<*************************************>>                        04015000
                                                               <<03522>>04020000
       <<----------------------->>                             <<03522>>04025000
       << GPTMOD function codes >>                             <<03522>>04030000
       <<----------------------->>                             <<03522>>04035000
EQUATE                                                         <<03522>>04040000
       WRITE'EOT'MARK       = 0,   << Write EOT in Gap Tbl. >> <<04249>>04045000
       BRAND'NEW'TAPE       = 1,   << Initialize Gap Table. >> <<03522>>04050000
       NEW'VOLUME           = 2,                               <<03733>>04055000
       WRITE'EOD'AND'POST   = 3,   << Copy GPT to device.   >> <<03522>>04060000
       WRITE'EOF'MARK       = 4,                               <<03522>>04065000
       ENTER'CONTIG'BLOCK   = 6,                               <<04249>>04070000
       FIND'CONTIG'BLOCK'N  = 8,   << See GPTMOD for descr. >> <<07114>>04075000
       UPDT'FOR'READ'OP     = 9,   << This one too.         >> <<03522>>04080000
       CLEAR'TO'END         =10;   << Erase GPT beyond ad-  >> <<03522>>04085000
                                   <<   dress in parm S1.   >> <<03522>>04090000
                                                               <<03522>>04095000
EQUATE GPTENTSIZE=2;                                           <<00494>>04100000
EQUATE HARDWARE'EOF=1;                                         <<00494>>04105000
EQUATE NO'EOF      =0;                                         <<03522>>04110000
$PAGE                                                          <<07114>>04115000
       <<------------------------->>                                    04120000
       <<CONSOLE MESSAGE INTERFACE>>                                    04125000
       <<------------------------->>                                    04130000
EQUATE                                                                  04135000
       CONSOLE   =    0,  <<GENMSG destination code.        >> <<M7478>>04140000
       SET1      =    1,  <<CATALOG SET NUMBER>>                        04145000
       SET19     =   19,  <<SERIAL DISC SET NUMBER>>                    04150000
       MESS10    =   10,  <<Wrong volume, another avail?>>     <<M7478>>04155000
       MESS11    =   11,  <<LDEV #\, NOT READY>>               <<M7478>>04160000
       MESS220   =  220,  <<LDEV #! NO WRITE RING>>                     04165000
       MESS273   =  273,  <<LDEV #! NOT READY OR NOT SERIAL>>           04170000
       MESS274   =  274,  <<LDEV #! WRITE RING?>>              <<M7478>>04175000
       REPLY'YESNO =  1;  <<GENMSG code, expects Y/N reply>>   <<M7478>>04180000
                                                               <<03522>>04185000
       <<------------------------------------------------>>    <<03522>>04190000
       << ATTACHIO and SDISC function  codes  for  discs >>    <<07114>>04195000
       << and mag tapes.                                 >>    <<07114>>04200000
       <<------------------------------------------------>>    <<03522>>04205000
EQUATE                                                         <<03522>>04210000
       READ       =  0,                                        <<03522>>04215000
       WRITE'EOT  =  0,   << CTRSLDISC function.            >> <<04249>>04220000
       WRITE      =  1,                                        <<03522>>04225000
       OPEN'FILE  =  2,                                        <<03522>>04230000
       CLOSE'FILE =  3,                                        <<03522>>04235000
       CLOSE'DEVC =  4,                                        <<03522>>04240000
       REWIND     =  5,                                        <<03522>>04245000
       WRITE'EOF  =  6,                                        <<03522>>04250000
       FSF        =  7,   << Forward space file.            >> <<03522>>04255000
       BSF        =  8,   << Backspace file.                >> <<03522>>04260000
       REW'UNLOAD =  9,                                        <<03522>>04265000
       UNLOAD     =  9,   << Cartridge tape unload.         >> <<03522>>04270000
       INITIALIZE =  9,   << MAC family discs only.         >> <<07114>>04275000
         DEFECTIVE=  1,   << SPD value when initializing.   >> <<07114>>04280000
         DELETED  =  1,   << Same thing, another name.      >> <<07114>>04285000
         SPARE    =  4,   << Another SPD value.             >> <<07114>>04290000
       GAP        = 10,   << Not used in SDISC.             >> <<03522>>04295000
       RFS        = 10,   << Read Full Sector, MAC discs.   >> <<07114>>04300000
       FSR        = 11,   << Forward space record.          >> <<03522>>04305000
       WRITE'LABEL= 11,   << Discs only.                    >> <<07114>>04310000
       BSR        = 12,   << Backspace record.              >> <<03522>>04315000
       REQ'VOLUME'LIMIT = 13,   << CS80 discs only.         >> <<07114>>04320000
       GET'STATUS = 15,   << Get device hardware status.    >> <<07114>>04325000
       LOCK       = 16,   << CS80 device code.              >> <<07114>>04330000
       UNLOCK     = 17,   << CS80 device code.              >> <<07114>>04335000
       SPARE'BLOCK= 88;   << CS80 discs only.               >> <<07114>>04340000
                                                                        04345000
       <<--------------------------->>                                  04350000
       <<SPECIAL FWRITE CONTROLCODES>>                                  04355000
       <<--------------------------->>                                  04360000
EQUATE                                                                  04365000
       SETCONTIG       = %1001,   << Function code to start >>          04370000
                                  <<   a contiguous block.  >>          04375000
       ENDCONTIG       = %2001,   << Function code to end   >> <<03733>>04380000
                                  <<   a contiguous block.  >>          04385000
       PRIV'WRITE'EOD  = %3001;   << Flush Gap Table with   >> <<03733>>04390000
                                  <<   EOD at EOT. For user >> <<03733>>04395000
                                  <<   logging recovery.    >> <<03733>>04400000
                                                                        04405000
$PAGE                                                          <<07114>>04410000
       <<---->>                                                         04415000
       <<MISC>>                                                         04420000
       <<---->>                                                         04425000
EQUATE                                                                  04430000
   BLOCKED        =   1, << P'ATTACHIO parameter causes     >> <<07114>>04435000
                         << true disc I/O with wait.        >> <<07114>>04440000
   BUFFALO        =   3, << BUFFALO subtype in CS80 type.   >> <<07114>>04445000
   CS80           =   3, << Hardware type of CS80 devices.  >> <<07114>>04450000
   DEFAULT'SECTOR'SIZE = 128,  << Used before we obtain     >> <<03522>>04455000
                               << WORDPERSECTR from label.  >> <<03522>>04460000
   EOF'MARK       =   0, << Fills out sector at EOF.        >> <<03522>>04465000
   EOT'MARK       =  -2, << Fills out sector at EOT mark.   >> <<03522>>04470000
   ERR'LIMIT      =   4, << Max. # of disc write retries.   >> <<01598>>04475000
   FILLCHAR       =  -1, << Sector fill so that contiguous  >> <<04249>>04480000
                         << blocks/holes start and end on   >> <<04249>>04485000
                         << sector boundaries.          >>     <<04249>>04490000
   FLOPPY'DISC    =   2, << Hardware type of floppy disc.   >> <<04249>>04495000
   GPT'START      =   4, << GPT-relative index of 1st entry >> <<00189>>04500000
   GPTBASESECTOR  =   4, << Starting disc addr of Gap Table >>          04505000
   LINUS          =   0, << LINUS subtype in CS80 type.     >> <<07114>>04510000
   MAX'SECTOR'SIZE= 512, << Size of ICT block.              >> <<07114>>04515000
   QMISC'         =   0, << ATTACHIO parameter.             >> <<07114>>04520000
   UNBLOCKED      =   0; << P'ATTACHIO parameter causes no- >> <<07114>>04525000
                         << wait I/O, no wake on completion,>> <<07114>>04530000
                         << impede if no DRQ entry.         >> <<07114>>04535000
                                                                        04540000
DEFINE                                                                  04545000
       ATIOERR          = ERR1.(13:3) <> 1#,                   <<07114>>04550000
       CARTRIDGE'TAPE   = TYPE = CS80 LAND (SUBTYPE = LINUS    <<07114>>04555000
                                 LOR SUBTYPE = BUFFALO)#,      <<07114>>04560000
       GPT'ADR'FIELD    = (3:13)#,                                      04565000
       GPT'TYPE'FIELD   = (0:3)#,                                       04570000
       NO'ATIOERROR     = [16/1, 16/0]D#,                      <<04742>>04575000
       RECBUFFSECTORLEN = (RECBUFFLEN+1) / WORDSPERSECTR#,              04580000
       SDERR            = ((ERRORCODE > 0) LAND                <<04742>>04585000
                             NOT DEVICE'CLOSE'FLAG)#,          <<04742>>04590000
       SUBTYPE          = TYPE'SUBTYPE.(12:4)#,                <<03522>>04595000
       SUBTYPE'FIELD    = (12:4)#,   << in VLAB(6).         >> <<03522>>04600000
       SYSBUFRS         = (12:1)#,   << in FLAGS.           >> <<07065>>04605000
       TYPE             = TYPE'SUBTYPE.(0:7)#,                 <<03522>>04610000
       TYPE'FIELD       = (6:6)#;    << in VLAB(6).         >> <<03522>>04615000
                                                                        04620000
$PAGE                                                          <<07114>>04625000
COMMENT --                                                     <<06745>>04630000
  Subroutine "declarations" for MOVEFROMDSEG,  MOVETODSEG  and <<06745>>04635000
MOVEDSEG.  To  use, declare "SUBROUTINE DEF'MOVExxDSEG in each <<06745>>04640000
procedure requiring it.  Note that DBSOURCE and  DBTARGET  are <<06745>>04645000
of type LOGICAL, not LOGICAL POINTER.  This makes it easier to <<06745>>04650000
move one or two word quantities from/to single or double  word <<06745>>04655000
cells  which  are not arrays or pointers.  Remember to include <<06745>>04660000
the "@" sign. CAUTION:  Beware the split-stack trap. Never use <<06745>>04665000
a Q- or S-relative DBSOURCE or DBTARGET in split-stack mode.   <<06745>>04670000
;                                                              <<06745>>04675000
DEFINE                                                         <<06745>>04680000
                                                               <<06745>>04685000
   DEF'MOVEFROMDSEG =                                          <<06745>>04690000
      MOVEFROMDSEG (DBTARGET, DSTN, DSTOFFSET, WORD'COUNT);    <<06745>>04695000
         VALUE   DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;        <<06745>>04700000
         LOGICAL DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;        <<06745>>04705000
      BEGIN                                                    <<06745>>04710000
      X := TOS;            << Save    return address.       >> <<06745>>04715000
      ASSEMBLE (MFDS 0);                                       <<06745>>04720000
      TOS := X;            << Restore return address.       >> <<06745>>04725000
      END #,                                                   <<06745>>04730000
                                                               <<06745>>04735000
   DEF'MOVETODSEG =                                            <<06745>>04740000
      MOVETODSEG (DSTN, DSTOFFSET, DBSOURCE, WORD'COUNT);      <<06745>>04745000
         VALUE   DSTN, DSTOFFSET, DBSOURCE, WORD'COUNT;        <<06745>>04750000
         LOGICAL DSTN, DSTOFFSET, DBSOURCE, WORD'COUNT;        <<06745>>04755000
      BEGIN                                                    <<06745>>04760000
      X := TOS;                                                <<06745>>04765000
      ASSEMBLE (MTDS 0);                                       <<06745>>04770000
      TOS := X;                                                <<06745>>04775000
      END #,                                                   <<06745>>04780000
                                                               <<06745>>04785000
   DEF'MOVEDSEG =                                              <<06745>>04790000
      MOVEDSEG   (TARGET'DST, TARGET'OFFSET,                   <<07114>>04795000
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT);       <<06745>>04800000
         VALUE   TARGET'DST, TARGET'OFFSET,                    <<07114>>04805000
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT;        <<07114>>04810000
         LOGICAL TARGET'DST, TARGET'OFFSET,                    <<07114>>04815000
                 SOURCE'DST, SOURCE'OFFSET, WORD'COUNT;        <<06745>>04820000
      BEGIN                                                    <<06745>>04825000
      X := TOS;                                                <<06745>>04830000
      ASSEMBLE (MDS 0);                                        <<06745>>04835000
      TOS := X;                                                <<06745>>04840000
      END #;                                                   <<06745>>04845000
                                                               <<07114>>04850000
                                                               <<07114>>04855000
       <<---------------------->>                                       04860000
       <<SERIAL DISC ERRORCODES>>                                       04865000
       <<---------------------->>                                       04870000
$PAGE                                                          <<06745>>04875000
  COMMENT -- Positive error codes < 100 are fatal errors, that <<03640>>04880000
is, they cause SDISCIO to set the FATALERROR flag (disallowing <<03640>>04885000
further serial disc operations on this FOPEN for this device), <<03640>>04890000
generate an error message to $STDLIST and return  an  ATTACHIO <<03640>>04895000
status to the caller.  Negative error codes and positive error <<03640>>04900000
codes >= 100 are not fatal and generate no message.  They  do, <<03640>>04905000
however,  return  the ATTACHIO status corresponding to \error- <<03640>>04910000
code\ or (errorcode - 100), as appropriate. The difference be- <<03640>>04915000
tween the two types of non-fatal codes is that  positive  ones <<03640>>04920000
abort the current request, negative ones allow it to continue. <<03640>>04925000
;                                                              <<03640>>04930000
EQUATE                                                                  04935000
      SDERR0=0,<<ALL OKAY--OR--EOF DETECTED                  >>         04940000
      SDERR1=1, << SDISC cannot be accessed via sys bufs.   >> <<07114>>04945000
      SDERR2=2, << ATTACHIO faliure - rd/wrt disc label.    >> <<07114>>04950000
      SDERR3=3,<<FATAL ERROR DETECTED-SDISC DISABLED         >><<00239>>04955000
      SDERR4=4,<<INVALID LENGTH PASSED TO "WRITE"            >>         04960000
      SDERR5=5,<<END OF TAPE DETECTED                        >>         04965000
      SDERR6=6, << ATTACHIO failure - reading DTT/DSCT.      >><<07114>>04970000
      SDERR7=7,<<PACK OVERFLOW-PROBABLY IGNORED EOT          >>         04975000
      SDERR8=8, << ATTACHIO failure - writing DTT/DSCT.      >><<07114>>04980000
      SDERR9=9,<<CONTIG & NON-CONTIG DATA MIXED IN RECBUFF   >>         04985000
      SDERR10=10, << File not open, can't call FINDSDISCGAP >> <<03558>>04990000
      SDERR11=11,  << FINDSDISCGAP - Block no. must be > 0. >> <<03522>>04995000
      SDERR12=12,  << ATTACHIO failure - assigning alt trks. >><<07114>>05000000
      SDERR13=13,<<ATTACHIO FAILURE-READING GAP TABLE        >>         05005000
      SDERR14=14,<<INVALID CONTROLCODE                       >>         05010000
      SDERR15=15,<<ATTACHIO FAILURE-WRITING GPT              >>         05015000
      SDERR16=16,<<ATTEMPTED TO WRITE ON PROTECTED DISC      >><<00239>>05020000
      SDERR17=17,<<OUT OF SYNC WITH GAPTABLE WHILE READING   >>         05025000
      SDERR18=18,<<GAPTABLE EXPANDED BEYOND CAPACITY         >><<00189>>05030000
      SDERR19=19,<<TOO MANY EOF MARKS FOR THIS DISC TYPE     >><<00467>>05035000
      SDERR20=20, << No spare blocks available.             >> <<03522>>05040000
      SDERR21=21, << Uninitialized media.                   >> <<03522>>05045000
      SDERR22=22,<<ATTEMPTED TO READ PAST END OF DATA        >>         05050000
      SDERR23=23,<<CURRENTBUFINDEX OUTSIDE OF RECBUFF        >>         05055000
      SDERR24=24,<<ATTEMPTED TO BSF BEYOND BOT               >>         05060000
      SDERR25=25,<<ATTEMPTED TO BACKWARD READ PAST LOADPOINT >>         05065000
      SDERR26=26, << Unused.                                >> <<03522>>05070000
      SDERR27=27,<<RUN AWAY SERIAL DISC                      >>         05075000
      SDERR28=28,<<LOCATED BEYOND END OF GAP TABLE           >><<00189>>05080000
      SDERR29=29, << ATTACHIO failure - writing data.       >> <<03522>>05085000
      SDERR30=30,<<LEADING AND TRAILING RECLENS DON'T MATCH  >>         05090000
      SDERR31=31,<<FINDGAP FAILURE-TRIED TO OVERFILL RECBUFF >>         05095000
      SDERR32=32,<<ATTACHIO FAILURE-READING DATA             >>         05100000
      SDERR33=33, << Corrupt DTT/DSCT.                      >> <<07114>>05105000
      SDERR34=34, << Unused.                                >> <<03522>>05110000
      SDERR35=35,<<DSTN IN LDTX IS ZERO FOR THIS SDISC       >>         05115000
      SDERR36=36, << Insufficient data segment size.        >> <<03522>>05120000
      SDERR37=37,<<ATTEMPTED WRITE PAST EOT W/O P2.(13:1)=1  >>         05125000
      SDERR38=38, << ATTACHIO failure - load or unload.     >> <<03522>>05130000
      SDERR39=39, << Unused.                                >> <<03522>>05135000
      SDERR40=40,<<NO WRITE RING                             >>         05140000
      SDERR41=41, << Unused.                                >> <<03522>>05145000
      SDERR42=42, << Unused.                                >> <<03522>>05150000
      SDERR43=43,<<NECESSARY PARM MISSING IN CALL TO GPTMOD  >><<00189>>05155000
      SDERR122=122; << File system anticipatory read.       >> <<03640>>05160000
$PAGE                                                          <<03640>>05165000
<<********************************************>>                        05170000
<<THESE VARIABLES DEFINE THE SERIAL DISC DATA >>                        05175000
<<SEGMENT AND MUST NOT BE MOVED OR REDEFINED  >>                        05180000
<<WITHOUT MAKING THE CORRESPONDING CHANGES IN >>                        05185000
<<ALL MPE MODULES WHICH REFERENCE A SERIAL    >>                        05190000
<<DISC DATA SEGMENT                           >>                        05195000
<<********************************************>>                        05200000
EQUATE                                                                  05205000
  INITARRAYSIZE = 12;   << Number of elements reserved for  >> <<03522>>05210000
                        <<   ALLOCATE.                      >> <<03522>>05215000
DEFINE IAS=INITARRAYSIZE#;                                              05220000
EQUATE IAS0=IAS+0,                                                      05225000
       IAS1=IAS+1,                                                      05230000
       IAS2=IAS+2,                                                      05235000
       IAS3=IAS+3,                                                      05240000
       IAS4=IAS+4,                                                      05245000
       IAS5=IAS+5,                                                      05250000
       IAS6=IAS+6,                                                      05255000
       IAS7=IAS+7,                                                      05260000
       IAS8=IAS+8,                                             <<00239>>05265000
       IAS9=IAS+9;                                             <<00239>>05270000
INTEGER ARRAY DBARRAY(*)=DB;                                   <<00494>>05275000
                                                               <<03522>>05280000
<< The following array is never referenced  in  SDISC,  but >> <<03522>>05285000
<< must  be included so that DB-relative variables declared >> <<03522>>05290000
<< later do not step on the equivalenced variables below.   >> <<03522>>05295000
                                                               <<03522>>05300000
INTEGER ARRAY DBHOLD(0:IAS9)=DB;                               <<00239>>05305000
INTEGER                                                                 05310000
        WORDSPERSECTR=DB,                                      <<03522>>05315000
        SECTORSPERTRAK=DB+1,  <<#SECTORS/TRACK FOR THIS DISC>>          05320000
        STARTADDRESS=DB+2;   <<SECTOR#OF LOAD POINT>>                   05325000
                                                               <<03522>>05330000
DOUBLE                                                                  05335000
  EOTSECTR = DB+3,   << Device address of simulated EOT re- >> <<03522>>05340000
                     << flector.                            >> <<03522>>05345000
  EODSECTR = DB+5;   << Highest address on device --   >>      <<03522>>05350000
                                                                        05355000
INTEGER                                                                 05360000
  EODSECTR0 = EODSECTR,                                        <<03522>>05365000
  EODSECTR1 = EODSECTR + 1,                                    <<03522>>05370000
  EOTSECTR0 = EOTSECTR,                                        <<03522>>05375000
  EOTSECTR1 = EOTSECTR + 1;                                    <<03522>>05380000
                                                               <<03522>>05385000
LOGICAL                                                                 05390000
        JUSTALLOCATED=DB+7,<<SET TRUE BY ALLOCATE AND REWUNLD>>         05395000
        WRITERING=DB+8,    <<FLAG--SIMULATION OF WRITE RING>>  <<00239>>05400000
        FATALERROR=DB+9,<<FLAG--DISABLES ALL SDISC FUNCTIONS>> <<00494>>05405000
                                                               <<07114>>05410000
<< LPERRORLOG, DB+10, no longer used.                       >> <<07114>>05415000
                                                               <<07114>>05420000
        MAX'DSEG'SIZE = DB+11;   << Set by ALLOCATE, used   >> <<03522>>05425000
                                 << to check for enough GPT >> <<03522>>05430000
$PAGE                                                          <<03640>>05435000
INTEGER ARRAY PARMARRAY(*)=DB+IAS0;                                     05440000
INTEGER                                                                 05445000
       LDNUM=DB+IAS0,      <<PARAMETERS PASSED TO ATTACHIO>>            05450000
       QMISC=DB+IAS1,                                                   05455000
       DSTX=DB+IAS2,                                                    05460000
       ADDR=DB+IAS3,                                                    05465000
       FUNC=DB+IAS4,                                                    05470000
       CNT=DB+IAS5,                                                     05475000
       P1=DB+IAS6,                                                      05480000
       P2=DB+IAS7,                                                      05485000
       FLAGS=DB+IAS8;                                                   05490000
$PAGE                                                          <<03522>>05495000
<<********************************************>>                        05500000
<<THE FOLLOWING DB-RELATIVE VARIABLES ARE NOT >>                        05505000
<<REFERENCED OUTSIDE OF THE SERIAL DISC       >>                        05510000
<<INTERFACE AND MAY BE REARRANGED OR DELETED  >>                        05515000
<<AS NECESSARY FOR SUPPORT OF THE SERIAL      >>                        05520000
<<INTERFACE.                                  >>               <<07114>>05525000
<<********************************************>>                        05530000
DOUBLE                                                                  05535000
   CONTIGSTARTSECT,   << Disc address of start of current   >>          05540000
                      << contiguous write block -OR- -1 if  >>          05545000
                      << not currently writing contig blk.  >>          05550000
   RECBUFFSA,         << Disc address where start of RECBUFF >><<00494>>05555000
                      << came from or will go.              >> <<00494>>05560000
   RECBUFFEA;         << Same for end of RECBUFF.           >> <<00494>>05565000
                                                                        05570000
DEFINE                                                         <<00494>>05575000
   CURRENTADR = RECBUFFSA +                                             05580000
                  DOUBLE (CURRENTBUFINDEX/WORDSPERSECTR)#;     <<03522>>05585000
                                                               <<03522>>05590000
LOGICAL                                                                 05595000
   SDISC'FLAGS,       << Up to 16 1- and 2-bit flags.       >> <<07114>>05600000
   SDISC'VERSION,                                              <<07114>>05605000
   TEMP,              << DB-relative to avoid split-stack   >> <<07114>>05610000
                      << problems in READSDISC, elsewhere.  >> <<07114>>05615000
   TYPE'SUBTYPE;      << Holds hdwr device type & subtype.  >> <<03522>>05620000
                                                               <<07114>>05625000
DEFINE                                                         <<07114>>05630000
   ALREADYREJECTED   = SDISC'FLAGS.(14:1) #,                   <<07114>>05635000
   BACKSPACING       = SDISC'FLAGS.(13:1) #,                   <<07114>>05640000
   BOT'SENSOR        = SDISC'FLAGS.(12:1) #,                   <<07114>>05645000
       BOT'NOT'FOUND = 0                  #,                   <<07114>>05650000
       BOT'FOUND     = 1                  #,                   <<07114>>05655000
   DEVICE'CLOSE'FLAG = SDISC'FLAGS.(15:1) #,                   <<07114>>05660000
   EOTSENSOR         = SDISC'FLAGS.(10:2) #,                   <<07114>>05665000
   NEXTRECINBUF      = SDISC'FLAGS.( 9:1) #,                   <<07114>>05670000
   NULLTRANSFER      = SDISC'FLAGS.( 8:1) #,                   <<07114>>05675000
   TAPEREWOUND       = SDISC'FLAGS.( 7:1) #,                   <<07114>>05680000
   TAPEWRITTEN       = SDISC'FLAGS.( 6:1) #;                   <<M7478>>05685000
                                                               <<07114>>05690000
LOGICAL ARRAY                                                  <<07114>>05695000
   LDT (0:SIZE'OF'LDT'ENTRY-1)  = DB,   << Must be direct.  >> <<07114>>05700000
   LDTX(0:SIZE'OF'LDTX'ENTRY-1) = DB;   << This one too.    >> <<07114>>05705000
                                                               <<03522>>05710000
LOGICAL POINTER                                                <<03522>>05715000
   WORKTABLE,   << Holds volume label, Defective Track  Ta- >> <<07114>>05720000
                << ble  (DTT)  or  Defective  Sector  Table >> <<07114>>05725000
                << (DSCT) while we're working with it.  The >> <<07114>>05730000
                << area above the first 128 words  is  also >> <<07114>>05735000
                << used as a Read Full Sector buffer.       >> <<07114>>05740000
   DSCT = WORKTABLE,                                           <<07114>>05745000
   DTT  = WORKTABLE,                                           <<07114>>05750000
   GPT;         << The Gap Table.                           >> <<03522>>05755000
$PAGE                                                          <<M7478>>05760000
BYTE POINTER                                                   <<M7478>>05765000
   WORKTABLE'B;                                                <<M7478>>05770000
                                                               <<M7478>>05775000
INTEGER                                                                 05780000
   CURRENTBUFINDEX,     << Word displacement in RECBUFF.    >>          05785000
                        << Varies from 0 to RECBUFFLEN.     >>          05790000
   CURRENTGPTENT,       << Word displacement in Gap Table.  >>          05795000
                        << Varies from GPT'START to GPTLEN. >>          05800000
   DBOFFSET,            << Offset to DB (DB-DL) in caller's >>          05805000
                        << stack -OR- 0 if we were called   >>          05810000
                        << in split-stack.                  >>          05815000
   DSTN,                << Serial Disc data segment number. >>          05820000
   EOFCODE,             << 0 = no EOF, 1 = EOF read in      >>          05825000
                        << RECBUFF.                         >>          05830000
   ERRORCODE,           << Serial Disc Interface error no.  >>          05835000
                        << 0 = no error or EOF, 1-99 are    >>          05840000
                        << fatal (SDI shuts down).  Nega-   >>          05845000
                        << tive values are non-fatal (in-   >>          05850000
                        << formational) equivalents of the  >>          05855000
                        << corresponding positive values.   >>          05860000
                        << Values > 100 are also non-fatal  >>          05865000
                        << equivalents of (ERRORCODE - 100) >>          05870000
   GPTLEN,              << Maximum length of Gap Table.     >> <<03522>>05875000
   READ0 = RECBUFFEA,   << Single-word equivalents of each  >> <<00494>>05880000
   READ1 = RECBUFFEA+1, << word of RECBUFFEA.               >> <<00494>>05885000
   RECBUFFLEN,          << Length of RECBUFF, less one.     >> <<03522>>05890000
   RITE0 = RECBUFFSA,   << Single-word equivalents of each  >> <<00494>>05895000
   RITE1 = RECBUFFSA+1, << word of RECBUFFSA.               >> <<00494>>05900000
   USERSTACK,           << DST number of user's stack.      >>          05905000
   WORDSINRECBUF,       << Number of words present in REC-  >>          05910000
                        << BUFF after READBLOCK finishes.   >>          05915000
   X = X,                                                               05920000
   S0 = S-0,                                                            05925000
   S1 = S-1,                                                            05930000
   S2 = S-2,                                                            05935000
   S3 = S-3,                                                            05940000
   S4 = S-4,                                                            05945000
   S5 = S-5;                                                            05950000
                                                                        05955000
       <<------------------------->>                                    05960000
       <<END OF TAPE SENSOR STATES>>                                    05965000
       <<------------------------->>                                    05970000
               << SECTR.                                    >> <<03522>>05975000
EQUATE                                                         <<03522>>05980000
  EOTNOTFOUND   = 0,                                           <<03522>>05985000
  EOTFOUND      = 1,                                           <<04249>>05990000
  EOT'WRITTEN   = 2;                                           <<04249>>05995000
$PAGE " *** Buffer management declarations *** "               <<07114>>06000000
<<**********************************************************>> <<07114>>06005000
<<                                                          >> <<07114>>06010000
<<            Buffer management declarations for            >> <<07114>>06015000
<<               double-buffering enhancement               >> <<07114>>06020000
<<                                                          >> <<07114>>06025000
<<**********************************************************>> <<07114>>06030000
                                                               <<07114>>06035000
EQUATE                                                         <<07114>>06040000
   BUFFER'INCREMENT  = 8192,   << Change this as required.  >> <<07114>>06045000
   INFO'ENTRY'SIZE   =    8,                                   <<07114>>06050000
   MAX'NUM'BUFFERS   =    2,   << This too.                 >> <<07114>>06055000
   MIN'BUFFER'LENGTH = 8192;                                   <<07114>>06060000
                                                               <<07114>>06065000
DOUBLE POINTER                                                 <<07114>>06070000
   BUFFER'INFO'D;                                              <<07114>>06075000
                                                               <<07114>>06080000
LOGICAL POINTER                                                <<07114>>06085000
   BUFFER'INFO =       << Holds SDISC data buffer info (I/O >> <<07114>>06090000
      BUFFER'INFO'D;   << status, disc address, DST#, etc.) >> <<07114>>06095000
                       << There are MAX'NUM'BUFFER entries, >> <<07114>>06100000
                       << each of size INFO'ENTRY'SIZE.     >> <<07114>>06105000
INTEGER                                                        <<07114>>06110000
   CURRENT'BUFFER,     <<   Index to SDISC data buffer cur- >> <<07114>>06115000
                       << rently in user.  Varies from 0 to >> <<07114>>06120000
                       << NUM'BUFFERS - 1.                  >> <<07114>>06125000
   BUFFER'COUNT,       <<   Loop control variable.          >> <<07114>>06130000
   NUM'BUFFERS;        <<   # buffers actually in user.     >> <<07114>>06135000
                                                               <<07114>>06140000
DEFINE                                                         <<07114>>06145000
   BUFFER'INFO'SIZE    = MAX'NUM'BUFFERS * INFO'ENTRY'SIZE  #, <<07114>>06150000
   BUMP'CURRENT'BUFFER =                                       <<07114>>06155000
      IF (CURRENT'BUFFER := CURRENT'BUFFER + 1) >= NUM'BUFFERS <<07114>>06160000
         THEN CURRENT'BUFFER := 0                           #, <<07114>>06165000
   DATABUF'ATTIO'GENL'STATUS =                                 <<07114>>06170000
                         BUFFER'INFO(ENTRY'INDEX + 2).(13:3)#, <<07114>>06175000
      NORMAL'COMPLETION= 1                                  #, <<07114>>06180000
   DATABUF'ATTIO'STATUS= BUFFER'INFO(ENTRY'INDEX + 2).(8:8) #, <<07114>>06185000
   DATABUF'ATTIO'TLOG  = BUFFER'INFO(ENTRY'INDEX + 3)       #, <<07114>>06190000
   DATABUF'BITS        = BUFFER'INFO(ENTRY'INDEX + 1)       #, <<07114>>06195000
   DATABUF'DST         = BUFFER'INFO(ENTRY'INDEX + 4)       #, <<07114>>06200000
   DATABUF'FLAGS       = DATABUF'BITS.(13:3)                #, <<07114>>06205000
      DATABUF'AVAILABLE= DATABUF'BITS.(14:2) = 0            #, <<07114>>06210000
      DATABUF'DOING'IO = DATABUF'BITS.(15:1)                #, <<07114>>06215000
      DATABUF'IN'USE   = DATABUF'BITS.(14:1)                #, <<07114>>06220000
      DATABUF'WRITE    = DATABUF'BITS.(13:1)                #, <<07114>>06225000
   DATABUF'IOQX        = BUFFER'INFO(ENTRY'INDEX + 0)       #, <<07114>>06230000
   DATABUF'SA0         = BUFFER'INFO(ENTRY'INDEX + 6)       #, <<07114>>06235000
   DATABUF'SA1         = BUFFER'INFO(ENTRY'INDEX + 7)       #, <<07114>>06240000
   DATABUF'STATUS      = DATABUF'BITS.(0:2)                 #, <<07114>>06245000
      DATABUF'NOT'ALLOC= 0                                  #, <<07114>>06250000
      DATABUF'ALLOCATED= 1                                  #, <<07114>>06255000
      DATABUF'LOCKED   = 2                                  #, <<07114>>06260000
      DATABUF'FROZEN   = 3                                  #, <<07114>>06265000
   DATABUF'WORDS'IN'BUF= BUFFER'INFO(ENTRY'INDEX + 5)       #, <<07114>>06270000
   DATABUFD'ATTIO'RETURN =                                     <<07114>>06275000
                         BUFFER'INFO'D(ENTRY'INDEX/2 + 1)   #, <<07114>>06280000
   DATABUFD'SA         = BUFFER'INFO'D(ENTRY'INDEX/2 + 3)   #, <<07114>>06285000
   ENTRY'INDEX         = CURRENT'BUFFER * INFO'ENTRY'SIZE   #; <<07114>>06290000
$PAGE "SDISC - Global Declarations"                            <<07114>>06295000
<<TIGHT COUPLING>>                                                      06300000
<< These cells are  used  to  return  values  from  GPTMOD, >>          06305000
<< SDISCFINDGAP, and BACKBLOCKREAD.                         >>          06310000
DOUBLE RTV1,                                                            06315000
       STARTBLOCK=RTV1,                                                 06320000
       STARTGAP=RTV1,                                                   06325000
       RTV2,                                                            06330000
       BLOCKLENGTH=RTV2,                                                06335000
       ENDGAP=RTV2;                                                     06340000
INTEGER RTV3,                                                           06345000
        GAPTYPE=RTV3,                                                   06350000
        BOT'SECTOR'COUNT = RTV3,  << Retnd by BACKBLOCKREAD >> <<03522>>06355000
        RTV4,                                                           06360000
        ENDINDEX=RTV4;                                                  06365000
                                                               <<07114>>06370000
LOGICAL                                                        <<07114>>06375000
   CYLINDER = RTV3,                                            <<07114>>06380000
   HEAD     = RTV4,                                            <<07114>>06385000
   STATUS1  = RTV3,                                            <<07114>>06390000
   STATUS2  = RTV4;                                            <<07114>>06395000
<<TIGHT COUPLING>>                                                      06400000
$PAGE                                                          <<03522>>06405000
                                                                        06410000
<<   XMITLOG must be the last declaration in the  DB  area. >> <<03522>>06415000
<< GPTMOD,  function 2, uses XMITLOG's address +1 as a base >> <<03522>>06420000
<< of the "secondary DB" area for all of the arrays in  the >> <<07114>>06425000
<< serial disc XDS for variables.                           >> <<07114>>06430000
                                                               <<03522>>06435000
INTEGER                                                                 06440000
  XMITLOG;   << +words or -chars transmitted to/from user.  >>          06445000
                                                               <<00079>>06450000
<<   These offsets into the Volume Label (VLAB)  sector  of >> <<03522>>06455000
<< the serial disc define locations of various disc config- >> <<03522>>06460000
<< uration parameters which SDISC uses to define the limits >> <<03522>>06465000
<< of the disc (EOTSECTR, EODSECTR),  a  sector  (WORDSPER- >> <<03522>>06470000
<< SECTR), RECBUFF and the Gap Table. The entire label sec- >> <<03522>>06475000
<< tor is read into the WORKTABLE when the device is  first >> <<03522>>06480000
<< allocated.                                               >> <<03522>>06485000
                                                               <<03522>>06490000
EQUATE                                                                  06495000
      VLAB'TYPE'SUBTYPE = 6,   << Hardware type and subtype >> <<03522>>06500000
      VLAB'B'LABEL      = 20,  << Byte offset to "SERDISC"  >> <<M7478>>06505000
      VLAB'SDISC'VERSION = 13,                                 <<07114>>06510000
      VLAB'WPS=14, <<WORDSPERSECTOR INDEX>>                             06515000
      VLAB'SPT=15, <<SECTORSPERTRACK>>                                  06520000
      VLAB'SA=16,  <<LOADPOINT-STARTADDRESS>>                           06525000
      VLAB'EOT=17, <<END OF TAPE SECTOR>>                               06530000
      VLAB'EOD=19; <<EON OF DISC SECTOR>>                               06535000
$PAGE "SDISC - EXTERNAL PROCEDURE DECLARATIONS"                         06540000
INTRINSIC                                                      <<00494>>06545000
     ASCII,                                                    <<00494>>06550000
     DEBUG,                                                    <<03640>>06555000
     FOPEN,                                                    <<00494>>06560000
     FWRITE,                                                   <<00494>>06565000
     FCLOSE;                                                   <<00494>>06570000
                                                               <<04742>>06575000
DOUBLE PROCEDURE P'ATTACHIO (LDNUM, QMISC, DSTX, OFFSET,       <<04828>>06580000
                 FUNCTION, COUNT, P1, P2, FLAGS,               <<04828>>06585000
                 EXTENT'BASE, EXTENT'LENGTH);                  <<04828>>06590000
   VALUE   LDNUM, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1,    <<04828>>06595000
           P2, FLAGS, EXTENT'BASE, EXTENT'LENGTH;              <<04828>>06600000
   INTEGER LDNUM, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1,    <<04828>>06605000
           P2, FLAGS, EXTENT'LENGTH;                           <<04828>>06610000
   DOUBLE EXTENT'BASE;                                         <<04828>>06615000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL, VARIABLE;          <<04828>>06620000
                                                               <<00239>>06625000
DOUBLE PROCEDURE REQSTATUS(LDN);                               <<00239>>06630000
VALUE LDN;                                                     <<00239>>06635000
INTEGER LDN;                                                   <<00239>>06640000
OPTION EXTERNAL;                                               <<00239>>06645000
                                                               <<00189>>06650000
INTEGER PROCEDURE GETSIR(A);                                            06655000
VALUE A;                                                                06660000
INTEGER A;                                                              06665000
OPTION EXTERNAL;                                                        06670000
                                                                        06675000
PROCEDURE RELSIR(A,B);                                                  06680000
VALUE A,B;                                                              06685000
INTEGER A,B;                                                            06690000
OPTION EXTERNAL;                                                        06695000
                                                                        06700000
LOGICAL PROCEDURE EXCHANGEDB(A);                                        06705000
VALUE A;                                                                06710000
LOGICAL A;                                                              06715000
OPTION EXTERNAL;                                                        06720000
                                                                        06725000
LOGICAL PROCEDURE SETSYSDB;                                             06730000
OPTION EXTERNAL;                                                        06735000
                                                                        06740000
PROCEDURE RESETDB(OLDDB);                                               06745000
VALUE OLDDB;                                                            06750000
INTEGER OLDDB;                                                          06755000
OPTION EXTERNAL;                                                        06760000
                                                                        06765000
PROCEDURE WAIT (EVENT, MASK);                                  <<M7478>>06770000
   VALUE   EVENT, MASK;                                        <<M7478>>06775000
   INTEGER EVENT, MASK;                                        <<M7478>>06780000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<M7478>>06785000
$PAGE                                                          <<03522>>06790000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,                  06795000
PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,CONTROL);                       06800000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,                   06805000
  DEST, REPLY, OFFSET, DST, CONTROL;                                    06810000
INTEGER SETNO,MSGNO,DEST,DST;                                           06815000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,                06820000
  CONTROL;                                                              06825000
OPTION VARIABLE,EXTERNAL;                                               06830000
                                                                        06835000
                                                               <<07114>>06840000
PROCEDURE FREEZE (SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM);          <<07114>>06845000
   VALUE   SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>06850000
   INTEGER SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>06855000
COMMENT -- Freezes a segment in main  memory.  TYPE'OF'SEGMENT <<L8989>>06860000
= 1 for a data segment.  If PCB'NUM = 0, FREEZE will  use  the <<L8989>>06865000
current process' PIN.  Segment must have been LOCKSEG'd before <<L8989>>06870000
calling FREEZE.                                                <<L8989>>06875000
;                                                              <<07114>>06880000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>06885000
                                                               <<07114>>06890000
PROCEDURE UNFREEZE (SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM);        <<07114>>06895000
   VALUE   SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>06900000
   INTEGER SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>06905000
COMMENT -- The inverse of FREEZE, above.  Parameters have  the <<07114>>06910000
same meaning.                                                  <<07114>>06915000
;                                                              <<07114>>06920000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>06925000
                                                               <<07114>>06930000
INTEGER PROCEDURE GETDATASEG (INITIAL'LENGTH, MAX'LENGTH);     <<07114>>06935000
   VALUE   INITIAL'LENGTH, MAX'LENGTH;                         <<07114>>06940000
   INTEGER INITIAL'LENGTH, MAX'LENGTH;                         <<07114>>06945000
COMMENT -- Acquires an extra data segment.  The DST entry num- <<07114>>06950000
ber is returned in the result.  INITIAL'LENGTH is rounded  up- <<07114>>06955000
ward  to the next 4-word boundary to satisfy DST requirements. <<07114>>06960000
If MAX'LENGTH < INITIAL'LENGTH it is  set  to  INITIAL'LENGTH. <<07114>>06965000
CAUTION:  If MAX'LENGTH > INITIAL'LENGTH it is NOT rounded up- <<07114>>06970000
ward.  Users who specify a MAX'LENGTH should always make  sure <<07114>>06975000
it is evenly divisible by 4.                                   <<07114>>06980000
;                                                              <<07114>>06985000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>06990000
                                                               <<07114>>06995000
PROCEDURE RELDATASEG (SEG'NUM);                                <<07114>>07000000
   VALUE   SEG'NUM;                                            <<07114>>07005000
   INTEGER SEG'NUM;                                            <<07114>>07010000
COMMENT -- Inverse of GETDATASEG.                              <<07114>>07015000
;                                                              <<07114>>07020000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>07025000
$PAGE                                                          <<07114>>07030000
PROCEDURE LOCKSEG' (OBJECT'ID, MIGRATE);                       <<L8989>>07035000
   VALUE   OBJECT'ID, MIGRATE;                                 <<L8989>>07040000
   DOUBLE  OBJECT'ID;                                          <<L8989>>07045000
   LOGICAL MIGRATE;                                            <<L8989>>07050000
COMMENT -- LOCKSEG' forces OBJECT'ID to remain in main memory. <<L8989>>07055000
The memory manager may relocate OBJECT'ID as it sees  fit  un- <<L8989>>07060000
less  OBJECT'ID  is  subsequently frozen.  If MIGRATE is TRUE, <<L8989>>07065000
LOCKSEG' does not return until OBJECT'ID has been relocated to <<L8989>>07070000
a bank boundary (usually in preparation for a FREEZE call).    <<L8989>>07075000
;                                                              <<07114>>07080000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>07085000
                                                               <<07114>>07090000
PROCEDURE UNLOCKSEG (SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM);       <<07114>>07095000
   VALUE   SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>07100000
   INTEGER SEG'NUM, TYPE'OF'SEGMENT, PCB'NUM;                  <<07114>>07105000
COMMENT -- The logical inverse of  LOCKSEG',  with  parameters <<L8989>>07110000
identical to FREEZE (see above for description).               <<L8989>>07115000
;                                                              <<07114>>07120000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>07125000
                                                               <<07114>>07130000
DOUBLE PROCEDURE WAITFORIO (IOQ'INDEX);                        <<07114>>07135000
   VALUE   IOQ'INDEX;                                          <<07114>>07140000
   INTEGER IOQ'INDEX;                                          <<07114>>07145000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<07114>>07150000
$PAGE "SDISC - FORWARD PROCEDURE DECLARATIONS"                 <<03522>>07155000
PROCEDURE CTRLSDISC;                                           <<00494>>07160000
OPTION PRIVILEGED, UNCALLABLE, FORWARD, INTERNAL;              <<06745>>07165000
                                                                        07170000
DOUBLE PROCEDURE ACTUAL'ADDRESS;                               <<03522>>07175000
OPTION PRIVILEGED, UNCALLABLE, FORWARD, INTERNAL;              <<06745>>07180000
                                                               <<03522>>07185000
PROCEDURE SDISCFINDGAP (STARTSECTOR, ENDSECTOR);               <<03522>>07190000
  VALUE STARTSECTOR, ENDSECTOR;                                <<03522>>07195000
  DOUBLE STARTSECTOR, ENDSECTOR;                               <<03522>>07200000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD, INTERNAL;            <<06745>>07205000
                                                               <<03522>>07210000
PROCEDURE LOCK'CS80'DEVICE;                                    <<03522>>07215000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD, INTERNAL;            <<06745>>07220000
                                                               <<03522>>07225000
PROCEDURE UNLOCK'CS80'DEVICE;                                  <<03522>>07230000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD, INTERNAL;            <<06745>>07235000
                                                               <<M7478>>07240000
DOUBLE PROCEDURE ATACHIO (LDNUM, QMISC, DSTX, ADDR, FUNC,      <<M7478>>07245000
                          CNT, P1, P2, FLAGS);                 <<M7478>>07250000
   VALUE   LDNUM, QMISC, DSTX, ADDR, FUNC, CNT, P1, P2, FLAGS; <<M7478>>07255000
   INTEGER LDNUM, QMISC, DSTX, ADDR, FUNC, CNT, P1, P2, FLAGS; <<M7478>>07260000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL, FORWARD;           <<M7478>>07265000
                                                               <<M7478>>07270000
PROCEDURE READ'DISC'LABEL;                                     <<M7478>>07275000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL, FORWARD;           <<M7478>>07280000
$PAGE   "   *** Procedure WAITFORDISC ***"                     <<M7478>>07285000
LOGICAL PROCEDURE WAITFORDISC;                                 <<M7478>>07290000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<M7478>>07295000
                                                               <<M7478>>07300000
BEGIN                                                          <<M7478>>07305000
  COMMENT -- WAITFORDISC is called whenever we start  process- <<M7478>>07310000
ing  a new volume, that is, when a serial disc is first opened <<M7478>>07315000
or during a "reelswitch" when a later volume  is  mounted.  We <<M7478>>07320000
check  the  Serial  Disc  Loaded bit in the LPDT, which is the <<M7478>>07325000
software simulation for discs  of  a  tape's  on-line/off-line <<M7478>>07330000
condition.  If we are "off-line", we notify the console and go <<M7478>>07335000
to sleep until media has been mounted in  the  device.  PVPROC <<M7478>>07340000
will  wake us at that time.  If the media has been >SERIALized <<M7478>>07345000
by VINIT ("SERDISC" in the label sector), we return  TRUE.  If <<M7478>>07350000
not,  we  notify the console and ask if proper media is avail- <<M7478>>07355000
able.  If so, we go back to sleep and repeat all of the  above <<M7478>>07360000
until  we  have  proper media or the operator responds NO.  If <<M7478>>07365000
the latter happens, we return FALSE.                           <<M7478>>07370000
  This approach clears up two problems we had  with  the  pre- <<M7478>>07375000
vious method:                                                  <<M7478>>07380000
  1.  We used to wake up every  five  seconds  and  check  the <<M7478>>07385000
LPDT.  It  was  fairly  easy to bump into PVPROC using its own <<M7478>>07390000
copy of SDISC to read the "tape" label of the new volume.      <<M7478>>07395000
  2.  If the operator mounted incorrect media,  there  was  no <<M7478>>07400000
way  to recover.  ABORTIO didn't work, because no physical I/O <<M7478>>07405000
was involved.  ABORTJOB didn't work because SDISC  runs  under <<M7478>>07410000
ATTACHIO and the File System, which are critical.              <<M7478>>07415000
  Implementation note:  We must be very careful not to replace <<M7478>>07420000
one non-recoverable situation with another. There are two pro- <<M7478>>07425000
cesses (ours and PVPROC) plus the  operator  all  asynchronous <<M7478>>07430000
with respect to each other.  Our process may request help from <<M7478>>07435000
the operator long before doing the I/O request  that  gets  us <<M7478>>07440000
here.  The operator may or may not mount new media in that in- <<M7478>>07445000
terval.  Media latency (disc spinup, cartridge  rewind,  etc.) <<M7478>>07450000
may  cause PVPROC to run at unknown times.  The MPE Kernel im- <<M7478>>07455000
poses the further burden that waking a  process  for  a  given <<M7478>>07460000
event erases all evidence of another event.  The two events in <<M7478>>07465000
this case are a Junkwait (which we set when we call WAIT)  and <<M7478>>07470000
a RIT (UCOP) wait when we ask the operator to respond.         <<M7478>>07475000
  What does all of this mean?  It means that we must  co-ordi- <<M7478>>07480000
nate  our  activities  very carefully with PVPROC.  Here's our <<M7478>>07485000
side of the bargain:                                           <<M7478>>07490000
1.  Clear the Serial Disc Loaded (SDLF) bit in the LPDT  when- <<M7478>>07495000
ever we Unload the device, or whenever we must WAIT on PVPROC. <<M7478>>07500000
2.  PDISABLE before testing the SDLF bit so that we can't lose <<M7478>>07505000
the CPU and have PVPROC twiddle it after we test it. WAIT will <<M7478>>07510000
PENABLE.                                                       <<M7478>>07515000
3.  When we WAIT in here, put our process' PCB index into Word <<M7478>>07520000
3 (the fourth word) of our LDTX entry, so  that  PVPROC  knows <<M7478>>07525000
whom  to wake.  Set the same word to 0 after being awakened as <<M7478>>07530000
a signal to PVPROC not to  waken  anyone.  This  will  prevent <<M7478>>07535000
problems associated with drives going off and on line at other <<M7478>>07540000
times (such as power failures).                                <<M7478>>07545000
4.  PDISABLE and test the SDLF bit when returning from an  op- <<M7478>>07550000
erator reply (RIT) wait. If it's set, then the operator mount- <<M7478>>07555000
ed media and it came on-line before the operator REPLYed.      <<M7478>>07560000
  PVPROC has to co-operate by working as follows:              <<M7478>>07565000
1.  When processing a serial disc on-line interrupt, it  likes <<M7478>>07570000
to  use  serial  disc code to read the "tape" label.  This re- <<M7478>>07575000
quires it to use the device's LDTX entry, which currently  be- <<M7478>>07580000
longs  to the copy of SDISC running on behalf of the user pro- <<M7478>>07585000
cess.  To avoid conflict, it must save the LDTX entry, acquire <<M7478>>07590000
a new extra data segment for its copy of SDISC to use, and put <<M7478>>07595000
together an LDTX entry for its purposes.  When it has finished <<M7478>>07600000
it puts the original entry back.                               <<M7478>>07605000
2.  If word 3 of the original entry is  non-0,  PVPROC  should <<M7478>>07610000
wake  the  associated  PCB index from a junkwait AFTER setting <<M7478>>07615000
the SDLF bit.                                                  <<M7478>>07620000
;                                                              <<M7478>>07625000
INTEGER                                                        <<M7478>>07630000
   LDTX'INDEX,    << Required by INCLLDT5.                  >> <<M7478>>07635000
   LPDT'INDEX,    << Required by INCLLPDT.                  >> <<M7478>>07640000
   PCBPT,         << Required by INCLPCB5.                  >> <<M7478>>07645000
   SAVE'LDT'SIR;                                               <<M7478>>07650000
                                                               <<M7478>>07655000
LOGICAL                                                        <<M7478>>07660000
   QDSTN,         << Local copy of our SDISC GPT XDS number >> <<M7478>>07665000
   QLDNUM,        << Local copy of the serial disc LDEV.    >> <<M7478>>07670000
   QREPLY,        << Gets response to "Another Volume?"     >> <<M7478>>07675000
   QXDS;          << SDISC XDS currently in the LDTX.       >> <<M7478>>07680000
                                                               <<M7478>>07685000
LOGICAL POINTER                                                <<M7478>>07690000
   LDT := 0,      << Base of LDT in split-stack.            >> <<M7478>>07695000
   LDTX,          << Base of LDTX in split-stack.           >> <<M7478>>07700000
   PCB = SYSPCBINDEX;   << Required by INCLPCB5.            >> <<M7478>>07705000
                                                               <<M7478>>07710000
WAITFORDISC := FALSE;                                          <<M7478>>07715000
QDSTN := DSTN;                                                 <<M7478>>07720000
QLDNUM := LDNUM;                                               <<M7478>>07725000
PCBPT := CURPRC;                    << Required by INCLPCB5 >> <<M7478>>07730000
LDTX'INDEX := LDNUM * SIZE'OF'LDTX'ENTRY;                      <<M7478>>07735000
LPDT'INDEX := LDNUM * INTEGER (LPDT'ENTRY'SIZE);               <<M7478>>07740000
DO BEGIN   << Loop until "SERDISC" or operator gives up.    >> <<M7478>>07745000
   EXCHANGEDB (LDT'DST);                                       <<M7478>>07750000
   @LDTX := LDTX'BASE;                                         <<M7478>>07755000
   DO BEGIN   << Loop until no conflict with PVPROC.        >> <<M7478>>07760000
      PDISABLE;                                                <<M7478>>07765000
      IF LPDT'RDY'SER'FRN'DISC THEN                            <<M7478>>07770000
         QXDS := QDSTN   << On line, assume no conflict.    >> <<M7478>>07775000
      ELSE                                                     <<M7478>>07780000
         BEGIN   << Off line, see if PVPROC was running.    >> <<M7478>>07785000
         QXDS := LDTX'SDISC'GPT'XDS;                           <<M7478>>07790000
         IF QXDS <> QDSTN THEN PENABLE;   << Go round again >> <<M7478>>07795000
         END;    << Off line, see if PVPROC was running.    >> <<M7478>>07800000
      END     << Loop until no conflict with PVPROC.        >> <<M7478>>07805000
     UNTIL QXDS = QDSTN;                                       <<M7478>>07810000
                                                               <<M7478>>07815000
<< Note:  When we're here, we're still PDISABLEd.  If we're >> <<M7478>>07820000
<< on-line, PENABLE and check for a proper label ("SERDISC" >> <<M7478>>07825000
<< in  the volume label).  If off-line, notify the operator >> <<M7478>>07830000
<< and WAIT for a new volume.                               >> <<M7478>>07835000
                                                               <<M7478>>07840000
   IF LPDT'RDY'SER'FRN'DISC THEN                               <<M7478>>07845000
      PENABLE                                                  <<M7478>>07850000
   ELSE                                                        <<M7478>>07855000
      BEGIN   << Still off-line, DB still at the LDT here.  >> <<M7478>>07860000
      PENABLE;                                                 <<M7478>>07865000
      SAVE'LDT'SIR := GETSIR (LDT'SIR);                        <<M7478>>07870000
      LDTX'SDISC'PCB'NUM := PCBPT;                             <<M7478>>07875000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<M7478>>07880000
      EXCHANGEDB (STACK);                                      <<M7478>>07885000
      GENMSG (SET1, MESS11, %10000, QLDNUM, , , , , CONSOLE);  <<M7478>>07890000
      WAIT (-JUNKWAIT, 0);                                     <<M7478>>07895000
      EXCHANGEDB (LDT'DST);                                    <<M7478>>07900000
      SAVE'LDT'SIR := GETSIR (LDT'SIR);                        <<M7478>>07905000
      LDTX'SDISC'PCB'NUM := 0;   << Restrict PVPROC wakeups >> <<M7478>>07910000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<M7478>>07915000
      END;    << Still off-line, DB still at the LDT here.  >> <<M7478>>07920000
   EXCHANGEDB (QDSTN);                                         <<M7478>>07925000
                                                               <<M7478>>07930000
<< On-line with a new volume.  Check that it's "SERDISC".   >> <<M7478>>07935000
                                                               <<M7478>>07940000
   @WORKTABLE := @XMITLOG + 1;   << Read volume label.      >> <<M7478>>07945000
   @WORKTABLE'B := @WORKTABLE & LSL(1);                        <<M7478>>07950000
   READ'DISC'LABEL;                                            <<M7478>>07955000
   IF SDERR THEN RETURN;                                       <<M7478>>07960000
   IF WORKTABLE'B(VLAB'B'LABEL) = "SERDISC" THEN               <<M7478>>07965000
      BEGIN                                                    <<M7478>>07970000
      WAITFORDISC := TRUE;                                     <<M7478>>07975000
      RETURN;   << *-*-* This is normal return.       *-*-* >> <<M7478>>07980000
      END;                                                     <<M7478>>07985000
   DISABLE;   << Here we go again.                          >> <<M7478>>07990000
   LPDT'RDY'SER'FRN'DISC := FALSE;                             <<M7478>>07995000
   ENABLE;                                                     <<M7478>>08000000
   EXCHANGEDB (STACK);                                         <<M7478>>08005000
   GENMSG (SET1, MESS273, %10000, QLDNUM, , , , , CONSOLE);    <<M7478>>08010000
   GENMSG (SET1, MESS10,  %10000, QLDNUM, , , , , CONSOLE,     <<M7478>>08015000
           REPLY'YESNO, QREPLY);                               <<M7478>>08020000
   END     << Loop until "SERDISC" or operator gives up.    >> <<M7478>>08025000
  UNTIL NOT QREPLY;                                            <<M7478>>08030000
EXCHANGEDB (QDSTN);   << Leave like we entered.             >> <<M7478>>08035000
END;    << of WAITFORDISC, error return here.               >> <<M7478>>08040000
$PAGE "SDISC - TABLE MANIPULATION ROUTINES"                             08045000
LOGICAL PROCEDURE ADD'GPT'ENTRY (GPT'TYPE, ADDR1, ADDR2);      <<03522>>08050000
  VALUE GPT'TYPE, ADDR1, ADDR2;                                <<03522>>08055000
  INTEGER GPT'TYPE, ADDR1, ADDR2;                              <<03522>>08060000
  OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                     <<06745>>08065000
                                                               <<03522>>08070000
BEGIN                                                          <<03522>>08075000
  COMMENT -- ADD'GPT'ENTRY adds the entry  information  passed <<03522>>08080000
in  the parameters to the Gap Table at CURRENTGPTENT, then up- <<03522>>08085000
dates CURRENTGPTENT.  If the entry fits in the Gap Table, ADD' <<03522>>08090000
GPT'ENTRY returns TRUE, if not it returns  FALSE  to  let  the <<03522>>08095000
caller choose the appropriate SDERR status.                    <<03522>>08100000
  This routine does not check how  close  a  valid  GPT  entry <<03522>>08105000
comes  to the end of the Gap Table.  Functional processors are <<03522>>08110000
responsible for calling CHECK'FOR'EOT at the end of their pro- <<03522>>08115000
cessing.                                                       <<03522>>08120000
;                                                              <<03522>>08125000
ADD'GPT'ENTRY := TRUE;   << I'm an incurable optimist.      >> <<03522>>08130000
IF CURRENTGPTENT < GPTLEN                                      <<03522>>08135000
   THEN                                                        <<03522>>08140000
      BEGIN   << Entry fits in Gap Table.                   >> <<03522>>08145000
      GPT (CURRENTGPTENT).GPT'TYPE'FIELD := GPT'TYPE;          <<03522>>08150000
      GPT (X).GPT'ADR'FIELD := ADDR1;                          <<03522>>08155000
      GPT (X := X+1) := ADDR2;                                 <<03522>>08160000
      CURRENTGPTENT := X + 1;                                  <<03522>>08165000
      END     << Entry fits in Gap Table.                   >> <<03522>>08170000
   ELSE ADD'GPT'ENTRY := FALSE;   << Entry doesn't fit.     >> <<03522>>08175000
END;   << of ADD'GPT'ENTRY.                                 >> <<03522>>08180000
$PAGE                                                          <<03522>>08185000
DOUBLE PROCEDURE ATACHIO(LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);   08190000
VALUE LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;              <<00189>>08195000
INTEGER LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;            <<00189>>08200000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>08205000
                                                               <<00189>>08210000
BEGIN                                                          <<00189>>08215000
  COMMENT -- A common shell for the real P'ATTACHIO call.      <<04742>>08220000
;                                                              <<03680>>08225000
ATACHIO := P'ATTACHIO (LDNUM, QMISC, DSTX, ADDR, FUNC, CNT,    <<04742>>08230000
                       P1, P2, FLAGS);                         <<04742>>08235000
END;                                                           <<00189>>08240000
$PAGE " *** Procedure GETRECBUFF *** "                         <<07114>>08245000
  COMMENT -- Procedures GETRECBUFF and PUTRECBUFF are  utility <<07114>>08250000
procedures which get or put one word at the specified location <<07114>>08255000
in the current data buffer segment.  They are designed to  re- <<07114>>08260000
place the single word references to RECBUFF in pre-double buf- <<07114>>08265000
fered versions of SDISC with minimal changes to  those  refer- <<07114>>08270000
ences.  NOTE:  These procedures do NOT handle block moves such <<07114>>08275000
as those necessary to fill out a sector with a specific  char- <<07114>>08280000
acter.  Such moves are implemented elsewhere.                  <<07114>>08285000
;                                                              <<07114>>08290000
                                                               <<07114>>08295000
LOGICAL PROCEDURE GETRECBUFF (OFFSET);                         <<07114>>08300000
   VALUE OFFSET;  INTEGER OFFSET;                              <<07114>>08305000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>08310000
                                                               <<07114>>08315000
BEGIN                                                          <<07114>>08320000
                                                               <<07114>>08325000
INTEGER                                                        <<07114>>08330000
   DB'RETURN = RTV3;   << Can't LRA Q-rel in split-stack.   >> <<07114>>08335000
                                                               <<07114>>08340000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<07114>>08345000
                                                               <<07114>>08350000
MOVEFROMDSEG (@DB'RETURN, DATABUF'DST, OFFSET, 1);             <<07114>>08355000
GETRECBUFF := DB'RETURN;                                       <<07114>>08360000
END;                                                           <<07114>>08365000
                                                               <<07114>>08370000
                                                               <<07114>>08375000
$PAGE " *** Procedure PUTRECBUFF *** "                         <<07114>>08380000
PROCEDURE PUTRECBUFF (OFFSET, CONTENTS);                       <<07114>>08385000
   VALUE OFFSET, CONTENTS;  INTEGER OFFSET, CONTENTS;          <<07114>>08390000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>08395000
                                                               <<07114>>08400000
BEGIN                                                          <<07114>>08405000
                                                               <<07114>>08410000
INTEGER                                                        <<07114>>08415000
   DB'SAVE = RTV4;   << Can't LRA Q-rel in split-stack.     >> <<07114>>08420000
                                                               <<07114>>08425000
SUBROUTINE DEF'MOVETODSEG;                                     <<07114>>08430000
                                                               <<07114>>08435000
DB'SAVE := CONTENTS;                                           <<07114>>08440000
MOVETODSEG (DATABUF'DST, OFFSET, @DB'SAVE, 1);                 <<07114>>08445000
END;                                                           <<07114>>08450000
$PAGE " *** Procedure CLEAR'ALL'BUFFERS *** "                  <<07114>>08455000
PROCEDURE CLEAR'ALL'BUFFERS;                                   <<07114>>08460000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>08465000
                                                               <<07114>>08470000
BEGIN COMMENT --                                               <<07114>>08475000
  CLEAR'ALL'BUFFERS resolves all I/O against SDISC buffers. It <<07114>>08480000
waits on all outstanding I/O's and  flushes  any  dirty  write <<07114>>08485000
buffers (with wait).  (We would abort read I/O's to save time, <<07114>>08490000
but disc I/O's cannot be  aborted).  All  buffer  status  bits <<07114>>08495000
(write,  in  use,  I/O in progress) are cleared.  The earliest <<07114>>08500000
write I/O error, if any, is reported via the  ATTACHIO  status <<07114>>08505000
area  of  BUFFER'INFO (CURRENT'BUFFER is left at the offending <<07114>>08510000
block) as well as by setting SDERR 29.                         <<07114>>08515000
                                                               <<07114>>08520000
  Inputs:   None.                                              <<07114>>08525000
                                                               <<07114>>08530000
  Returns:  No direct returns, but SDERR should be checked.    <<07114>>08535000
            Condition code is not affected.                    <<07114>>08540000
                                                               <<07114>>08545000
  Special considerations:  DB must be at SDISC's global varia- <<07114>>08550000
                           ble XDS, same at return.            <<07114>>08555000
                                                               <<07114>>08560000
Called by:  DEALLOCATE'BUFFERS, READ'BUFFER.                   <<07114>>08565000
                                                               <<07114>>08570000
Calls:      ATACHIO, WAITFORIO.                                <<07114>>08575000
;                                                              <<07114>>08580000
LOGICAL                                                        <<07114>>08585000
   ANY'ERROR := FALSE;                                         <<07114>>08590000
                                                               <<07114>>08595000
BUFFER'COUNT := 0;                                             <<07114>>08600000
DO BEGIN                                                       <<07114>>08605000
   BUMP'CURRENT'BUFFER;                                        <<07114>>08610000
   DATABUFD'ATTIO'RETURN := NO'ATIOERROR;   << Assume O.K.  >> <<07114>>08615000
   IF DATABUF'DOING'IO THEN                                    <<07114>>08620000
      BEGIN   << Allow I/O's in progress to finish.         >> <<07114>>08625000
      DATABUFD'ATTIO'RETURN := WAITFORIO (DATABUF'IOQX);       <<07114>>08630000
      IF DATABUF'WRITE THEN IF DATABUF'ATTIO'GENL'STATUS <>    <<07114>>08635000
         NORMAL'COMPLETION THEN ANY'ERROR := TRUE;             <<07114>>08640000
      END     << Allow I/O's in progress to finish.         >> <<07114>>08645000
   ELSE   << No I/O in progress on current buffer.          >> <<07114>>08650000
      IF DATABUF'WRITE THEN                                    <<07114>>08655000
         BEGIN   << Flush dirty write buffer.               >> <<07114>>08660000
         DATABUFD'ATTIO'RETURN := ATACHIO (LDNUM, QMISC',      <<07114>>08665000
            DATABUF'DST, 0 <<base of segment>>, WRITE,         <<07114>>08670000
            WORDSINRECBUF, DATABUF'SA0, DATABUF'SA1, BLOCKED); <<07114>>08675000
         IF DATABUF'ATTIO'GENL'STATUS <> NORMAL'COMPLETION     <<07114>>08680000
            THEN ANY'ERROR := TRUE;                            <<07114>>08685000
         END;    << Flush dirty write buffer.               >> <<07114>>08690000
   DATABUF'FLAGS := DATABUF'WORDS'IN'BUF := DATABUF'IOQX := 0; <<07114>>08695000
   DATABUFD'SA := 0D;                                                   08700000
   END                                                         <<07114>>08705000
  UNTIL (BUFFER'COUNT := BUFFER'COUNT + 1) >= NUM'BUFFERS;     <<07114>>08710000
                                                               <<07114>>08715000
<< All I/O done, now check for any I/O error.               >> <<07114>>08720000
                                                               <<07114>>08725000
IF ANY'ERROR THEN                                              <<07114>>08730000
   BEGIN   << Go around again until we find earliest one.   >> <<07114>>08735000
   BUFFER'COUNT := 0;                                          <<07114>>08740000
   DO BEGIN                                                    <<07114>>08745000
      BUMP'CURRENT'BUFFER;                                     <<07114>>08750000
      IF DATABUF'ATTIO'GENL'STATUS <> NORMAL'COMPLETION THEN   <<07114>>08755000
         BEGIN   << Found the bad egg.                      >> <<07114>>08760000
         ERRORCODE := SDERR29;                                 <<07114>>08765000
         BUFFER'COUNT := NUM'BUFFERS;   << Stop loop.       >> <<07114>>08770000
         END;                                                  <<07114>>08775000
      END                                                      <<07114>>08780000
     UNTIL (BUFFER'COUNT := BUFFER'COUNT + 1) >= NUM'BUFFERS;  <<07114>>08785000
   END;                                                        <<07114>>08790000
END;   << of CLEAR'ALL'BUFFERS                              >> <<07114>>08795000
$PAGE " *** Procedure RELEASE'BUFFERS *** "                    <<07114>>08800000
PROCEDURE RELEASE'BUFFERS;                                     <<07114>>08805000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>08810000
                                                               <<07114>>08815000
BEGIN COMMENT --                                               <<07114>>08820000
  RELEASE'BUFFERS returns any extra data segment  buffers  ob- <<07114>>08825000
tained  by  ALLOCATE'BUFFERS, either because of an error there <<07114>>08830000
or because the device is  being  closed.  Note:  Buffers  must <<07114>>08835000
first be unfrozen, then unlocked and finally released.         <<07114>>08840000
                                                               <<07114>>08845000
  Inputs:   None.                                              <<07114>>08850000
                                                               <<07114>>08855000
  Returns:  None.                                              <<07114>>08860000
                                                               <<07114>>08865000
  Errors:   None.                                              <<07114>>08870000
                                                               <<07114>>08875000
  Special considerations:  DB must be at SDISC's global varia- <<07114>>08880000
                           ble XDS, same at return.            <<07114>>08885000
                                                               <<07114>>08890000
  Called by:  ALLOCATE'BUFFERS, SDISCIO.                       <<07114>>08895000
                                                               <<07114>>08900000
  Calls:      RELDATASEG, UNFREEZE, UNLOCKSEG.                 <<07114>>08905000
;                                                              <<07114>>08910000
EQUATE                                                         <<07114>>08915000
   DATA'SEG     = 1,   << Segment is a data segment.        >> <<07114>>08920000
   IT'FINDS'PCB = 0;   << UNLOCK, UNFREEZE find the PCB.    >> <<07114>>08925000
                                                               <<07114>>08930000
BUFFER'COUNT := 0;                                             <<07114>>08935000
DO BEGIN                                                       <<07114>>08940000
   IF DATABUF'STATUS = DATABUF'FROZEN THEN                     <<07114>>08945000
      BEGIN                                                    <<07114>>08950000
      UNFREEZE (DATABUF'DST, DATA'SEG, IT'FINDS'PCB);          <<07114>>08955000
      DATABUF'STATUS := DATABUF'LOCKED;                        <<07114>>08960000
      END;                                                     <<07114>>08965000
                                                               <<07114>>08970000
   IF DATABUF'STATUS = DATABUF'LOCKED THEN                     <<07114>>08975000
      BEGIN                                                    <<07114>>08980000
      UNLOCKSEG (DATABUF'DST, DATA'SEG, IT'FINDS'PCB);         <<07114>>08985000
      DATABUF'STATUS := DATABUF'ALLOCATED;                     <<07114>>08990000
      END;                                                     <<07114>>08995000
                                                               <<07114>>09000000
   IF DATABUF'STATUS = DATABUF'ALLOCATED THEN                  <<07114>>09005000
      BEGIN                                                    <<07114>>09010000
      RELDATASEG (DATABUF'DST);                                <<07114>>09015000
      DATABUF'STATUS := DATABUF'NOT'ALLOC;                     <<07114>>09020000
      END;                                                     <<07114>>09025000
   BUMP'CURRENT'BUFFER;                                        <<07114>>09030000
   END                                                         <<07114>>09035000
  UNTIL (BUFFER'COUNT := BUFFER'COUNT + 1) >= NUM'BUFFERS;     <<07114>>09040000
END;   << of RELEASE'BUFFERS.                               >> <<07114>>09045000
$PAGE " *** Procedure BUFFERS'ALLOCATED *** "                  <<07114>>09050000
LOGICAL PROCEDURE BUFFERS'ALLOCATED;                           <<07114>>09055000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>09060000
                                                               <<07114>>09065000
BEGIN COMMENT --                                               <<07114>>09070000
  BUFFERS'ALLOCATED tests the LDTX entry for the device to see <<07114>>09075000
if data buffers have been acquired.                            <<07114>>09080000
                                                               <<07114>>09085000
  Inputs:   None.                                              <<07114>>09090000
                                                               <<07114>>09095000
  Returns:  TRUE if data buffers have already been allocated.  <<07114>>09100000
            FALSE if not -OR- the LDTX entry is not for a ser- <<07114>>09105000
              ial or foreign disc.  SDERR should be checked.   <<07114>>09110000
                                                               <<07114>>09115000
  Special considerations:  DB must be at SDISC's global varia- <<07114>>09120000
                           ble XDS, same at return.            <<07114>>09125000
                                                               <<07114>>09130000
  Called by:  GPTMOD.                                          <<07114>>09135000
                                                               <<07114>>09140000
  Calls:      None.                                            <<07114>>09145000
;                                                              <<07114>>09150000
INTEGER                                                        <<07114>>09155000
   LDTX'INDEX := 0;                                            <<07114>>09160000
                                                               <<07114>>09165000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<07114>>09170000
                                                               <<07114>>09175000
BUFFERS'ALLOCATED := FALSE;                                    <<07114>>09180000
MOVEFROMDSEG (@LDT, LDT'DST, 0, SIZE'OF'LDT'ENTRY);            <<07114>>09185000
MOVEFROMDSEG (@LDTX, LDT'DST, LDTX'BASE +                      <<07114>>09190000
              LDNUM*SIZE'OF'LDTX'ENTRY, SIZE'OF'LDTX'ENTRY);   <<07114>>09195000
IF LDTX'SERIAL'OR'FOREIGN THEN                                 <<07114>>09200000
   IF LDTX'SDISC'DBUFS'ALLOC THEN                              <<07114>>09205000
      BUFFERS'ALLOCATED := TRUE                                <<07114>>09210000
   ELSE                            << Already FALSE.        >> <<07114>>09215000
ELSE ERRORCODE := SDERR26;         << Not a serial disc.    >> <<07114>>09220000
END;       << of BUFFERS'ALLOCATED.                         >> <<07114>>09225000
$PAGE "SDISC -- Procedure ALLOCATE'BUFFERS"                    <<07114>>09230000
PROCEDURE ALLOCATE'BUFFERS;                                    <<07114>>09235000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>09240000
                                                               <<07114>>09245000
BEGIN COMMENT --                                               <<07114>>09250000
  ALLOCATE'BUFFERS acquires data segments from MPE to be  used <<07114>>09255000
as  data buffers.  Once acquired, the segments are locked (may <<07114>>09260000
not be swapped out) and frozen (forced to stay in the same lo- <<07114>>09265000
cation in main memory).  MPE can force a segment lock  request <<L8989>>09270000
to wait until space is available  at  a  bank  boundary.  This <<L8989>>09275000
tends  to  minimize  bank fragmenting (but see additional com- <<L8989>>09280000
ments at the LOCKSEG' call).                                   <<L8989>>09285000
  This approach has two advantages:                            <<07114>>09290000
1.  We're sure to get all the memory we need before we do  any <<07114>>09295000
    work.  This avoids unpleasant surprises later.             <<07114>>09300000
2.  Performance is improved because there are never  any  seg- <<07114>>09305000
    ment faults. (Other users who can't run because they can't <<07114>>09310000
    get main memory may have other opinions on  the  subject). <<07114>>09315000
    In particular, if the disc with our virtual memory were on <<07114>>09320000
    the same GIC as the MPE file disc or the serial  disc,  we <<07114>>09325000
    could  run  very  slowly indeed.  Even now, we require the <<07114>>09330000
    latter two to be on separate GIC's.                        <<07114>>09335000
  We assume any errors that occur while we are doing all  this <<07114>>09340000
are  caused  by  lack of available main memory (which may well <<07114>>09345000
happen with small systems).  We then release all acquired buf- <<07114>>09350000
fers, lower our size requirements and try again.  If the  size <<07114>>09355000
reaches an arbitrary floor (currently 8K words), we reduce the <<07114>>09360000
number of buffers and start over at the maximum  buffer  size. <<07114>>09365000
If we can't fly with one 8K buffer, we give up with an error.  <<07114>>09370000
  This buffering enhancement is designed around the Integrated <<07114>>09375000
Cartridge Tape (ICT), which works better with larger  buffers. <<07114>>09380000
(Other  serial  disc  devices aren't hurt by them either).  So <<07114>>09385000
each buffer starts out with the largest number of integral ICT <<07114>>09390000
blocks (or disc sectors) which fit  in  the  largest  possible <<07114>>09395000
data segment.  Current values are:                             <<07114>>09400000
                                                               <<07114>>09405000
    Largest possible           32760 words (MPE needs the      <<07114>>09410000
      data segment               other 8)                      <<07114>>09415000
      (MPE limit)                                              <<07114>>09420000
                                                               <<07114>>09425000
    Largest possible           32760 - (32760 MOD 512) words   <<07114>>09430000
      ICT buffer             = 32760 - 504 = 32256 words       <<07114>>09435000
                                                               <<07114>>09440000
    Largest possible           32760 - (32760 MOD 128) words   <<07114>>09445000
      disc buffer            = 32760 - 120 = 32640 words       <<07114>>09450000
                                                               <<07114>>09455000
    Buffer increment           8192 words (but first reduction <<07114>>09460000
      (amount by which we      is smaller, to get us to an 8K  <<07114>>09465000
      reduce size if space     boundary).                      <<07114>>09470000
      is not available)                                        <<07114>>09475000
                                                               <<07114>>09480000
    Minimum buffer size        8192 words                      <<07114>>09485000
      (below which number                                      <<07114>>09490000
      of buffers is cut by 1)                                  <<07114>>09495000
                                                               <<07114>>09500000
                                                               <<07114>>09505000
  Inputs:   None.                                              <<07114>>09510000
                                                               <<07114>>09515000
  Returns:  Buffers are allocated and all size parameters have <<07114>>09520000
            been set -OR- an error has occurred (check SDERR). <<07114>>09525000
                                                               <<07114>>09530000
  Special considerations:  DB must be as SDISC's global varia- <<07114>>09535000
                           ble XDS, same at return.            <<07114>>09540000
                                                               <<07114>>09545000
  SIR's locked:  LDT'SIR.                                      <<07114>>09550000
                                                               <<07114>>09555000
  Called by:  GPTMOD.                                          <<07114>>09560000
                                                               <<07114>>09565000
  Calls:      FREEZE, GETDATASEG, LOCKSEG', RELEASE'BUFFERS.   <<L8989>>09570000
;                                                              <<07114>>09575000
EQUATE                                                         <<07114>>09580000
   DATA'SEG           =     1,   << Segment is a data seg.  >> <<07114>>09585000
   IT'FINDS'PCB       =     0,   << LOCK, FREEZE find PCB.  >> <<07114>>09590000
   MAX'DATASEG'LENGTH = 32760,                                 <<L8989>>09595000
   SIXTEEN'K          = 16384;                                 <<L8989>>09600000
                                                               <<07114>>09605000
INTEGER                                                        <<07114>>09610000
   LDTX'INDEX := 0,                                            <<07114>>09615000
   MAX'BUFFER'LENGTH,                                          <<07114>>09620000
   SAVE'LDT'SIR;                                               <<07114>>09625000
                                                               <<07114>>09630000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<07114>>09635000
                                                               <<07114>>09640000
SUBROUTINE DEF'MOVETODSEG;                                     <<07114>>09645000
                                                               <<07114>>09650000
FOR CURRENT'BUFFER := 0 UNTIL MAX'NUM'BUFFERS - 1 DO           <<07114>>09655000
    DATABUF'STATUS := DATABUF'NOT'ALLOC;                       <<07114>>09660000
MAX'BUFFER'LENGTH := MAX'DATASEG'LENGTH -                      <<07114>>09665000
                     MAX'DATASEG'LENGTH MOD WORDSPERSECTR;     <<07114>>09670000
IF SYSNUMBANKS <= 3 THEN MAX'BUFFER'LENGTH := SIXTEEN'K;       <<L8989>>09675000
NUM'BUFFERS := MAX'NUM'BUFFERS;                                <<07114>>09680000
DO BEGIN      << Try to get NUM'BUFFERS data segments.      >> <<07114>>09685000
   RECBUFFLEN := MAX'BUFFER'LENGTH;                            <<07114>>09690000
   DO BEGIN   << Each data segment is RECBUFFLEN long.      >> <<07114>>09695000
      CURRENT'BUFFER := 0;                                     <<07114>>09700000
      DO BEGIN   << Acquire, lock and freeze one data seg.  >> <<07114>>09705000
         DATABUF'DST := GETDATASEG (RECBUFFLEN, 0);            <<07114>>09710000
         IF < OR DATABUF'DST = 0 THEN GO TO ERROR;             <<07114>>09715000
         DATABUF'STATUS := DATABUF'ALLOCATED;                  <<07114>>09720000
                                                               <<L8989>>09725000
COMMENT --                                                     <<L8989>>09730000
  The outermost kernel procedure for locking a segment in mem- <<L8989>>09735000
ory is LOCKSEG (DATABUF'DST, DATA'SEG, IT'FINDS'PCB). Starting <<L8989>>09740000
with MPEV/P (disc caching), LOCKSEG  no  longer  migrates  the <<L8989>>09745000
segment  to  a bank boundary because it calls a more primitive <<L8989>>09750000
procedure LOCKSEG' (OBJ, FALSE).  To  be  migrated,  the  call <<L8989>>09755000
LOCKSEG' (OBJ, TRUE) must be used, so we'll do that here.  For <<L8989>>09760000
data segments only, the mapping OBJ := DOUBLE (DATABUF'DST) is <<L8989>>09765000
valid.  (Don't do this with code or cache segments).           <<L8989>>09770000
  Note:  If this area of the kernel is changed, we may have to <<L8989>>09775000
revise this code also.                                         <<L8989>>09780000
;                                                              <<L8989>>09785000
         LOCKSEG' (DOUBLE (DATABUF'DST), TRUE);                <<L8989>>09790000
         IF < THEN GO TO ERROR;                                <<L8989>>09795000
         DATABUF'STATUS := DATABUF'LOCKED;                     <<07114>>09800000
                                                               <<07114>>09805000
         FREEZE (DATABUF'DST, DATA'SEG, IT'FINDS'PCB);         <<07114>>09810000
         IF < THEN GO TO ERROR;                                <<07114>>09815000
         DATABUF'STATUS := DATABUF'FROZEN;                     <<07114>>09820000
                                                               <<07114>>09825000
         END                                                   <<07114>>09830000
        UNTIL (CURRENT'BUFFER := CURRENT'BUFFER + 1) >=        <<07114>>09835000
               NUM'BUFFERS;                                    <<07114>>09840000
      CURRENT'BUFFER := 0;   << Can't leave > NUM'BUFFERS-1 >> <<07114>>09845000
                                                               <<07114>>09850000
<< We have all the buffers, so note this in the LDTX so  we >> <<07114>>09855000
<< don't come here again.                                   >> <<07114>>09860000
                                                               <<07114>>09865000
      SAVE'LDT'SIR := GETSIR (LDT'SIR);                        <<07114>>09870000
      MOVEFROMDSEG (@LDT, LDT'DST, 0 << base of segment >>,    <<07114>>09875000
                    SIZE'OF'LDT'ENTRY);  << To get to LDTX. >> <<07114>>09880000
      MOVEFROMDSEG (@LDTX, LDT'DST, LDTX'BASE +                <<07114>>09885000
          LDNUM*SIZE'OF'LDTX'ENTRY, SIZE'OF'LDTX'ENTRY);       <<07114>>09890000
      IF NOT LDTX'SERIAL'OR'FOREIGN THEN                       <<07114>>09895000
         BEGIN   << Not an SDISC entry, something's wrong.  >> <<07114>>09900000
         RELSIR (LDT'SIR, SAVE'LDT'SIR);                       <<07114>>09905000
         RELEASE'BUFFERS;   << Give 'em back.               >> <<07114>>09910000
         ERRORCODE := SDERR26;                                 <<07114>>09915000
         RETURN;                                               <<07114>>09920000
         END;                                                  <<07114>>09925000
      LDTX'SDISC'DBUFS'ALLOC := TRUE;                          <<07114>>09930000
      MOVETODSEG (LDT'DST, LDTX'BASE +                         <<07114>>09935000
         LDNUM*SIZE'OF'LDTX'ENTRY, @LDTX, SIZE'OF'LDTX'ENTRY); <<07114>>09940000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<07114>>09945000
      RECBUFFLEN := RECBUFFLEN - 1;   << For rest of SDISC. >> <<07114>>09950000
      RETURN;                         << Normal return here >> <<07114>>09955000
                                                               <<07114>>09960000
<< If we're here, we had an  error  acquiring,  locking  or >> <<07114>>09965000
<< freezing a buffer. Assume it's due to unavailable memory >> <<07114>>09970000
<< and reduce our requirements (after releasing all buffers >> <<07114>>09975000
<< acquired so far). Try again unless we fall below minimum >> <<07114>>09980000
<< requirements.                                            >> <<07114>>09985000
                                                               <<07114>>09990000
ERROR:                                                         <<07114>>09995000
      RELEASE'BUFFERS;                                         <<07114>>10000000
      IF RECBUFFLEN = MAX'BUFFER'LENGTH                        <<07114>>10005000
         THEN RECBUFFLEN := RECBUFFLEN -   << Get us to 8K..>> <<07114>>10010000
              RECBUFFLEN MOD BUFFER'INCREMENT  << boundary. >> <<07114>>10015000
         ELSE RECBUFFLEN := RECBUFFLEN - BUFFER'INCREMENT;     <<07114>>10020000
      END     << Each data segment is RECBUFFLEN long.      >> <<07114>>10025000
     UNTIL RECBUFFLEN < MIN'BUFFER'LENGTH;                     <<07114>>10030000
   END        << Try to get NUM'BUFFERS data segments.      >> <<07114>>10035000
  UNTIL (NUM'BUFFERS := NUM'BUFFERS - 1) = 0;                  <<07114>>10040000
ERRORCODE := SDERR34;      << At the end of our rope.       >> <<07114>>10045000
END;   << of ALLOCATE'BUFFERS.                              >> <<07114>>10050000
$PAGE " *** Procedure DEALLOCATE'BUFFERS ***"                  <<07114>>10055000
PROCEDURE DEALLOCATE'BUFFERS;                                  <<07114>>10060000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>10065000
                                                               <<07114>>10070000
BEGIN COMMENT --                                               <<07114>>10075000
  DEALLOCATE'BUFFERS releases all SDISC XDS data  buffers  and <<07114>>10080000
resets the LDTX Data Buffers Allocated word.                   <<07114>>10085000
                                                               <<07114>>10090000
  Inputs:   None.                                              <<07114>>10095000
                                                               <<07114>>10100000
  Returns:  No direct return, but SDERR should be checked.     <<07114>>10105000
            The condition code is not affected.                <<07114>>10110000
                                                               <<07114>>10115000
  Special considerations:  DB must be at SDISC's global varia- <<07114>>10120000
                           ble XDS, same at return.            <<07114>>10125000
                                                               <<07114>>10130000
  Called by:  CLOSE'DEVICE                                     <<07114>>10135000
                                                               <<07114>>10140000
  Calls:      RELEASE'BUFFERS.                                 <<07114>>10145000
;                                                              <<07114>>10150000
INTEGER                                                        <<07114>>10155000
   LDTX'INDEX := 0,                                            <<07114>>10160000
   SAVE'LDT'SIR;                                               <<07114>>10165000
                                                               <<07114>>10170000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<07114>>10175000
                                                               <<07114>>10180000
SUBROUTINE DEF'MOVETODSEG;                                     <<07114>>10185000
                                                               <<07114>>10190000
IF BUFFERS'ALLOCATED THEN                                               10195000
   BEGIN   << Must have 'em before we can give 'em back.    >> <<07114>>10200000
   CLEAR'ALL'BUFFERS;   << Resolve any outstanding I/O.     >> <<07114>>10205000
   RELEASE'BUFFERS;                                            <<07114>>10210000
   MOVEFROMDSEG (@LDT, LDT'DST, 0, SIZE'OF'LDT'ENTRY);         <<07114>>10215000
   MOVEFROMDSEG (@LDTX, LDT'DST, LDTX'BASE +                   <<07114>>10220000
                 LDNUM*SIZE'OF'LDTX'ENTRY, SIZE'OF'LDTX'ENTRY);<<07114>>10225000
   IF LDTX'SERIAL'OR'FOREIGN THEN                              <<07114>>10230000
      BEGIN   << Safe to reset LDTX entry.                     <<07114>>10235000
      LDTX'SDISC'DBUFS'ALLOC := 0;                             <<07114>>10240000
      SAVE'LDT'SIR := GETSIR (LDT'SIR);                        <<07114>>10245000
      MOVETODSEG (LDT'DST, LDTX'BASE+LDNUM*SIZE'OF'LDTX'ENTRY, <<07114>>10250000
                  @LDTX, SIZE'OF'LDTX'ENTRY);                  <<07114>>10255000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<07114>>10260000
      END                                                      <<07114>>10265000
   ELSE ERRORCODE := SDERR26;                                  <<07114>>10270000
   END;   << Must have 'em...                               >> <<07114>>10275000
END;   << of DEALLOCATE'BUFFERS.                            >> <<07114>>10280000
$PAGE " *** Procedure READ'DISC'LABEL ***"                     <<07114>>10285000
PROCEDURE READ'DISC'LABEL;                                     <<07114>>10290000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>10295000
                                                               <<07114>>10300000
BEGIN COMMENT --                                               <<07114>>10305000
  Reads or writes DEFAULT'SECTOR'SIZE words from or to  sector <<07114>>10310000
(block) 0 to or from WORKTABLE.                                <<07114>>10315000
;                                                              <<07114>>10320000
ENTRY                                                          <<07114>>10325000
   WRITE'DISC'LABEL;                                           <<07114>>10330000
                                                               <<07114>>10335000
DOUBLE                                                         <<07114>>10340000
   DERR;                                                       <<07114>>10345000
                                                               <<07114>>10350000
INTEGER                                                        <<07114>>10355000
   ERR1 = DERR,                                                <<07114>>10360000
   FUNC;                                                       <<07114>>10365000
                                                               <<07114>>10370000
FUNC := READ;                                                  <<07114>>10375000
                                                               <<07114>>10380000
WHILE FALSE DO                                                 <<07114>>10385000
                                                               <<07114>>10390000
WRITE'DISC'LABEL:                                              <<07114>>10395000
                                                               <<07114>>10400000
   FUNC := WRITE'LABEL;                                        <<07114>>10405000
                                                               <<07114>>10410000
                                                               <<07114>>10415000
DERR := ATACHIO (LDNUM, QMISC', DSTN, @WORKTABLE,              <<07114>>10420000
        FUNC, DEFAULT'SECTOR'SIZE, 0, 0, BLOCKED);             <<07114>>10425000
IF ATIOERR THEN ERRORCODE := SDERR2;                           <<07114>>10430000
RETURN;                                                        <<07114>>10435000
END;   << of READ'DISC'LABEL.                               >> <<07114>>10440000
$PAGE   "   *** Procedure COMPACT'DTT ***"                     <<07114>>10445000
PROCEDURE COMPACT'DTT;                                         <<07114>>10450000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>10455000
                                                               <<07114>>10460000
BEGIN COMMENT --                                               <<07114>>10465000
  COMPACT'DTT  compacts  any  7905R/7906R/7920/7925  Defective <<07114>>10470000
Tracks  Table (DTT) entries that are left after REASSIGN'792X' <<07114>>10475000
TRACKS is finished.  An entry which is still active is non-0.  <<07114>>10480000
  We work with a copy of the DTT which has  already  been  al- <<07114>>10485000
tered by REASSIGN'792X'TRACKS. We'll change it some more, then <<07114>>10490000
other routines are responsible for posting  the  updated  copy <<07114>>10495000
back to the disc.                                              <<07114>>10500000
  The compaction algorithm uses three indices into the DTT  to <<07114>>10505000
move  contiguous active entries into the space previously used <<07114>>10510000
by deleted entries.  The three indices are:                    <<07114>>10515000
   TO'ENTRY:       The destination of the active entries, cur- <<07114>>10520000
                   rently a deleted entry.                     <<07114>>10525000
   START'ENTRY:    Index of the  first  active  entry  in  the <<07114>>10530000
                   group.                                      <<07114>>10535000
   THIS'ENTRY:     Index of the first deleted entry beyond the <<07114>>10540000
                   group of active entries, also  the  overall <<07114>>10545000
                   DTT scanning index.                         <<07114>>10550000
  Operation is as follows:  The three indices are  initialized <<07114>>10555000
to the first entry in the DTT.  The DTT is then scanned  until <<07114>>10560000
all active entries have been accounted for.  As it is scanned, <<07114>>10565000
each entry can be active or deleted.  An  active  entry  bumps <<07114>>10570000
THIS'ENTRY.  A deleted entry causes all entries between START' <<07114>>10575000
ENTRY and THIS'ENTRY to be moved to TO'ENTRY, then  the  other <<07114>>10580000
two indices are set to THIS'ENTRY.                             <<07114>>10585000
  There are three special cases:                               <<07114>>10590000
1.  TO'ENTRY = START'ENTRY when we find a deleted entry.  This <<07114>>10595000
    is the situation when the first DTT entry is  active.  Ob- <<07114>>10600000
    viously, no move is needed, so it is skipped.              <<07114>>10605000
2.  START'ENTRY = THIS'ENTRY when we  find  a  deleted  entry. <<07114>>10610000
    This  happens  for  contiguous deleted entries.  Again, no <<07114>>10615000
    move is needed.                                            <<07114>>10620000
3.  The last active entry is scanned. This is treated as if we <<07114>>10625000
    had found a deleted entry, that is,  any  needed  move  is <<07114>>10630000
    performed.                                                 <<07114>>10635000
;                                                              <<07114>>10640000
EQUATE                                                         <<07114>>10645000
   DELETED'ENTRY    = 0;                                       <<07114>>10650000
                                                               <<07114>>10655000
LOGICAL                                                        <<07114>>10660000
   ACTIVE'ENTRIES  := 0,                                       <<07114>>10665000
   DELETED'ENTRIES := 0,                                       <<07114>>10670000
   START'ENTRY,                                                <<07114>>10675000
   THIS'ENTRY,                                                 <<07114>>10680000
   TO'ENTRY;                                                   <<07114>>10685000
                                                               <<07114>>10690000
                                                               <<07114>>10695000
SUBROUTINE MOVE'ENTRIES;                                       <<07114>>10700000
                                                               <<07114>>10705000
BEGIN COMMENT --                                               <<07114>>10710000
  MOVE'ENTRIES is actually a conditional move.  The  block  of <<07114>>10715000
DTT  entries  defined by START'ENTRY to THIS'ENTRY is moved to <<07114>>10720000
TO'ENTRY only if all three indices are different. See comments <<07114>>10725000
to the procedure for more details.                             <<07114>>10730000
;                                                              <<07114>>10735000
IF TO'ENTRY <> START'ENTRY THEN                                <<07114>>10740000
   IF START'ENTRY <> THIS'ENTRY THEN                           <<07114>>10745000
      BEGIN   << We need to move, then update TO'ENTRY.     >> <<07114>>10750000
      MOVE DTT(TO'ENTRY) := DTT(START'ENTRY),                  <<07114>>10755000
           (THIS'ENTRY - START'ENTRY);                         <<07114>>10760000
      TO'ENTRY := TO'ENTRY + (THIS'ENTRY - START'ENTRY);       <<07114>>10765000
      END                                                      <<07114>>10770000
   ELSE   << Null ELSE.                                     >> <<07114>>10775000
ELSE      << No move, just update TO'ENTRY.                 >> <<07114>>10780000
   TO'ENTRY := THIS'ENTRY;                                     <<07114>>10785000
END;   << of MOVE'ENTRIES.                                  >> <<07114>>10790000
                                                               <<07114>>10795000
                                                               <<07114>>10800000
TO'ENTRY := START'ENTRY := THIS'ENTRY := DTT'FIRST'ENTRY;      <<07114>>10805000
ACTIVE'ENTRIES := DELETED'ENTRIES := 0;                        <<07114>>10810000
WHILE ACTIVE'ENTRIES < DTT(DTT'NUMBER'OF'ENTRIES) DO           <<07114>>10815000
   BEGIN                                                       <<07114>>10820000
   IF ACTIVE'ENTRIES + DELETED'ENTRIES >                       <<07114>>10825000
         DTT(DTT'MAX'NUMBER'ENTRIES) THEN                      <<07114>>10830000
      BEGIN                                                    <<07114>>10835000
      ERRORCODE := SDERR33;   << Corrupt DTT.               >> <<07114>>10840000
      RETURN;                                                  <<07114>>10845000
      END;                                                     <<07114>>10850000
   IF DTT(THIS'ENTRY) = DELETED'ENTRY THEN                     <<07114>>10855000
      BEGIN                                                    <<07114>>10860000
      DELETED'ENTRIES := DELETED'ENTRIES + 1;                  <<07114>>10865000
      MOVE'ENTRIES;                                            <<07114>>10870000
      START'ENTRY := THIS'ENTRY := THIS'ENTRY + 1;             <<07114>>10875000
      END     << Deleted entry.                             >> <<07114>>10880000
   ELSE                                                        <<07114>>10885000
      BEGIN   << Active entry.                              >> <<07114>>10890000
      ACTIVE'ENTRIES := ACTIVE'ENTRIES + 1;                    <<07114>>10895000
      THIS'ENTRY := THIS'ENTRY + 1;                            <<07114>>10900000
      END;                                                     <<07114>>10905000
   END;         << WHILE loop.                              >> <<07114>>10910000
MOVE'ENTRIES;   << if need be.                              >> <<07114>>10915000
END;            << of COMPACT'DTT.                          >> <<07114>>10920000
$PAGE   "   *** Procedure MATCH'DTT'ENTRY ***"                 <<07114>>10925000
INTEGER PROCEDURE MATCH'DTT'ENTRY (TRACK);                     <<07114>>10930000
   VALUE   TRACK;                                              <<07114>>10935000
   LOGICAL TRACK;                                              <<07114>>10940000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>10945000
                                                               <<07114>>10950000
BEGIN COMMENT --                                               <<07114>>10955000
  MATCH'DTT'ENTRY searches the Defective Track Table (DTT) for <<07114>>10960000
an entry whose track matches the input parameter.  If such  an <<07114>>10965000
entry is found, its DTT index is returned in the result. If no <<07114>>10970000
match, a -1 is returned instead.                               <<07114>>10975000
  We expect a DTT image in the DTT array.  There are no errors <<07114>>10980000
associated with this procedure.                                <<07114>>10985000
;                                                              <<07114>>10990000
LOGICAL                                                        <<07114>>10995000
   ENTRY'COUNT := 0;                                           <<07114>>11000000
                                                               <<07114>>11005000
WHILE (ENTRY'COUNT := ENTRY'COUNT + 1) <=                      <<07114>>11010000
       DTT(DTT'NUMBER'OF'ENTRIES) DO                           <<07114>>11015000
   IF DTT(ENTRY'COUNT).DTT'TRACK'NUMBER = TRACK THEN           <<07114>>11020000
      BEGIN   << Found it.                                  >> <<07114>>11025000
      MATCH'DTT'ENTRY := ENTRY'COUNT;                          <<07114>>11030000
      RETURN;                                                  <<07114>>11035000
      END;                                                     <<07114>>11040000
MATCH'DTT'ENTRY := -1;   << Entry not found.                >> <<07114>>11045000
END;                     << of MATCH'DTT'ENTRY.             >> <<07114>>11050000
$PAGE   "   *** Procedure FIND'CYL'AND'HEAD ***"               <<07114>>11055000
LOGICAL PROCEDURE FIND'CYL'AND'HEAD (TRACK);                   <<07114>>11060000
   VALUE   TRACK;                                              <<07114>>11065000
   LOGICAL TRACK;                                              <<07114>>11070000
   OPTION  PRIVILEGED, UNCALLABLE, INTERNAL;                   <<07114>>11075000
                                                               <<07114>>11080000
BEGIN COMMENT --                                               <<07114>>11085000
  FIND'CYL'AND'HEAD retrieves valid cylinder and head address- <<07114>>11090000
es from TRACK on a MAC (7905R/7906R/7920/7925) disc using  the <<07114>>11095000
Read  Full  Sector  function.  These addresses are returned in <<07114>>11100000
CYLINDER and HEAD, which are aliases of the globals  RTV3  and <<07114>>11105000
RTV4, respectively (required because of our split-stack opera- <<07114>>11110000
tion).  The values are valid only  if  the  procedure  returns <<07114>>11115000
TRUE.  Here's what will make it return FALSE:                  <<07114>>11120000
  1.  A cylinder address of -1.  DMD factory diagnostics  mark <<07114>>11125000
defective tracks that way, so we should not use such a track.  <<07114>>11130000
  2.  Reading the entire track, one sector at a time,  without <<07114>>11135000
finding  the  same cylinder and head addresses in any two con- <<07114>>11140000
secutive sectors.  Here's how we rationalize this:             <<07114>>11145000
    Each track is supposed to have the same cylinder and  head <<07114>>11150000
  address  in  each  sector  of the track.  We often deal with <<07114>>11155000
  suspect tracks, tracks in which one or more read errors have <<07114>>11160000
  been found. Read Full Sector does not detect any read errors <<07114>>11165000
  so this is a way to ignore an error which causes one or both <<07114>>11170000
  of the addresses to be returned incorrectly. If the track is <<07114>>11175000
  so bad that we can't read ANY two consecutive  sectors  cor- <<07114>>11180000
  rectly, it's time to hang it up.                             <<07114>>11185000
    We can't use the low end of WORKTABLE, because it has  the <<07114>>11190000
DTT.  So  we  use  the  area above the DTT.  Note:  The global <<07114>>11195000
EQUATE MAX'SECTOR'SIZE should never drop below DEFAULT'SECTOR' <<07114>>11200000
SIZE + RFS'SIZE, or we'll clobber some other SDISC areas.      <<07114>>11205000
  No SDERRs are set here. Callers can deal with a FALSE return <<07114>>11210000
as they please.                                                <<07114>>11215000
;                                                              <<07114>>11220000
EQUATE                                                         <<07114>>11225000
   RFS'SIZE = 141;  << One sector + 2x3 address wds + 7 chk >> <<07114>>11230000
                                                               <<07114>>11235000
DOUBLE                                                         <<07114>>11240000
   DERR,                                                       <<07114>>11245000
   FIRST'SECTOR,   << First logical sector of TRACK.        >> <<07114>>11250000
   SECTOR;         << Moving sector address.                >> <<07114>>11255000
                                                               <<07114>>11260000
INTEGER                                                        <<07114>>11265000
   ERR1    = DERR,                                             <<07114>>11270000
   SECTOR0 = SECTOR,                                           <<07114>>11275000
   SECTOR1 = SECTOR + 1;                                       <<07114>>11280000
                                                               <<07114>>11285000
LOGICAL POINTER                                                <<07114>>11290000
   RFS'BUFFER;                                                 <<07114>>11295000
                                                               <<07114>>11300000
DEFINE                                                         <<07114>>11305000
   CYLAD1 = RFS'BUFFER(1)         #,                           <<07114>>11310000
   CYLAD2 = RFS'BUFFER(139)       #,                           <<07114>>11315000
   HEAD1  = RFS'BUFFER(2).(3:5)   #,                           <<07114>>11320000
   HEAD2  = RFS'BUFFER(140).(3:5) #;                           <<07114>>11325000
                                                               <<07114>>11330000
FIND'CYL'AND'HEAD := FALSE;                                    <<07114>>11335000
@RFS'BUFFER := @WORKTABLE(WORDSPERSECTR);                      <<07114>>11340000
SECTOR := FIRST'SECTOR := TRACK ** LOGICAL (SECTORSPERTRAK);   <<07114>>11345000
WHILE SECTOR < FIRST'SECTOR + DOUBLE (SECTORSPERTRAK) DO       <<07114>>11350000
   BEGIN                                                       <<07114>>11355000
   DERR := ATACHIO (LDNUM, QMISC', DSTN, @RFS'BUFFER, RFS,     <<07114>>11360000
                    RFS'SIZE, SECTOR0, SECTOR1, BLOCKED);      <<07114>>11365000
   IF ATIOERR THEN RETURN;   << Let caller handle.          >> <<07114>>11370000
   IF CYLAD1 = -1 THEN RETURN;   << Deleted.                >> <<07114>>11375000
   IF CYLAD1 = CYLAD2 AND HEAD1 = HEAD2 THEN                   <<07114>>11380000
      BEGIN   << Found valid track.                         >> <<07114>>11385000
      CYLINDER := CYLAD1;   << Return in RTV3...            >> <<07114>>11390000
      HEAD     := HEAD1;    <<   and RTV4.                  >> <<07114>>11395000
      FIND'CYL'AND'HEAD := TRUE;                               <<07114>>11400000
      RETURN;                                                  <<07114>>11405000
      END;    << Found valid track.                         >> <<07114>>11410000
   END;       << WHILE loop.                                >> <<07114>>11415000
END;          << of FIND'CYL'AND'HEAD.                      >> <<07114>>11420000
$PAGE   "   *** Procedure FLAG'792X'TRACK ***"                 <<07114>>11425000
LOGICAL PROCEDURE FLAG'792X'TRACK (PHYS'TRACK, LOG'TRACK,      <<07114>>11430000
                                   SPD'FLAG);                  <<07114>>11435000
   VALUE   PHYS'TRACK, LOG'TRACK, SPD'FLAG;                    <<07114>>11440000
   INTEGER PHYS'TRACK, LOG'TRACK, SPD'FLAG;                    <<07114>>11445000
   OPTION  PRIVILEGED, UNCALLABLE, INTERNAL, VARIABLE;         <<07114>>11450000
                                                               <<07114>>11455000
BEGIN COMMENT --                                               <<07114>>11460000
  FLAG'792X'TRACK initializes a  7905R/7906R/7920/7925  track. <<07114>>11465000
"Initializing"  here  means  a  disc  hardware  function which <<07114>>11470000
writes into the address fields of the track (including the SPD <<07114>>11475000
bits, about which more in a minute) in addition  to  the  data <<07114>>11480000
areas. This is, therefore, a highly specialized function which <<07114>>11485000
must be used with care.                                        <<07114>>11490000
  SDISC uses this procedure to reassign tracks and  to  delete <<07114>>11495000
suspect  alternate tracks which have had their original defec- <<07114>>11500000
tive track reassigned to a new alternate track.                <<07114>>11505000
  The SPD'FLAG is a right-justified image of three bits  (SPD) <<07114>>11510000
which  may  be written into the disc address fields along with <<07114>>11515000
the addresses.  No more than one bit at a time may be set, and <<07114>>11520000
the combination must be the same for all sectors  in  a  given <<07114>>11525000
track.                                                         <<07114>>11530000
  Interface to the disc driver:                                <<07114>>11535000
   PHYS'TRACK -- The physical disc area which will be initial- <<07114>>11540000
                 ized.  The entire track is written.           <<07114>>11545000
   LOG'TRACK  -- Optional parameter. If present, we will break <<07114>>11550000
                 it up into cylinder and head  addresses,  and <<07114>>11555000
                 this  information  is  written to the address <<07114>>11560000
                 fields of PHYS'TRACK.  If omitted, we  supply <<07114>>11565000
                 a -1 for the cylinder address which indicates <<07114>>11570000
                 a deleted track.  (The SPD flag  should  have <<07114>>11575000
                 the D-bit on, but this is not checked).       <<07114>>11580000
   SPD'FLAG   -- Three one-bit fields, only one of  which  may <<07114>>11585000
                 be set (but this is not checked):             <<07114>>11590000
            S -- (13:1).  PHYS'TRACK is to be  flagged  Spare. <<07114>>11595000
                 PHYS'TRACK  should  be in the alternate track <<07114>>11600000
                 area of the disc.  LOG'TRACK  should  be  the <<07114>>11605000
                 suspect track being reassigned to PHYS'TRACK. <<07114>>11610000
            P -- (14:1).  Not used by MPE and should never  be <<07114>>11615000
                 set.                                          <<07114>>11620000
            D -- (15:1).  PHYS'TRACK is to be  flagged  Defec- <<07114>>11625000
                 tive. If PHYS'TRACK is being Reassigned, LOG' <<07114>>11630000
                 TRACK should be in the alternate  track  area <<07114>>11635000
                 of the disc.  If PHYS'TRACK is being Deleted, <<07114>>11640000
                 LOG'TRACK should be omitted from the  calling <<07114>>11645000
                 sequence.                                     <<07114>>11650000
  Getting this additional information to the disc driver posed <<07114>>11655000
quite a problem to designers constrained to ATTACHIO's  inter- <<07114>>11660000
face.  PHYS'TRACK  is  no problem, since it is disguised as P1 <<07114>>11665000
and P2, as for other operations.  But there was no  place  for <<07114>>11670000
LOG'TRACK  or  the SPD information.  Here's how they did it (I <<07114>>11675000
know it's ugly, but no one's found a better way yet):          <<07114>>11680000
   BUFFADR - 3:  Holds the SPD information in (12:3).  Bit 15, <<07114>>11685000
                 if set, tells the driver to verify the  track <<07114>>11690000
                 after initializing.  We always clear it.      <<07114>>11695000
   BUFFADR - 2:  Holds the cylinder address from LOG'TRACK.    <<07114>>11700000
   BUFFADR - 1:  (0:8) = head address, (8:8) = sector address. <<07114>>11705000
                 Sector address must always be 0.              <<07114>>11710000
   BUFFADR ...   One track worth of data. For proper operation <<07114>>11715000
                 you MUST initialize an entire track. The data <<07114>>11720000
                 is irrelevant in SDISC, so we use the current <<07114>>11725000
                 data buffer without disturbing  the  data  or <<07114>>11730000
                 the buffer management areas.                  <<07114>>11735000
  The procedure returns TRUE if  no  I/O  error  occurs,  else <<07114>>11740000
FALSE.                                                         <<07114>>11745000
  NOTE:  The $INCLUDE file, module B6, must be declared local- <<07114>>11750000
ly to assure that the arrays in it are PB-relative.  We cannot <<07114>>11755000
declare them globally because they  are  indirect,  and  would <<07114>>11760000
screw up our do-it-yourself secondary DB allocation.           <<07114>>11765000
;                                                              <<07114>>11770000
$SET X7 = ON   << Force arrays to be PB-relative.           >> <<07114>>11775000
$PAGE                                                          <<07114>>11780000
$INCLUDE INCDISC2                                              <<07114>>11785000
$PAGE                                                          <<07114>>11790000
DOUBLE                                                         <<07114>>11795000
   DERR,                                                       <<07114>>11800000
   PHYS'SECTOR;   << Starting address in single-vector form >> <<07114>>11805000
                                                               <<07114>>11810000
LOGICAL                                                        <<07114>>11815000
   ERR1         = DERR,                                        <<07114>>11820000
   PHYS'SECTOR0 = PHYS'SECTOR,                                 <<07114>>11825000
   PHYS'SECTOR1 = PHYS'SECTOR + 1,                             <<07114>>11830000
   QPARM        = Q - 4;                                       <<07114>>11835000
                                                               <<07114>>11840000
INTEGER POINTER                                                <<07114>>11845000
   DB'AREA;   << Set to unused area of WORKTABLE.           >> <<07114>>11850000
                                                               <<07114>>11855000
DEFINE                                                         <<07114>>11860000
   LOG'CYLINDER     = DB'AREA(1)  #,                           <<07114>>11865000
   LOG'HEAD'SECTOR  = DB'AREA(2)  #,                           <<07114>>11870000
   PASSED'LOG'TRACK = QPARM.(14:1)#,                           <<07114>>11875000
   SPD              = DB'AREA     #;                           <<07114>>11880000
                                                               <<07114>>11885000
                                                               <<07114>>11890000
SUBROUTINE DEF'MOVEDSEG;                                       <<07114>>11895000
                                                               <<07114>>11900000
                                                               <<07114>>11905000
@DB'AREA := @WORKTABLE(WORDSPERSECTR);                         <<07114>>11910000
PHYS'SECTOR := LOGICAL(PHYS'TRACK) ** LOGICAL(SECTORSPERTRAK); <<07114>>11915000
IF PASSED'LOG'TRACK THEN                                       <<07114>>11920000
   BEGIN   << This is what we write in the address fields.  >> <<07114>>11925000
   LOG'CYLINDER := LOG'TRACK / MH'TRACKS'PER'CYLINDER(SUBTYPE);<<07114>>11930000
   LOG'HEAD'SECTOR := (LOG'TRACK MOD                           <<07114>>11935000
       MH'TRACKS'PER'CYLINDER(SUBTYPE)) & LSL(8);              <<07114>>11940000
   END                                                         <<07114>>11945000
ELSE                                                           <<07114>>11950000
   BEGIN   << No LOG'TRACK parm, assume we're deleting.     >> <<07114>>11955000
   LOG'CYLINDER := -1;                                         <<07114>>11960000
   LOG'HEAD'SECTOR := 0;                                       <<07114>>11965000
   END;                                                        <<07114>>11970000
SPD := SPD'FLAG & LSL(1);                                      <<07114>>11975000
                                                               <<07114>>11980000
<< Save first three words of current data buffer  while  we >> <<07114>>11985000
<< use the space as BUFADDR-3 to BUFFADR-1. We must use the >> <<07114>>11990000
<< DB'AREA array to avoid split stack problems (can't LRA a >> <<07114>>11995000
<< Q-relative array while in split-stack).                  >> <<07114>>12000000
                                                               <<07114>>12005000
MOVEDSEG (DSTN, @DB'AREA(3), DATABUF'DST, 0, 3);               <<07114>>12010000
MOVEDSEG (DATABUF'DST, 0, DSTN, @DB'AREA, 3);                  <<07114>>12015000
DERR := ATACHIO (LDNUM, QMISC', DATABUF'DST, 3, INITIALIZE,    <<07114>>12020000
        SECTORSPERTRAK*WORDSPERSECTR, PHYS'SECTOR0,            <<07114>>12025000
        PHYS'SECTOR1, BLOCKED);                                <<07114>>12030000
MOVEDSEG (DATABUF'DST, 0, DSTN, @DB'AREA(3), 3);  << Restore>> <<07114>>12035000
FLAG'792X'TRACK := NOT ATIOERR;                                <<07114>>12040000
END;   << of FLAG'792X'TRACK.                               >> <<07114>>12045000
$PAGE   "   *** Procedure REASSIGN'ONE'TRACK ***"              <<07114>>12050000
   LOGICAL PROCEDURE REASSIGN'ONE'TRACK (DTT'INDEX);           <<07114>>12055000
   VALUE   DTT'INDEX;                                          <<07114>>12060000
   INTEGER DTT'INDEX;                                          <<07114>>12065000
OPTION  PRIVILEGED, UNCALLABLE, INTERNAL;                      <<07114>>12070000
                                                               <<07114>>12075000
BEGIN COMMENT --                                               <<07114>>12080000
  REASSIGN'ONE'TRACK reassigns the track indicated by  DTT'IN- <<07114>>12085000
DEX  to  the next available alternate track.  "Available" here <<07114>>12090000
means the track currently in DTT'NEXT'ALT'TRACK iff that track <<07114>>12095000
has not been previously deleted.  If the track is deleted, the <<07114>>12100000
next track address is tried until a non-deleted track is found <<07114>>12105000
or until we run out of tracks.  A deleted track is one with  a <<07114>>12110000
cylinder  address field of -1, put there by the factory during <<07114>>12115000
initial certification or by SDISC if deleting a suspect alter- <<07114>>12120000
nate track.                                                    <<07114>>12125000
  The process of reassigning a track causes an association be- <<07114>>12130000
tween a suspect track and an alternate track. The association, <<07114>>12135000
recognized by the disc subsystem hardware, is such that a log- <<07114>>12140000
ical access to one or more sectors on the suspect  track  will <<07114>>12145000
cause the hardware to automatically access the alternate track <<07114>>12150000
instead.                                                       <<07114>>12155000
  Further refinement of the above:  The process of reassigning <<07114>>12160000
causes the suspect track to be marked Reassigned  in  the  DTT <<07114>>12165000
and  Defective  on  the  disc.  The  alternate track is marked <<07114>>12170000
Spare on the disc.  The interested reader can find a more  de- <<07114>>12175000
tailed  description  of  the  hardware  aspects of reassigning <<07114>>12180000
tracks in appropriate 13037 controller documentation.          <<07114>>12185000
  The procedure returns TRUE if the track is successfully  re- <<07114>>12190000
assigned.  Any I/O error here causes us to return FALSE.       <<07114>>12195000
  NOTE:  The $INCLUDE file, module B6, must be declared local- <<07114>>12200000
ly to assure that the arrays in it are PB-relative.  We cannot <<07114>>12205000
declare them globally because they  are  indirect,  and  would <<07114>>12210000
screw up our do-it-yourself secondary DB allocation.           <<07114>>12215000
;                                                              <<07114>>12220000
$SET X7 = ON   << Force arrays to be PB-relative.           >> <<07114>>12225000
$PAGE                                                          <<07114>>12230000
$INCLUDE INCDISC2                                              <<07114>>12235000
$PAGE                                                          <<07114>>12240000
LOGICAL                                                        <<07114>>12245000
   DEFECTIVE'TRACK,                                            <<07114>>12250000
   GOT'ALTERNATE := FALSE;                                     <<07114>>12255000
                                                               <<07114>>12260000
INTEGER                                                        <<07114>>12265000
   TEST'ALTERNATE;                                             <<07114>>12270000
                                                               <<07114>>12275000
REASSIGN'ONE'TRACK := FALSE;                                   <<07114>>12280000
DEFECTIVE'TRACK := DTT(DTT'INDEX).DTT'TRACK'NUMBER;            <<07114>>12285000
TEST'ALTERNATE := DTT(DTT'NEXT'ALT'TRACK);                     <<07114>>12290000
WHILE NOT GOT'ALTERNATE DO                                     <<07114>>12295000
   BEGIN   << Test for deleted alternate track, use if O.K. >> <<07114>>12300000
   IF FIND'CYL'AND'HEAD (TEST'ALTERNATE) THEN                  <<07114>>12305000
      GOT'ALTERNATE := TRUE                                    <<07114>>12310000
   ELSE                                                        <<07114>>12315000
      BEGIN   << Not this time, have we got another to try? >> <<07114>>12320000
      IF (TEST'ALTERNATE := TEST'ALTERNATE + 1) /              <<07114>>12325000
         MH'TRACKS'PER'CYLINDER(SUBTYPE) >=                    <<07114>>12330000
         MH'MAX'LOG'PACK'SIZE(SUBTYPE) THEN                    <<07114>>12335000
         BEGIN   << Out of alternates, gotta quit.          >> <<07114>>12340000
         RETURN;                                               <<07114>>12345000
         END;    << Out of alternates, gotta quit.          >> <<07114>>12350000
      END;       << Not this time, another alternate?       >> <<07114>>12355000
   END;          << WHILE loop.                             >> <<07114>>12360000
                                                               <<07114>>12365000
<< We now have both the defective and alternate tracks,  so >> <<07114>>12370000
<< perform the reassignment.                                >> <<07114>>12375000
                                                               <<07114>>12380000
IF FLAG'792X'TRACK (TEST'ALTERNATE, DEFECTIVE'TRACK, SPARE)    <<07114>>12385000
   THEN                                                        <<07114>>12390000
   IF FLAG'792X'TRACK (DEFECTIVE'TRACK, TEST'ALTERNATE,        <<07114>>12395000
      DEFECTIVE) THEN                                          <<07114>>12400000
      BEGIN   << We did it, update DTC and return.          >> <<07114>>12405000
      DTT(DTT'INDEX).DTT'TRACK'CODE := DTT'REASSIGNED;         <<07114>>12410000
      DTT(DTT'NEXT'ALT'TRACK) := TEST'ALTERNATE + 1;           <<07114>>12415000
      REASSIGN'ONE'TRACK := TRUE;                              <<07114>>12420000
      RETURN;                                                  <<07114>>12425000
      END;                                                     <<07114>>12430000
END;   << of REASSIGN'ONE'TRACK.                            >> <<07114>>12435000
$PAGE   "   *** Procedure REASSIGN'792X'TRACKS ***"            <<07114>>12440000
PROCEDURE REASSIGN'792X'TRACKS;                                <<07114>>12445000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>12450000
                                                               <<07114>>12455000
BEGIN COMMENT --                                               <<07114>>12460000
  REASSIGN'792X'TRACKS reassigns any suspect,  suspect  alter- <<07114>>12465000
nate,  or  deleted  tracks  in the Defective Track Table (DTT) <<07114>>12470000
-IFF- those tracks are beyond our current starting  write  ad- <<07114>>12475000
dress  (we  can't  guarantee  to preserve existing data in the <<07114>>12480000
current track if it is reassigned).  Entries in this table are <<07114>>12485000
not removed, as they are in the DSCT, except for  suspect  al- <<07114>>12490000
ternate  tracks.  They  already have an entry corresponding to <<07114>>12495000
their original reassigning, so we don't need the new  one.  It <<07114>>12500000
is  deleted  after the new reassigning, and in this case alone <<07114>>12505000
the DTT is compacted before being rewritten to the disc.       <<07114>>12510000
  This is a more complicated routine than its CS80 counterpart <<07114>>12515000
SPARE'CS80'BLOCKS. This is because the CS80 disc hardware does <<07114>>12520000
most of what we have to do here for 7905/7906/7920/7925 discs. <<07114>>12525000
What follows is an ever-increasing list of the gotchas we must <<07114>>12530000
check for:                                                     <<07114>>12535000
  1.  The integrity of the DTT (<= 120 entries, and  the  next <<07114>>12540000
available  alternate  track must lie in the proper area of the <<07114>>12545000
disc).                                                         <<07114>>12550000
  2.  For each track we reassign,  the  alternate  must  exist <<07114>>12555000
(that  is,  we  must check that we haven't used them all), and <<07114>>12560000
its integrity must be checked before we use it.  We limit  the <<07114>>12565000
integrity check to seeing whether a diagnostic has flagged the <<07114>>12570000
track as deleted by setting the cylinder address field to  -1. <<07114>>12575000
(We could check its present condition by reading/verifying but <<07114>>12580000
this could lead to complicated (and possibly endless) loops in <<07114>>12585000
case of an error, which would cause an  additional  DTT  entry <<07114>>12590000
which we would have to deal with -- carefully.  Etc.).         <<07114>>12595000
  3.  Finding a suspect alternate track implies that the track <<07114>>12600000
was the object of an earlier reassignment.  To avoid  multiple <<07114>>12605000
seeks,  we search out the original reassigned track in the DTT <<07114>>12610000
and reassign it again to a new alternate track.  This  is  the <<07114>>12615000
only case for which we have two DTT entries for the same  pair <<07114>>12620000
of reassigned tracks, so the suspect alternate entry is delet- <<07114>>12625000
ed after it is processed.                                      <<07114>>12630000
  Errors and exceptions merit a word or ten.  There are plenty <<07114>>12635000
of them.  In general, a situation which does  not  affect  the <<07114>>12640000
state of the disc is ignored.  Others will cause an SDERR, and <<07114>>12645000
SDISC will not go on.  Examples of the latter might be a  cor- <<07114>>12650000
rupt  DTT  or an I/O error while flagging tracks.  Examples of <<07114>>12655000
the former are a deleted alternate track (one which a diagnos- <<07114>>12660000
tic has flagged as in (2) above) -- the track is  ignored  and <<07114>>12665000
the  next  alternate  track is tried -- or a suspect alternate <<07114>>12670000
for which we can find no corresponding reassigned track in the <<07114>>12675000
DTT -- the entry is ignored and so is its track.               <<07114>>12680000
  NOTE:  The $INCLUDE file, module B6, must be declared local- <<07114>>12685000
ly to assure that the arrays in it are PB-relative.  We cannot <<07114>>12690000
declare them globally because they  are  indirect,  and  would <<07114>>12695000
screw up our do-it-yourself secondary DB allocation.           <<07114>>12700000
;                                                              <<07114>>12705000
$SET X7 = ON   << Force arrays to be PB-relative.           >> <<07114>>12710000
$PAGE                                                          <<07114>>12715000
$INCLUDE INCDISC2                                              <<07114>>12720000
$PAGE                                                          <<07114>>12725000
LOGICAL                                                        <<07114>>12730000
   CURRENT'TRACK,   << Holds track we wrote in last.        >> <<07114>>12735000
   DTT'CHANGED  := FALSE,                                      <<07114>>12740000
   MUST'COMPACT := FALSE,                                      <<07114>>12745000
   ORIG'DEFECTIVE'TRACK,                                       <<07114>>12750000
   THIS'TRACK;      << Holds track number of CURRENT'ENTRY. >> <<07114>>12755000
                                                               <<07114>>12760000
DOUBLE                                                         <<07114>>12765000
   DERR,                                                       <<07114>>12770000
   DTT'ADDR := DTT'DISC'ADDRESS;                               <<07114>>12775000
                                                               <<07114>>12780000
INTEGER                                                        <<07114>>12785000
   DTT'DISC'ADDR0 = DTT'ADDR,                                  <<07114>>12790000
   DTT'DISC'ADDR1 = DTT'ADDR + 1,                              <<07114>>12795000
   ERR1           = DERR,                                      <<07114>>12800000
   ENTRY'COUNT,                                                <<07114>>12805000
   NEXT'ALT'CYL,   << Derived from next alt track in DTT.   >> <<07114>>12810000
   OLD'ENTRY;      << Existing entry when re-assgn susp alt >> <<07114>>12815000
                                                               <<07114>>12820000
                                                               <<07114>>12825000
LOGICAL SUBROUTINE VALID'DTT;                                  <<07114>>12830000
                                                               <<07114>>12835000
BEGIN                                                          <<07114>>12840000
VALID'DTT := FALSE;   << I'm from Missouri.                 >> <<07114>>12845000
IF DTT(DTT'NUMBER'OF'ENTRIES) > DTT'MAX'NUMBER'ENTRIES THEN    <<07114>>12850000
   RETURN;                                                     <<07114>>12855000
NEXT'ALT'CYL := INTEGER (DTT(DTT'NEXT'ALT'TRACK)) /            <<07114>>12860000
                MH'TRACKS'PER'CYLINDER(SUBTYPE);               <<07114>>12865000
IF (MH'DEFAULT'LOG'PACK'SIZE(SUBTYPE) <= NEXT'ALT'CYL <=       <<07114>>12870000
    MH'MAX'LOG'PACK'SIZE(SUBTYPE) - 1) THEN VALID'DTT := TRUE; <<07114>>12875000
END;                                                           <<07114>>12880000
                                                               <<07114>>12885000
                                                               <<07114>>12890000
IF VALID'DTT THEN                                              <<07114>>12895000
   BEGIN                                                       <<07114>>12900000
   ENTRY'COUNT := 0;                                           <<07114>>12905000
   CURRENT'TRACK := (RECBUFFSA + DOUBLE ((CURRENTBUFINDEX +    <<07114>>12910000
      WORDSPERSECTR - 1) / WORDSPERSECTR)) //                  <<07114>>12915000
      LOGICAL (SECTORSPERTRAK);                                <<07114>>12920000
   WHILE (ENTRY'COUNT := ENTRY'COUNT + 1) <=                   <<07114>>12925000
          INTEGER (DTT(DTT'NUMBER'OF'ENTRIES)) DO              <<07114>>12930000
      BEGIN                                                    <<07114>>12935000
      THIS'TRACK := DTT(ENTRY'COUNT).DTT'TRACK'NUMBER;         <<07114>>12940000
      IF THIS'TRACK > CURRENT'TRACK AND                        <<07114>>12945000
         DTT(ENTRY'COUNT).DTT'TRACK'CODE <> DTT'REASSIGNED THEN<<07114>>12950000
         IF DTT(ENTRY'COUNT).DTT'TRACK'CODE = DTT'SUSPECT'ALT  <<07114>>12955000
            THEN                                               <<07114>>12960000
               BEGIN                                           <<07114>>12965000
               IF NOT FIND'CYL'AND'HEAD (DTT(ENTRY'COUNT).     <<07114>>12970000
                  DTT'TRACK'NUMBER) THEN GO TO NEXT'ENTRY;     <<07114>>12975000
               ORIG'DEFECTIVE'TRACK := CYLINDER *              <<07114>>12980000
                    LOGICAL (MH'TRACKS'PER'CYLINDER(SUBTYPE))  <<07114>>12985000
                    + HEAD;                                    <<07114>>12990000
               IF ORIG'DEFECTIVE'TRACK <= CURRENT'TRACK THEN   <<07114>>12995000
                  GO TO NEXT'ENTRY;   << Still in use.      >> <<07114>>13000000
               IF (OLD'ENTRY := MATCH'DTT'ENTRY                <<07114>>13005000
                  (ORIG'DEFECTIVE'TRACK)) = -1 THEN            <<07114>>13010000
                  GO TO NEXT'ENTRY;   << No match.          >> <<07114>>13015000
               IF REASSIGN'ONE'TRACK (OLD'ENTRY) THEN          <<07114>>13020000
                  DTT'CHANGED := TRUE                          <<07114>>13025000
               ELSE                                            <<07114>>13030000
                  BEGIN   << Error reassigning track.       >> <<07114>>13035000
                  ERRORCODE := SDERR12;                        <<07114>>13040000
                  ENTRY'COUNT := DTT(DTT'NUMBER'OF'ENTRIES);   <<07114>>13045000
                  GO TO NEXT'ENTRY;   << Will exit loop.    >> <<07114>>13050000
                  END;                                         <<07114>>13055000
               IF FLAG'792X'TRACK (THIS'TRACK, , DELETED) THEN <<07114>>13060000
                  BEGIN   << Final hurdle has been overcome >> <<07114>>13065000
                  DTT(ENTRY'COUNT) := 0;                       <<07114>>13070000
                  DTT(DTT'NUMBER'OF'ENTRIES) :=                <<07114>>13075000
                      DTT(DTT'NUMBER'OF'ENTRIES) - 1;          <<07114>>13080000
                  DTT'CHANGED := MUST'COMPACT := TRUE;         <<07114>>13085000
                  END                                          <<07114>>13090000
               ELSE                                            <<07114>>13095000
                  BEGIN                                        <<07114>>13100000
                  ERRORCODE := SDERR12;                        <<07114>>13105000
                  ENTRY'COUNT := DTT(DTT'NUMBER'OF'ENTRIES);   <<07114>>13110000
                  END;                                         <<07114>>13115000
               END   << Suspect alternate.                  >> <<07114>>13120000
            ELSE                                               <<07114>>13125000
               BEGIN   << Suspect or deleted.               >> <<07114>>13130000
               IF REASSIGN'ONE'TRACK (ENTRY'COUNT) THEN        <<07114>>13135000
                  DTT'CHANGED := TRUE                          <<07114>>13140000
               ELSE                                            <<07114>>13145000
                  BEGIN                                        <<07114>>13150000
                  ERRORCODE := SDERR12;                        <<07114>>13155000
                  ENTRY'COUNT := DTT(DTT'NUMBER'OF'ENTRIES);   <<07114>>13160000
                  END;                                         <<07114>>13165000
               END;    << Suspect or deleted.               >> <<07114>>13170000
NEXT'ENTRY:                                                    <<07114>>13175000
      END;   << WHILE loop.                                 >> <<07114>>13180000
                                                               <<07114>>13185000
   IF DTT'CHANGED THEN                                         <<07114>>13190000
      BEGIN   << Post changed DTT back to disc.             >> <<07114>>13195000
      IF MUST'COMPACT THEN COMPACT'DTT;                        <<07114>>13200000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @DTT, WRITE,       <<07114>>13205000
              WORDSPERSECTR, DTT'DISC'ADDR0, DTT'DISC'ADDR1,   <<07114>>13210000
              BLOCKED);                                        <<07114>>13215000
      IF ATIOERR THEN ERRORCODE := SDERR8;                     <<07114>>13220000
      END;   << Post changed DTT back to disc.              >> <<07114>>13225000
   END       << Valid DTT.                                  >> <<07114>>13230000
ELSE                                                           <<07114>>13235000
   ERRORCODE := SDERR33;   << Corrupt DTT.                  >> <<07114>>13240000
END;         << of REASSIGN'792X'TRACKS.                    >> <<07114>>13245000
$PAGE   "   *** Procedure COMPACT'DSCT ***"                    <<07114>>13250000
PROCEDURE COMPACT'DSCT;                                        <<07114>>13255000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>13260000
                                                               <<07114>>13265000
BEGIN COMMENT --                                               <<07114>>13270000
  COMPACT'DSCT compacts any CS80 Defective Sector Table (DSCT) <<07114>>13275000
entries that are left after SPARE'CS80'BLOCKS is finished.  An <<07114>>13280000
entry which is still active is non-0.                          <<07114>>13285000
  We work with a copy of the DSCT which has already  been  al- <<07114>>13290000
tered  by  SPARE'CS80'BLOCKS.  We'll change it some more, then <<07114>>13295000
other routines are responsible for posting  the  updated  copy <<07114>>13300000
back to the disc.                                              <<07114>>13305000
  The compaction algorithm uses three indices into the DSCT to <<07114>>13310000
move contiguous active entries into the space previously  used <<07114>>13315000
by deleted entries.  The three indices are:                    <<07114>>13320000
   TO'ENTRY:       The destination of the active entries, cur- <<07114>>13325000
                   rently a deleted entry.                     <<07114>>13330000
   START'ENTRY:    Index of the  first  active  entry  in  the <<07114>>13335000
                   group.                                      <<07114>>13340000
   THIS'ENTRY:     Index of the first deleted entry beyond the <<07114>>13345000
                   group of active entries, also  the  overall <<07114>>13350000
                   DSCT scanning index.                        <<07114>>13355000
  Operation is as follows:  The three indices are  initialized <<07114>>13360000
to the first entry in the DSCT. The DSCT is then scanned until <<07114>>13365000
all active entries have been accounted for.  As it is scanned, <<07114>>13370000
each entry can be active or deleted.  An  active  entry  bumps <<07114>>13375000
THIS'ENTRY.  A deleted entry causes all entries between START' <<07114>>13380000
ENTRY and THIS'ENTRY to be moved to TO'ENTRY, then  the  other <<07114>>13385000
two indices are set to THIS'ENTRY.                             <<07114>>13390000
  There are three special cases:                               <<07114>>13395000
1.  TO'ENTRY = START'ENTRY when we find a deleted entry.  This <<07114>>13400000
    is the situation when the first DSCT entry is active.  Ob- <<07114>>13405000
    viously, no move is needed, so it is skipped.              <<07114>>13410000
2.  START'ENTRY = THIS'ENTRY when we  find  a  deleted  entry. <<07114>>13415000
    This  happens  for  contiguous deleted entries.  Again, no <<07114>>13420000
    move is needed.                                            <<07114>>13425000
3.  The last active entry is scanned. This is treated as if we <<07114>>13430000
    had found a deleted entry, that is,  any  needed  move  is <<07114>>13435000
    performed.                                                 <<07114>>13440000
;                                                              <<07114>>13445000
EQUATE                                                         <<07114>>13450000
   DELETED'ENTRY    = 0;                                       <<07114>>13455000
                                                               <<07114>>13460000
LOGICAL                                                        <<07114>>13465000
   ACTIVE'ENTRIES  := 0,                                       <<07114>>13470000
   DELETED'ENTRIES := 0,                                       <<07114>>13475000
   LIMIT,                                                      <<07114>>13480000
   START'ENTRY,                                                <<07114>>13485000
   THIS'ENTRY,                                                 <<07114>>13490000
   TO'ENTRY;                                                   <<07114>>13495000
                                                               <<07114>>13500000
                                                               <<07114>>13505000
SUBROUTINE MOVE'ENTRIES;                                       <<07114>>13510000
                                                               <<07114>>13515000
BEGIN COMMENT --                                               <<07114>>13520000
  MOVE'ENTRIES is actually a conditional move.  The  block  of <<07114>>13525000
DSCT  entries defined by START'ENTRY to THIS'ENTRY is moved to <<07114>>13530000
TO'ENTRY only if all three indices are different. See comments <<07114>>13535000
to the procedure for more details.                             <<07114>>13540000
;                                                              <<07114>>13545000
IF TO'ENTRY <> START'ENTRY THEN                                <<07114>>13550000
   IF START'ENTRY <> THIS'ENTRY THEN                           <<07114>>13555000
      BEGIN   << We need to move, then update TO'ENTRY.     >> <<07114>>13560000
      MOVE DSCT(TO'ENTRY) := DSCT(START'ENTRY),                <<07114>>13565000
           (THIS'ENTRY - START'ENTRY);                         <<07114>>13570000
      TO'ENTRY := TO'ENTRY + (THIS'ENTRY - START'ENTRY);       <<07114>>13575000
      END                                                      <<07114>>13580000
   ELSE   << Null ELSE.                                     >> <<07114>>13585000
ELSE      << No move, just update TO'ENTRY.                 >> <<07114>>13590000
   TO'ENTRY := THIS'ENTRY;                                     <<07114>>13595000
END;   << of MOVE'ENTRIES.                                  >> <<07114>>13600000
                                                               <<07114>>13605000
                                                               <<07114>>13610000
TO'ENTRY := START'ENTRY := THIS'ENTRY :=                       <<07114>>13615000
   DSCT(DSCT'FIRST'ENTRY'INDEX);                               <<07114>>13620000
WHILE ACTIVE'ENTRIES < DSCT(DSCT'NUMBER'OF'ENTRIES) DO         <<07114>>13625000
   BEGIN                                                       <<07114>>13630000
   IF ACTIVE'ENTRIES + DELETED'ENTRIES >                       <<07114>>13635000
         DSCT(DSCT'MAX'NUMBER'OF'ENTRIES) THEN                 <<07114>>13640000
      BEGIN                                                    <<07114>>13645000
      ERRORCODE := SDERR33;   << Corrupt DSCT.              >> <<07114>>13650000
      RETURN;                                                  <<07114>>13655000
      END;                                                     <<07114>>13660000
   IF DSCT(THIS'ENTRY) = DELETED'ENTRY AND                     <<07114>>13665000
      DSCT(X := X + 1)    = DELETED'ENTRY THEN                 <<07114>>13670000
      BEGIN   << I guess it quacks like a deleted entry!    >> <<07114>>13675000
      DELETED'ENTRIES := DELETED'ENTRIES + 1;                  <<07114>>13680000
      MOVE'ENTRIES;                                            <<07114>>13685000
      THIS'ENTRY := THIS'ENTRY + DSCT(DSCT'ENTRY'SIZE);        <<07114>>13690000
      START'ENTRY := THIS'ENTRY;                               <<07114>>13695000
      END     << Deleted entry.                             >> <<07114>>13700000
   ELSE                                                        <<07114>>13705000
      BEGIN   << Active entry.                              >> <<07114>>13710000
      ACTIVE'ENTRIES := ACTIVE'ENTRIES + 1;                    <<07114>>13715000
      THIS'ENTRY := THIS'ENTRY + DSCT(DSCT'ENTRY'SIZE);        <<07114>>13720000
      END;                                                     <<07114>>13725000
   END;         << WHILE loop.                              >> <<07114>>13730000
MOVE'ENTRIES;   << if need be.                              >> <<07114>>13735000
                                                               <<07114>>13740000
<< Zero out rest of table so it looks nice on dumps.        >> <<07114>>13745000
                                                               <<07114>>13750000
LIMIT := DSCT'MAX'ENTRIES & LSL(1) +                           <<07114>>13755000
         DSCT'OFFSET'TO'FIRST'INDEX;                           <<07114>>13760000
WHILE TO'ENTRY < LIMIT DO                                      <<07114>>13765000
   BEGIN                                                       <<07114>>13770000
   DSCT(TO'ENTRY) := 0;                                        <<07114>>13775000
   TO'ENTRY := TO'ENTRY + 1;                                   <<07114>>13780000
   END;                                                        <<07114>>13785000
END;            << of COMPACT'DSCT.                         >> <<07114>>13790000
$PAGE   "   *** Procedure SPARE'ONE'BLOCK ***"                 <<07114>>13795000
LOGICAL PROCEDURE SPARE'ONE'BLOCK (DSCT'INDEX);                <<07114>>13800000
   VALUE   DSCT'INDEX;                                         <<07114>>13805000
   INTEGER DSCT'INDEX;                                         <<07114>>13810000
   OPTION  PRIVILEGED, UNCALLABLE, INTERNAL;                   <<07114>>13815000
                                                               <<07114>>13820000
BEGIN COMMENT --                                               <<07114>>13825000
  SPARE'ONE'BLOCK executes the CS80 Spare  Block  function  on <<07114>>13830000
the  DSCT  single-vector sector address whose first word is at <<07114>>13835000
DSCT'INDEX.  The function has  many  options,  from  which  we <<07114>>13840000
choose not to retain any data since we have already determined <<07114>>13845000
there is nothing of value in the area we are sparing.          <<07114>>13850000
  The net effect is to reassign the sector  in  question.  The <<07114>>13855000
first  time  this happens, a spare sector on the same track is <<07114>>13860000
used and the physical sector addresses are manipulated to pre- <<07114>>13865000
serve rotationally serial access (analogous to skip sparing in <<07114>>13870000
the cartridge tape). The second time, the entire track must be <<07114>>13875000
reassigned.  This whole process, including the selection of an <<07114>>13880000
alternate track if necessary, is invisible to us.  We  do  not <<07114>>13885000
know whether we got a spare sector or a spare track, nor do we <<07114>>13890000
care.                                                          <<07114>>13895000
  If we succeed in sparing the target sector, we then set  the <<07114>>13900000
corresponding  DSCT  entry  to  0 and decrement the DSCT entry <<07114>>13905000
count.                                                         <<07114>>13910000
;                                                              <<07114>>13915000
EQUATE                                                         <<07114>>13920000
   NO'RETAIN'DATA = 1,   << P2 option.                      >> <<07114>>13925000
   SINGLE'VECTOR  = 0;   << P1 option.                      >> <<07114>>13930000
                                                               <<07114>>13935000
DOUBLE                                                         <<07114>>13940000
   DERR;                                                       <<07114>>13945000
                                                               <<07114>>13950000
LOGICAL                                                        <<07114>>13955000
   ERR1 = DERR;                                                <<07114>>13960000
                                                               <<07114>>13965000
LOGICAL ARRAY                                                  <<07114>>13970000
   ZEROS(0:DSCT'SIZE'OF'ENTRY-1) = PB := DSCT'SIZE'OF'ENTRY(0);<<07114>>13975000
                                                               <<07114>>13980000
DERR := ATACHIO (LDNUM, QMISC', DSTN, @DSCT(DSCT'INDEX),       <<07114>>13985000
                SPARE'BLOCK, 2, SINGLE'VECTOR, NO'RETAIN'DATA, <<07114>>13990000
                BLOCKED);                                      <<07114>>13995000
IF ATIOERR THEN                                                <<07114>>14000000
   SPARE'ONE'BLOCK := FALSE                                    <<07114>>14005000
ELSE                                                           <<07114>>14010000
   BEGIN   << Delete entry in table, reduce entry count.    >> <<07114>>14015000
   SPARE'ONE'BLOCK := TRUE;                                    <<07114>>14020000
   MOVE DSCT(DSCT'INDEX) := ZEROS, (DSCT(DSCT'ENTRY'SIZE));    <<07114>>14025000
   DSCT(DSCT'NUMBER'OF'ENTRIES) :=                             <<07114>>14030000
      DSCT(DSCT'NUMBER'OF'ENTRIES) - 1;                        <<07114>>14035000
   END;    << Delete entry in table, reduce entry count.    >> <<07114>>14040000
END;   << of SPARE'ONE'BLOCK.                               >> <<07114>>14045000
$PAGE   "   *** Procedure SPARE'CS80'BLOCKS ***"               <<07114>>14050000
PROCEDURE SPARE'CS80'BLOCKS;                                   <<07114>>14055000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>14060000
                                                               <<07114>>14065000
BEGIN COMMENT --                                               <<07114>>14070000
  SPARE'CS80'BLOCKS spares any CS80 disc  sectors/tracks  that <<07114>>14075000
have entries in the Defective Sector Table (DSCT), -IFF- those <<07114>>14080000
addresses are in tracks beyond our current starting write  ad- <<07114>>14085000
dress  (we  can't  guarantee  to preserve existing data in the <<07114>>14090000
current track if it is spared).  The DSCT  entries  of  spared <<07114>>14095000
blocks are then removed from the table, per DSCT rules.        <<07114>>14100000
  The DSCT is first checked for a valid format.  If the  check <<07114>>14105000
fails,  we  generate  a fatal error message and leave the disc <<07114>>14110000
unchanged.                                                     <<07114>>14115000
;                                                              <<07114>>14120000
DOUBLE                                                         <<07114>>14125000
   DERR,                                                       <<07114>>14130000
   DSCT'ADDR := DSCT'DISC'ADDRESS,                             <<07114>>14135000
   THIS'SECTOR;                                                <<07114>>14140000
                                                               <<07114>>14145000
INTEGER                                                        <<07114>>14150000
   DSCT'DISC'ADDR0 = DSCT'ADDR,                                <<07114>>14155000
   DSCT'DISC'ADDR1 = DSCT'ADDR + 1,                            <<07114>>14160000
   ERR1 = DERR;                                                <<07114>>14165000
                                                               <<07114>>14170000
LOGICAL                                                        <<07114>>14175000
   CURRENT'TRACK,                                              <<07114>>14180000
   DSCT'CHANGED := FALSE,                                      <<07114>>14185000
   ENTRY'COUNT,                                                <<07114>>14190000
   NUM'DSCT'ENTRIES,   << Needed because DSCT copy changes. >> <<07114>>14195000
   THIS'ENTRY;                                                 <<07114>>14200000
                                                               <<07114>>14205000
DOUBLE POINTER                                                 <<07114>>14210000
   DB'AREA'D;                                                  <<07114>>14215000
                                                               <<07114>>14220000
LOGICAL POINTER                                                <<07114>>14225000
   DB'AREA = DB'AREA'D;                                        <<07114>>14230000
                                                               <<07114>>14235000
DEFINE                                                         <<07114>>14240000
   THIS'TRACK = THIS'SECTOR // LOGICAL (SECTORSPERTRAK) #;     <<07114>>14245000
                                                               <<07114>>14250000
                                                               <<07114>>14255000
LOGICAL SUBROUTINE VALID'DSCT;                                 <<07114>>14260000
                                                               <<07114>>14265000
BEGIN                                                          <<07114>>14270000
VALID'DSCT := FALSE;   << until proved otherwise.           >> <<07114>>14275000
IF DSCT(DSCT'MAX'NUMBER'OF'ENTRIES) <> DSCT'MAX'ENTRIES THEN   <<07114>>14280000
   RETURN;                                                     <<07114>>14285000
IF DSCT(DSCT'FIRST'ENTRY'INDEX) <> DSCT'OFFSET'TO'FIRST'ENTRY  <<07114>>14290000
   THEN RETURN;                                                <<07114>>14295000
IF DSCT(DSCT'ENTRY'SIZE) <> DSCT'SIZE'OF'ENTRY THEN RETURN;    <<07114>>14300000
IF DSCT(DSCT'NUMBER'OF'ENTRIES) <= DSCT'MAX'ENTRIES THEN       <<07114>>14305000
   VALID'DSCT := TRUE;                                         <<07114>>14310000
END;  << of subroutine VALID'DSCT.                          >> <<07114>>14315000
                                                               <<07114>>14320000
                                                               <<07114>>14325000
@DB'AREA := @DSCT(WORDSPERSECTR);                              <<07114>>14330000
IF VALID'DSCT THEN                                             <<07114>>14335000
   IF DSCT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN                    <<07114>>14340000
      BEGIN   << Some work to do.                           >> <<07114>>14345000
      ENTRY'COUNT := 0;                                        <<07114>>14350000
      NUM'DSCT'ENTRIES := DSCT(DSCT'NUMBER'OF'ENTRIES);        <<07114>>14355000
      CURRENT'TRACK := (RECBUFFSA + DOUBLE ((CURRENTBUFINDEX + <<07114>>14360000
         WORDSPERSECTR - 1) / WORDSPERSECTR)) //               <<07114>>14365000
         LOGICAL (SECTORSPERTRAK);                             <<07114>>14370000
      THIS'ENTRY := DSCT(DSCT'FIRST'ENTRY'INDEX);              <<07114>>14375000
      DO BEGIN   << Search through all entries.             >> <<07114>>14380000
                                                               <<07114>>14385000
<< The MOVE statement below cannot use a Q-relative  target >> <<07114>>14390000
<< address  because  SDISC runs in split-stack mode.  So we >> <<07114>>14395000
<< invent a DB target and go from there.                    >> <<07114>>14400000
                                                               <<07114>>14405000
         MOVE DB'AREA := DSCT(THIS'ENTRY),                     <<07114>>14410000
                         (DSCT(DSCT'ENTRY'SIZE));              <<07114>>14415000
         THIS'SECTOR := DB'AREA'D;                             <<07114>>14420000
         IF THIS'TRACK > CURRENT'TRACK THEN                    <<07114>>14425000
            BEGIN   << Only clobber tracks with no data.    >> <<07114>>14430000
            IF SPARE'ONE'BLOCK (THIS'ENTRY) THEN               <<07114>>14435000
               DSCT'CHANGED := TRUE   << This one worked.   >> <<07114>>14440000
            ELSE                                               <<07114>>14445000
               BEGIN   << No it didn't.                     >> <<07114>>14450000
               ERRORCODE := SDERR12;                           <<07114>>14455000
               ENTRY'COUNT := NUM'DSCT'ENTRIES;  <<Stop loop>> <<07114>>14460000
               END;    << No it didn't.                     >> <<07114>>14465000
            END;       << Only clobber tracks with no data. >> <<07114>>14470000
         ENTRY'COUNT := ENTRY'COUNT + 1;                       <<07114>>14475000
         THIS'ENTRY := THIS'ENTRY + DSCT(DSCT'ENTRY'SIZE);     <<07114>>14480000
         END           << Search through all entries.       >> <<07114>>14485000
        UNTIL ENTRY'COUNT >= NUM'DSCT'ENTRIES;                 <<07114>>14490000
      IF DSCT'CHANGED THEN                                     <<07114>>14495000
         BEGIN   << Post changed DSCT back to disc.         >> <<07114>>14500000
         IF DSCT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN              <<07114>>14505000
            BEGIN  << Must compact remaining entries first. >> <<07114>>14510000
            COMPACT'DSCT;                                      <<07114>>14515000
            IF SDERR THEN RETURN;                              <<07114>>14520000
            END;                                               <<07114>>14525000
         DERR := ATACHIO (LDNUM, QMISC', DSTN, @DSCT, WRITE,   <<07114>>14530000
                 DEFAULT'SECTOR'SIZE, DSCT'DISC'ADDR0,         <<07114>>14535000
                 DSCT'DISC'ADDR1, BLOCKED);                    <<07114>>14540000
         IF ATIOERR THEN ERRORCODE := SDERR8;                  <<07114>>14545000
         END;   << Post changed DSCT back to disc.          >> <<07114>>14550000
      END       << Some work to do.                         >> <<07114>>14555000
   ELSE         << Null ELSE.                               >> <<07114>>14560000
ELSE                                                           <<07114>>14565000
   ERRORCODE := SDERR33;   << Corrupt DSCT.                 >> <<07114>>14570000
END;         << of SPARE'CS80'BLOCKS.                       >> <<07114>>14575000
$PAGE   "   *** Procedure REASSIGN'FLAGGED'TRACKS ***"         <<07114>>14580000
PROCEDURE REASSIGN'FLAGGED'TRACKS;                             <<07114>>14585000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>14590000
                                                               <<07114>>14595000
BEGIN COMMENT --                                               <<07114>>14600000
  REASSIGN'FLAGGED'TRACKS is the entry to a  group  of  proce- <<07114>>14605000
dures  designed  to  eliminate  the serial disc "hole" and its <<07114>>14610000
corresponding entry in the Gap Table.  Overall design concepts <<07114>>14615000
can be found in the IMS section in the front of this  listing. <<07114>>14620000
This procedure is called from the CLEAR'TO'END functional pro- <<07114>>14625000
cessor of GPTMOD, which in turn is called  whenever  the  user <<07114>>14630000
writes  (data  or  EOF)  and  the previous operation was not a <<07114>>14635000
write (that is, whenever the user calls for a write  operation <<07114>>14640000
and TAPEWRITTEN is FALSE).                                     <<07114>>14645000
  REASSIGN'FLAGGED'TRACKS examines the defective  track  table <<07114>>14650000
(13037-family  discs)  or  the  defective  sector  table (CS80 <<07114>>14655000
discs) for entries beyond our current track address for  writ- <<07114>>14660000
ing (that is, areas which we may write into but which current- <<07114>>14665000
ly contain no data). It then performs the REASSIGN function of <<07114>>14670000
VINIT or INITIAL on those entries.  For CS80 discs, we perform <<07114>>14675000
a SPARE BLOCK and then erase the DSCT  table  entry.  For  the <<07114>>14680000
13037  family,  we reassign all suspect, alternate suspect, or <<07114>>14685000
deleted tracks in our area of interest,  and  update  the  DTT <<07114>>14690000
appropriately.                                                 <<07114>>14695000
  The idea behind all of this  is  to  minimize  media-related <<07114>>14700000
ATTACHIO  write  errors which used to generate holes or other- <<07114>>14705000
wise cause us grief.  At the same time, we eliminate the  con- <<07114>>14710000
cept  of  the hole entry in the Gap Table, which will increase <<07114>>14715000
our Gap Table search speed when reading.                       <<07114>>14720000
  Floppy discs have no alternate track mechanism, so they  are <<07114>>14725000
filtered  out at the beginning.  Similarly, the cartridge tape <<07114>>14730000
has its own (automatic) spare block generation  when  writing, <<07114>>14735000
so we need not do anything here.                               <<07114>>14740000
  Errors are returned through the existing SDERR mechanism.    <<07114>>14745000
;                                                              <<07114>>14750000
EQUATE                                                         <<07114>>14755000
   THREE'VECTOR = 1;   << P1 to retn disc size in C/H/S fmt >> <<07114>>14760000
                                                               <<07114>>14765000
DOUBLE                                                         <<07114>>14770000
   DERR,                                                       <<07114>>14775000
   DSCT'ADDR := DSCT'DISC'ADDRESS;                             <<07114>>14780000
                                                               <<07114>>14785000
INTEGER                                                        <<07114>>14790000
   DSCT'DISC'ADDR0 = DSCT'ADDR,                                <<07114>>14795000
   DSCT'DISC'ADDR1 = DSCT'ADDR + 1,                            <<07114>>14800000
   ERR1            = DERR;                                     <<07114>>14805000
                                                               <<07114>>14810000
IF TYPE = FLOPPY'DISC THEN RETURN;   << No alternate tracks >> <<07114>>14815000
IF CARTRIDGE'TAPE THEN RETURN;   << Reassigned when writing >> <<07114>>14820000
IF TYPE = CS80 THEN                                            <<07114>>14825000
   BEGIN                                                       <<07114>>14830000
   IF SECTORSPERTRAK = -1 THEN                                 <<07114>>14835000
      BEGIN   << SERIALized with old VINIT, get actual SPT. >> <<07114>>14840000
      READ'DISC'LABEL;   << So we can update it.            >> <<07114>>14845000
      IF SDERR THEN RETURN;                                    <<07114>>14850000
                                                               <<07114>>14855000
<< This call, valid only for CS80 discs, returns the  maxi- >> <<07114>>14860000
<< mum  physical  disc address in three-vector format using >> <<07114>>14865000
<< two words.  The first word has the largest cylinder  ad- >> <<07114>>14870000
<< dress,  while the second holds the largest head (upper 8 >> <<07114>>14875000
<< bits and sector (lower 8 bits) addresses. We're only in- >> <<07114>>14880000
<< terested in the sector address, which presumably is  one >> <<07114>>14885000
<< less than the number of sectors per track.               >> <<07114>>14890000
                                                               <<07114>>14895000
      DERR := ATACHIO (LDNUM, QMISC', DSTN,                    <<07114>>14900000
              @WORKTABLE(WORDSPERSECTR), REQ'VOLUME'LIMIT, 2,  <<07114>>14905000
              THREE'VECTOR, 0, BLOCKED);                       <<07114>>14910000
      IF ATIOERR THEN                                          <<07114>>14915000
         BEGIN                                                 <<07114>>14920000
         ERRORCODE := SDERR12;                                 <<07114>>14925000
         RETURN;                                               <<07114>>14930000
         END;                                                  <<07114>>14935000
      SECTORSPERTRAK := WORKTABLE(WORDSPERSECTR+1).(8:8) + 1;  <<07114>>14940000
      WORKTABLE(VLAB'SPT) := SECTORSPERTRAK;                   <<07114>>14945000
      WRITE'DISC'LABEL;                                        <<07114>>14950000
      IF SDERR THEN RETURN;                                    <<07114>>14955000
      END;    << SERIALized with old VINIT, get actual SPT. >> <<07114>>14960000
   END;       << Type = CS80.                               >> <<07114>>14965000
DERR := ATACHIO (LDNUM, QMISC', DSTN, @DSCT, READ,             <<07114>>14970000
        WORDSPERSECTR, DSCT'DISC'ADDR0, DSCT'DISC'ADDR1,       <<07114>>14975000
        BLOCKED);                                              <<07114>>14980000
IF ATIOERR THEN                                                <<07114>>14985000
   BEGIN                                                       <<07114>>14990000
   ERRORCODE := SDERR6;   << Error reading DTT/DSCT.        >> <<07114>>14995000
   RETURN;                                                     <<07114>>15000000
   END;                                                        <<07114>>15005000
IF TYPE = CS80 THEN                                            <<07114>>15010000
   SPARE'CS80'BLOCKS                                           <<07114>>15015000
ELSE REASSIGN'792X'TRACKS;                                     <<07114>>15020000
END;   << of REASSIGN'FLAGGED'TRACKS.                       >> <<07114>>15025000
$PAGE " *** Procedure UPDATE'SDISC'VERSION ***"                <<07114>>15030000
PROCEDURE UPDATE'SDISC'VERSION;                                <<07114>>15035000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>15040000
                                                               <<07114>>15045000
BEGIN COMMENT --                                               <<07114>>15050000
  This procedure puts the current version I.D. of  SDISC  into <<07114>>15055000
the  disc's volume label.  It uses the special Write Label AT- <<07114>>15060000
TACHIO function code.                                          <<07114>>15065000
;                                                              <<07114>>15070000
EQUATE                                                         <<07114>>15075000
   CURRENT'VERSION = "0";                                      <<07114>>15080000
                                                               <<07114>>15085000
DOUBLE                                                         <<07114>>15090000
   DERR;                                                       <<07114>>15095000
                                                               <<07114>>15100000
INTEGER                                                        <<07114>>15105000
   ERR1 = DERR;                                                <<07114>>15110000
                                                               <<07114>>15115000
IF SDISC'VERSION <> CURRENT'VERSION THEN                       <<07114>>15120000
   BEGIN                                                       <<07114>>15125000
   READ'DISC'LABEL;                                            <<07114>>15130000
   IF SDERR THEN RETURN;                                       <<07114>>15135000
   WORKTABLE(VLAB'SDISC'VERSION).(8:8) := CURRENT'VERSION;     <<07114>>15140000
   WRITE'DISC'LABEL;                                           <<07114>>15145000
   IF SDERR THEN RETURN;                                       <<07114>>15150000
   SDISC'VERSION := CURRENT'VERSION;                           <<07114>>15155000
   END;                                                        <<07114>>15160000
END;   << of UPDATE'SDISC'VERSION.                          >> <<07114>>15165000
$PAGE " *** Procedure GPTMOD *** "                             <<07114>>15170000
  PROCEDURE GPTMOD(CONTROLCODE,S1,S2);                         <<07114>>15175000
    VALUE CONTROLCODE,S1,S2;                                   <<07114>>15180000
    INTEGER CONTROLCODE;                                       <<07114>>15185000
    DOUBLE S1,S2;                                              <<07114>>15190000
    OPTION VARIABLE, PRIVILEGED, UNCALLABLE, INTERNAL;         <<07114>>15195000
                                                               <<07114>>15200000
COMMENT:                                                                15205000
  PURPOSE-TO MANAGE THE GAP TABLE.                                      15210000
  CONTROLCODES-                                                         15215000
 -N.RETURN STARTSECTOR AND SECTORLENGTH OF CONTIG BLOCK #N     <<00189>>15220000
    RETURN -1D FOR BOTH IF CONTIG BLOCK #N DOESN'T EXIST       <<00189>>15225000
  0.Write EOT mark.  Used only with floppy discs.              <<04249>>15230000
  1.INITIALIZE GPT TO "VIRGIN TAPE" STATE                               15235000
  2.Read label sector and Gap Table of new volume,             <<03733>>15240000
      configure SDISC from label sector parameters.            <<03733>>15245000
  3.WRITE EODMARK AND CLOSE GPT TO DISC                                 15250000
  4.WRITE EOFMARK                                                       15255000
  5.Obsolete (was Make Hole Entry).                            <<07114>>15260000
  6.Make a contiguous block entry.                             <<04249>>15265000
  7.Obsolete (was End Contiguous Block).                       <<04249>>15270000
  8.UPDATE GPT TO REFLECT A RELOCATED BLOCK                             15275000
  9.UPDATE CURRENTGPT POINTERS FOR READ OPERATIONS                      15280000
 10.CLEAR GAP TABLE OF ENTRIES WHOSE ADDRESSES ARE                      15285000
      GREATER THAN ACTUAL'ADDRESS.                                      15290000
END OF COMMENT;                                                         15295000
<<**************************************>>                              15300000
<<                                      >>                              15305000
<<CONTROLCODE= -N                       >>                              15310000
<<RETURN VALUES:                        >>                              15315000
<<                                      >>                              15320000
<<VALUES ARE PASSED THROUGH GLOBAL CELLS>>                              15325000
<<BECAUSE SDISC OPERATES IN SPLIT STACK >>                              15330000
<<AT ALL TIMES, MAKING REFERENCE PARMS  >>                              15335000
<<AN IMPOSSIBILITY.                     >>                              15340000
<<                                      >>                              15345000
<<RTV1- (DOUBLE) -DISC ADDRESS OF START >>                              15350000
<<               -OF CONTIGUOUS BLOCK   >>                              15355000
<<               -REQUESTED             >>                              15360000
<<RTV2- (DOUBLE) -LENGTH OF CONTIGUOUS  >>                              15365000
<<               -BLOCK REQUESTED       >>                              15370000
<<                                      >>                              15375000
<<**************************************>>                              15380000
                                                                        15385000
  BEGIN <<GPTMOD>>                                                      15390000
  INTEGER PARMS=Q-4;                                                    15395000
  DOUBLE DERR,S3;                                                       15400000
  INTEGER ERR1=DERR,BLOCKNUMBER,BLOCK,I;                       <<03522>>15405000
  INTEGER ADR1=S1,                                                      15410000
          ADR2=S1+1,                                                    15415000
          ADR3=S2,                                                      15420000
          ADR4=S2+1,                                                    15425000
          ADR5=S3,                                                      15430000
          ADR6=S3+1;                                                    15435000
  LOGICAL FOUNDBLOCK:=FALSE;                                            15440000
                                                               <<07114>>15445000
  SUBROUTINE DEF'MOVEDSEG;                                     <<07114>>15450000
                                                                        15455000
IF PARMS.(13:1) = 0 THEN GO TO MISSING'PARM;   << No CCODE. >> <<03522>>15460000
  BLOCKNUMBER:=0;                                                       15465000
  IF CONTROLCODE < 0 THEN                                               15470000
    BEGIN <<SET UP TO FIND CONTIG BLOCK# -CONTROLCODE>>                 15475000
    BLOCKNUMBER:=-CONTROLCODE;                                          15480000
    BLOCK:=0;                                                           15485000
    STARTBLOCK:=-1D;                                           <<00189>>15490000
    BLOCKLENGTH:=-1D;                                          <<00189>>15495000
    CONTROLCODE := FIND'CONTIG'BLOCK'N;                        <<03522>>15500000
    END;  <<SET UP TO FIND CONTIG BLOCK# -CONTROLCODE>>                 15505000
  CASE CONTROLCODE OF                                                   15510000
    BEGIN <<CASE STATEMENT>>                                            15515000
                                                               <<07114>>15520000
<< *-*-* 0 -- Write EOT mark, floppy disc only.       *-*-* >> <<07114>>15525000
                                                                        15530000
      BEGIN   << 0 -- Write EOT mark, floppy disc only.     >> <<04249>>15535000
      IF PARMS.(14:1) = 0 THEN GO TO MISSING'PARM;             <<04249>>15540000
      IF NOT ADD'GPT'ENTRY (EOTTYPE, ADR1, ADR2) THEN          <<04249>>15545000
         GO TO GPT'OVERFLOW;                                   <<04249>>15550000
      END;    << 0 -- Write EOT mark, floppy disc only.     >> <<04249>>15555000
                                                               <<07114>>15560000
<< *-*-* 1 -- Initialize GPT to "virgin tape" state.  *-*-* >> <<07114>>15565000
                                                                        15570000
      BEGIN   << 1 -- Initialize GPT to "virgin tape" state. >>         15575000
      GPT:=-1;                                                          15580000
      MOVE GPT(1) := GPT, (GPTLEN);                            <<03522>>15585000
      GPT := STARTADDRESS;                                     <<03522>>15590000
      CURRENTGPTENT:=GPT'START;                                <<00189>>15595000
                                                               <<03535>>15600000
<< Lay down an end-of-data entry at load point  to  prevent >> <<03535>>15605000
<< trying to read a brand new disc or cartridge.            >> <<03535>>15610000
                                                               <<03535>>15615000
      GPTMOD (WRITE'EOD'AND'POST, DOUBLE (STARTADDRESS));      <<03535>>15620000
      IF SDERR THEN RETURN;                                    <<07114>>15625000
      CURRENTGPTENT := GPT'START;                              <<03558>>15630000
      TAPEREWOUND:=FALSE; <<GPT IS RESET-READY TO WRITE>>               15635000
      IF WRITERING THEN UPDATE'SDISC'VERSION;                  <<07114>>15640000
      END;    << 1 -- Initialize GPT to "virgin tape" state. >>         15645000
                                                               <<07114>>15650000
<< *-*-* 2 -- Get data buffers, read 1st GPT block.   *-*-* >> <<07114>>15655000
                                                                        15660000
      BEGIN   << 2 -- Read first block of GPT from device.  >>          15665000
                                                               <<03522>>15670000
      @WORKTABLE := @XMITLOG + 1;                              <<03522>>15675000
      READ'DISC'LABEL;                                         <<07114>>15680000
      IF SDERR THEN RETURN;                                    <<07114>>15685000
      WORDSPERSECTR:=WORKTABLE(VLAB'WPS);                               15690000
      SECTORSPERTRAK:=WORKTABLE(VLAB'SPT);                              15695000
      STARTADDRESS:=WORKTABLE(VLAB'SA);                                 15700000
      SUBTYPE := WORKTABLE (VLAB'TYPE'SUBTYPE).SUBTYPE'FIELD;  <<03522>>15705000
      TYPE    := WORKTABLE (VLAB'TYPE'SUBTYPE).TYPE'FIELD;     <<03522>>15710000
      SDISC'VERSION := WORKTABLE (VLAB'SDISC'VERSION).(8:8);   <<07114>>15715000
      EOTSECTR0:=WORKTABLE(VLAB'EOT);                                   15720000
      EOTSECTR1:=WORKTABLE(X:=X+1);                                     15725000
      EODSECTR0:=WORKTABLE(VLAB'EOD);                                   15730000
      EODSECTR1:=WORKTABLE(X:=X+1);                                     15735000
      IF NOT BUFFERS'ALLOCATED THEN                            <<07114>>15740000
         BEGIN   << Allocate buffers and set secondary DB.  >> <<07114>>15745000
         IF SDERR THEN RETURN;  << BUFFERS'ALLOCATED failed >> <<07114>>15750000
         @BUFFER'INFO := @WORKTABLE + MAX'SECTOR'SIZE;         <<07114>>15755000
         @GPT := @BUFFER'INFO + BUFFER'INFO'SIZE;              <<07114>>15760000
         BUFFER'INFO := 0;                                     <<07114>>15765000
         MOVE BUFFER'INFO(1) := BUFFER'INFO,                   <<07114>>15770000
              (BUFFER'INFO'SIZE - 1);                          <<07114>>15775000
         ALLOCATE'BUFFERS;                                     <<07114>>15780000
         IF SDERR THEN RETURN;   << LDTX error or no space. >> <<07114>>15785000
         END;    << Allocate buffers and set secondary DB.  >> <<07114>>15790000
      GPTLEN := (STARTADDRESS - GPTBASESECTOR) * WORDSPERSECTR;<<03522>>15795000
                                                               <<03522>>15800000
<< See if we have room for the Gap Table.                   >> <<03522>>15805000
                                                               <<03522>>15810000
      IF INTEGER (MAX'DSEG'SIZE) - @GPT < GPTLEN THEN          <<03522>>15815000
         BEGIN   << Gap Table doesn't fit, can't continue.  >> <<03522>>15820000
         ERRORCODE := SDERR36;                                 <<07114>>15825000
         RETURN;                                               <<03522>>15830000
         END;                                                  <<03522>>15835000
                                                               <<03522>>15840000
<< Now read in the Gap Table.                               >> <<03522>>15845000
                                                               <<03522>>15850000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @GPT, READ,        <<03522>>15855000
              GPTLEN, 0, GPTBASESECTOR, BLOCKED);              <<07114>>15860000
      IF ATIOERR THEN                                          <<00189>>15865000
         BEGIN                                                 <<00189>>15870000
         ERRORCODE := SDERR13;                                 <<07114>>15875000
         RETURN;                                               <<00189>>15880000
         END;                                                  <<00189>>15885000
      CURRENTGPTENT:=GPT'START;                                <<00189>>15890000
      IF INTEGER(GPT.GPT'ADR'FIELD)<>STARTADDRESS THEN                  15895000
        BEGIN <<VIRGIN TAPE>>                                           15900000
        GPTMOD (BRAND'NEW'TAPE);                               <<03522>>15905000
        IF SDERR THEN RETURN;                                           15910000
        END;  <<VIRGIN TAPE>>                                           15915000
      RECBUFFSA:=DOUBLE(STARTADDRESS);                         <<00494>>15920000
      RECBUFFEA:=-1D;                                                   15925000
      NEXTRECINBUF:=FALSE;                                     <<00494>>15930000
      TAPEREWOUND:=FALSE;                                               15935000
      END;    << 2 -- Read first block of GPT from device.  >>          15940000
                                                               <<07114>>15945000
<< *-*-* 3 -- Write End-of-Data and flush Gap Table.  *-*-* >> <<07114>>15950000
                                                                        15955000
      BEGIN   << 3 -- Write End-of-Data and flush GPT.      >>          15960000
      IF PARMS.(14:1)=0 THEN                                            15965000
         BEGIN                                                          15970000
MISSING'PARM:                                                  <<03522>>15975000
         ERRORCODE := SDERR43;                                 <<07114>>15980000
         RETURN;                                                        15985000
         END;                                                           15990000
      IF NOT ADD'GPT'ENTRY (EODTYPE, ADR1, ADR2) THEN          <<03522>>15995000
         BEGIN   << Overflowed Gap Table, gotta stop.       >> <<03522>>16000000
GPT'OVERFLOW:                                                  <<03522>>16005000
         ERRORCODE := SDERR18;                                 <<07114>>16010000
         RETURN;                                               <<03522>>16015000
         END;                                                  <<03522>>16020000
                                                               <<04742>>16025000
<< We need a "write ring" check here  because  we  can  get >> <<04742>>16030000
<< here  trying  to write an EOD entry at load point of the >> <<04742>>16035000
<< disc copy of the Gap Table if this is the first  use  of >> <<04742>>16040000
<< the  disc  since  being  >SERIALized with VINIT.  If the >> <<04742>>16045000
<< operator did not allow writing in the  :REPLY,  we  omit >> <<04742>>16050000
<< updating  the disc.  The copy of the Gap Table in memory >> <<04742>>16055000
<< (in the XDS) is enough for read-only accesses. All other >> <<04742>>16060000
<< procedures using this code have already checked for  the >> <<04742>>16065000
<< existence of a "write ring".                             >> <<04742>>16070000
                                                               <<04742>>16075000
      IF WRITERING                                             <<04742>>16080000
         THEN DERR := ATACHIO (LDNUM, QMISC', DSTN, @GPT,      <<04742>>16085000
                      WRITE, GPTLEN, 0, GPTBASESECTOR, BLOCKED)<<07114>>16090000
         ELSE DERR := NO'ATIOERROR;                            <<04742>>16095000
      IF ATIOERR THEN                                                   16100000
        BEGIN <<ATTACHIO WRITE ERROR>>                                  16105000
        ERRORCODE := SDERR15;                                  <<07114>>16110000
        RETURN;                                                         16115000
        END;  <<ATTACHIO WRITE ERROR>>                                  16120000
      END;    << 3 -- Write End-of-Data and flush GPT.      >>          16125000
                                                               <<07114>>16130000
<< *-*-* 4 -- Write End-of-File entry.                *-*-* >> <<07114>>16135000
                                                                        16140000
      BEGIN   << 4 -- Write EOF. >>                                     16145000
      IF PARMS.(14:1) = 0 THEN GO TO MISSING'PARM;             <<03522>>16150000
      IF NOT ADD'GPT'ENTRY (EOFTYPE, ADR1, ADR2) THEN          <<03522>>16155000
         BEGIN   << This EOF overflows Gap Table.           >> <<03522>>16160000
         ERRORCODE := SDERR19;                                 <<07114>>16165000
         RETURN;                                               <<03522>>16170000
         END;                                                  <<03522>>16175000
      END;    << 4 -- Write EOF. >>                                     16180000
                                                               <<07114>>16185000
      ;       << 5 -- Obsolete.  Was Make Hole Entry.       >> <<07114>>16190000
                                                               <<07114>>16195000
<< *-*-* 6 -- Make a contiguous block entry.          *-*-* >> <<07114>>16200000
                                                                        16205000
      BEGIN   << 6 -- Make a contiguous block entry.        >> <<04249>>16210000
      IF PARMS.(14:2) <> 3 THEN GO TO MISSING'PARM;            <<04249>>16215000
      IF NOT ADD'GPT'ENTRY (BOBTYPE, ADR1, ADR2) THEN          <<03522>>16220000
         GO TO GPT'OVERFLOW;                                   <<03522>>16225000
      IF NOT ADD'GPT'ENTRY (EOBTYPE, ADR3, ADR4) THEN          <<04249>>16230000
         GO TO GPT'OVERFLOW;                                   <<03522>>16235000
      END;    << 6 -- Make a contiguous block entry.        >> <<04249>>16240000
                                                               <<04249>>16245000
      ;       << 7 -- Obsolete.  Was End Contiguous Block.  >> <<04249>>16250000
                                                               <<07114>>16255000
<< *-*-* 8 -- Find contiguous block BLOCKNUMBER.      *-*-* >> <<07114>>16260000
                                                                        16265000
      BEGIN   << 8 -- Find contiguous block BLOCKNUMBER.    >> <<07114>>16270000
      IF BLOCKNUMBER = 0 OR PARMS.(14:1) = 0 THEN              <<07114>>16275000
        GO TO MISSING'PARM;                                    <<03522>>16280000
      I := GPT'START;                                          <<00189>>16285000
      DO                                                                16290000
        BEGIN   << Scan every entry.                        >> <<00189>>16295000
        ADR5 := GPT(I).GPT'ADR'FIELD;                                   16300000
        ADR6 := GPT(I+1);                                               16305000
        IF BLOCKNUMBER <> 0 THEN                                        16310000
          BEGIN   << Find addr of contig block BLOCKNUMBER. >>          16315000
          IF GPT(I).GPT'TYPE'FIELD = BOBTYPE THEN                       16320000
            BEGIN   << Found a contig block -- right one?   >>          16325000
            BLOCK := BLOCK+1;                                           16330000
            IF BLOCK = BLOCKNUMBER THEN                                 16335000
              BEGIN   << Yep, that's ours.                  >>          16340000
              STARTBLOCK := S3;                                         16345000
              FOUNDBLOCK := TRUE;                                       16350000
              END;                                                      16355000
            END;    << Found a contig block -- right one?   >>          16360000
          IF GPT(I).GPT'TYPE'FIELD = EOBTYPE THEN                       16365000
            IF FOUNDBLOCK THEN                                          16370000
              BEGIN   << Found end of block.                >>          16375000
              FOUNDBLOCK := FALSE;                                      16380000
              BLOCKLENGTH := S3 - STARTBLOCK + 1D;                      16385000
              END;                                                      16390000
          END;    << Find addr of contig block BLOCKNUMBER. >> <<07114>>16395000
        END     << Scan every entry.                        >> <<00189>>16400000
       UNTIL (I:=I+GPTENTSIZE) >= GPTLEN                       <<03522>>16405000
        OR GPT(I).GPT'TYPE'FIELD = ENDOFTABLETYPE;             <<00189>>16410000
      END;    << 8 -- Find contiguous block BLOCKNUMBER.    >> <<07114>>16415000
                                                               <<07114>>16420000
<< *-*-* 9 -- Update CURRENTGPT pointers for read op. *-*-* >> <<07114>>16425000
                                                                        16430000
      BEGIN   << 9 -- Update CURRENTGPT pointers for read op>>          16435000
      CURRENTGPTENT:=ENDINDEX;                                 <<00189>>16440000
      IF CURRENTGPTENT >= GPTLEN THEN                          <<03522>>16445000
         BEGIN                                                          16450000
         ERRORCODE := SDERR28;                                 <<07114>>16455000
         RETURN;                                               <<00189>>16460000
         END;                                                           16465000
      END;    << 9 -- Update CURRENTGPT pointers for read op>>          16470000
                                                               <<07114>>16475000
<< *-*-* 10 -- Clear GPT from ACTUAL'ADDRESS to end.  *-*-* >> <<07114>>16480000
                                                                        16485000
      BEGIN   << 10 -- Clear GPT from ACTUAL'ADDRESS to end >> <<03522>>16490000
                                                               <<03522>>16495000
COMMENT:  When you write on a mag tape, any information beyond <<03522>>16500000
your current location is lost.  This section,  called  by  the <<03522>>16505000
write  (RITESDISC) and write end-of-file (CTRLSDISC, FUNC = 6) <<03522>>16510000
routines if the previous operation was not one of  the  above, <<03522>>16515000
"erases"  any Gap Table information pertaining to areas beyond <<03522>>16520000
the current sector. Since CURRENTADR does not reflect any con- <<03522>>16525000
tiguous blocks or holes ("gaps") within the scope  of  RECBUFF <<03522>>16530000
when  we  are not writing, ACTUAL'ADDRESS is called to give us <<03522>>16535000
the real starting address to clear from.                       <<03522>>16540000
  When writing we assume that CURRENTADR always  represents  a <<03522>>16545000
valid  address, since any contiguous blocks ARE in RECBUFF and <<03522>>16550000
holes are posted to disc as they are generated. To assure that <<03522>>16555000
CURRENTADR is valid as we start to write, we move the contents <<03522>>16560000
of the current sector to the beginning of RECBUFF  and  update <<03522>>16565000
CURRENTBUFINDEX appropriately.                                 <<03522>>16570000
;                                                              <<03522>>16575000
      S1 := ACTUAL'ADDRESS;                                    <<03522>>16580000
      CURRENTGPTENT:=GPT'START-GPTENTSIZE;                              16585000
      DO                                                                16590000
        BEGIN                                                           16595000
        CURRENTGPTENT:=CURRENTGPTENT+GPTENTSIZE;                        16600000
        ADR5:=GPT(CURRENTGPTENT).GPT'ADR'FIELD;                         16605000
        ADR6:=GPT(X:=X+1);                                              16610000
        END                                                             16615000
       UNTIL S3 >= S1 OR CURRENTGPTENT >= GPTLEN;              <<03522>>16620000
      IF CURRENTGPTENT < GPTLEN THEN                           <<03522>>16625000
        BEGIN   << There is some Gap Table to clear.        >> <<03522>>16630000
        GPT(CURRENTGPTENT) := -1;                                       16635000
        MOVE GPT(CURRENTGPTENT+1) := GPT(CURRENTGPTENT),                16640000
          (GPTLEN - CURRENTGPTENT);                                     16645000
        END;    << There is some Gap Table to clear.        >> <<03522>>16650000
      MOVEDSEG (DATABUF'DST, 0, DATABUF'DST,                   <<07114>>16655000
                CURRENTBUFINDEX/WORDSPERSECTR*WORDSPERSECTR,   <<07114>>16660000
                CURRENTBUFINDEX MOD WORDSPERSECTR);            <<07114>>16665000
      CURRENTBUFINDEX := CURRENTBUFINDEX MOD WORDSPERSECTR;    <<03522>>16670000
      RECBUFFSA := DATABUFD'SA := S1;                          <<07114>>16675000
      RECBUFFEA := -1D;                                        <<03522>>16680000
      REASSIGN'FLAGGED'TRACKS;                                 <<07114>>16685000
      END;    << 10 -- Clear GPT from ACTUAL'ADDRESS to end >>          16690000
                                                                        16695000
    END;  <<CASE STATEMENT>>                                            16700000
  END;  <<GPTMOD>>                                                      16705000
$PAGE " *** Procedure CHECK'FOR'EOT *** "                      <<07114>>16710000
PROCEDURE CHECK'FOR'EOT;                                       <<03522>>16715000
  OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                     <<06745>>16720000
                                                               <<03522>>16725000
BEGIN                                                          <<03522>>16730000
  COMMENT -- CHECK'FOR'EOT is  responsible  for  managing  the <<03522>>16735000
EOTSENSOR flag. It should be called at the end of all routines <<03522>>16740000
which result in relative logical tape motion. It sets the flag <<03522>>16745000
if we are beyond EOTSECTR or within END'OF'GPT entries of  the <<03522>>16750000
end of the Gap Table, otherwise it clears the flag.  If we are <<03522>>16755000
writing (TAPEWRITTEN = TRUE), the non-fatal end-of-tape  error <<03522>>16760000
status is also set.                                            <<03522>>16765000
;                                                              <<03522>>16770000
EQUATE                                                         <<03522>>16775000
   END'OF'GPT = 10;  << Set EOT if within 10 entries of end >> <<03522>>16780000
                                                               <<03522>>16785000
DOUBLE                                                         <<03522>>16790000
   TEST'ADDRESS;   << Prevents ACTUAL'ADDRESS call if wrt.  >> <<03522>>16795000
                                                               <<03522>>16800000
IF TAPEWRITTEN                                                 <<03522>>16805000
   THEN TEST'ADDRESS := CURRENTADR                             <<03522>>16810000
   ELSE TEST'ADDRESS := ACTUAL'ADDRESS;                        <<03522>>16815000
IF TEST'ADDRESS > EOTSECTR                                     <<03535>>16820000
   OR GPTLEN - CURRENTGPTENT < END'OF'GPT * GPTENTSIZE         <<03522>>16825000
      THEN                                                     <<03522>>16830000
         BEGIN                                                 <<03522>>16835000
                                                               <<04249>>16840000
<< The following strange-looking statement  preserves  EOT- >> <<04249>>16845000
<< SENSOR  =  EOT'WRITTEN  if we write after detecting EOT. >> <<04249>>16850000
<< EOTFOUND is set here only as we cross EOTSECTR.          >> <<04249>>16855000
                                                               <<04249>>16860000
         IF EOTSENSOR = EOTNOTFOUND THEN                       <<04249>>16865000
            EOTSENSOR := EOTFOUND;                             <<04249>>16870000
         IF TAPEWRITTEN THEN ERRORCODE := -SDERR5;             <<03522>>16875000
         END                                                   <<03522>>16880000
      ELSE EOTSENSOR := EOTNOTFOUND;                           <<03522>>16885000
END;   << of CHECK'FOR'EOT.                                 >> <<03522>>16890000
$PAGE   "   *** Procedure SDISC'FINDGAP ***"                   <<07114>>16895000
PROCEDURE SDISC'FINDGAP (START'SECTOR, END'SECTOR);            <<07114>>16900000
   VALUE   START'SECTOR, END'SECTOR;                           <<07114>>16905000
   DOUBLE  START'SECTOR, END'SECTOR;                           <<07114>>16910000
   OPTION  PRIVILEGED, UNCALLABLE, INTERNAL;                   <<07114>>16915000
                                                               <<07114>>16920000
BEGIN COMMENT --                                               <<07114>>16925000
  SDISC'FINDGAP is a simplified (and much faster)  version  of <<07114>>16930000
SDISCFINDGAP. Like its older counterpart, it detects Gap Table <<07114>>16935000
entries whose addresses lie between START'SECTOR and  END'SEC- <<07114>>16940000
TOR.  Unlike  SDISCFINDGAP, it only needs to scan entries from <<07114>>16945000
CURRENTGPTENT (the current offset into the Gap Table)  to  the <<07114>>16950000
first entry whose address exceeds END'SECTOR instead of to the <<07114>>16955000
end of the Gap Table, and it must only do this once instead of <<07114>>16960000
twice.  (See below for an exception when backspacing).         <<07114>>16965000
  Nothing comes for free, and neither does this.  SDISCFINDGAP <<07114>>16970000
had to cover a variety of several bizarre (and scarce)  situa- <<07114>>16975000
tions involving hole entries.  If you're interested, read more <<07114>>16980000
about it in the comments for that procedure. SDISC'FINDGAP as- <<07114>>16985000
sumes that there are no hole entries in  its  Gap  Table,  and <<07114>>16990000
further  assumes that all entry addresses are in ascending or- <<07114>>16995000
der.  This raises the following compatibility issues:          <<07114>>17000000
  1.  Serial discs written before this  revision  may  contain <<07114>>17005000
hole  entries, which SDISC'FINDGAP can't handle.  The original <<07114>>17010000
SDISCFINDGAP has been retained to deal with  these  discs,  at <<07114>>17015000
the cost of the sloppy performance of SDISCFINDGAP.            <<07114>>17020000
  2.  To tell the difference between "old"  and  "new"  serial <<07114>>17025000
discs, the eighth byte of the volume name (the blank following <<07114>>17030000
"SERDISC") has been picked to contain version information. Old <<07114>>17035000
serial discs contain the blanks.  Newer serial discs will have <<07114>>17040000
a version number starting with "0" and incrementing as may  be <<07114>>17045000
required in the future.  The volume name is never displayed to <<07114>>17050000
the user, nor do any internal MPE routines require a blank  in <<07114>>17055000
that byte.                                                     <<07114>>17060000
  3.  VINIT is responsible for writing the volume  label  when <<07114>>17065000
>SERIALizing the disc, so it must be aware of the current ver- <<07114>>17070000
sion.  Users with old discs can upgrade to the current version <<07114>>17075000
by reSERIALizing the disc.  In addition, SDISC will upgrade to <<07114>>17080000
version "0" whenever the user writes from  Load  Point,  since <<07114>>17085000
this generates a completely new Gap Table.                     <<07114>>17090000
  4.  Since holes and hole entries are no longer allowed,  all <<07114>>17095000
the  code  which  used  to generate holes has been pulled from <<07114>>17100000
SDISC. To minimize the possibility of write errors (which used <<07114>>17105000
to cause holes and their entries to be generated), a  new  set <<07114>>17110000
of  procedures  has  been  developed  to  reassign any problem <<07114>>17115000
tracks or sectors found in the Defective Sector  Table  (DSCT) <<07114>>17120000
for  CS80  discs,  or the Defective Tracks Table (DTT) for the <<07114>>17125000
MAC family discs (7905R/7906R/7920/7925) before writing to the <<07114>>17130000
discs. See the comments in REASSIGN'FLAGGED'TRACKS for further <<07114>>17135000
details.                                                       <<07114>>17140000
  When backspacing over one or more records we may have to ex- <<07114>>17145000
amine Gap Table entries in front of  CURRENTGPTENT.  Since  we <<07114>>17150000
don't  know how far in front, we start at the beginning of the <<07114>>17155000
Gap Table.  This condition is indicated by  the  global  flag, <<07114>>17160000
BACKSPACING,  cleared at every entry to SDISCIO and set for us <<07114>>17165000
by BACKBLOCKREAD (which also clears it when it's done).        <<07114>>17170000
  We have to account for a few pathological cases.  Usually if <<07114>>17175000
we find no Gap Table entries between START'SECTOR and END'SEC- <<07114>>17180000
TOR we just say so (RTV1 through RTV4 returned as -1).  Begin- <<07114>>17185000
ning of Block/End of Block entries need special care and feed- <<07114>>17190000
ing, however.  For these entries, if the block  starts  before <<07114>>17195000
START'SECTOR  but ends in range, STARTGAP is set to START'SEC- <<07114>>17200000
TOR.  Similarly if it starts in range but ends out  of  range, <<07114>>17205000
ENDGAP  is set to END'SECTOR.  When such a gap spans the range <<07114>>17210000
(starts before and ends after), we have to be careful  to  set <<07114>>17215000
both  STARTGAP  and  ENDGAP to START'SECTOR and END'SECTOR re- <<07114>>17220000
spectively.  The real trick is in spotting this condition.     <<07114>>17225000
;                                                              <<07114>>17230000
DOUBLE                                                         <<07114>>17235000
   ENTRY'ADDRESS;                                              <<07114>>17240000
                                                               <<07114>>17245000
INTEGER                                                        <<07114>>17250000
   GPT'ENTRY'INDEX,                                            <<07114>>17255000
   MSW'ADDRESS = ENTRY'ADDRESS,                                <<07114>>17260000
   LSW'ADDRESS = ENTRY'ADDRESS + 1;                            <<07114>>17265000
                                                               <<07114>>17270000
LOGICAL                                                        <<07114>>17275000
   ENTRY'TYPE;                                                 <<07114>>17280000
                                                               <<07114>>17285000
                                                               <<07114>>17290000
SUBROUTINE SET'UP'ENTRY;                                       <<07114>>17295000
                                                               <<07114>>17300000
BEGIN                                                          <<07114>>17305000
ENTRY'TYPE  := GPT(GPT'ENTRY'INDEX).GPT'TYPE'FIELD;            <<07114>>17310000
MSW'ADDRESS := GPT(X).GPT'ADR'FIELD;                           <<07114>>17315000
LSW'ADDRESS := GPT(X:=X+1);                                    <<07114>>17320000
END;                                                           <<07114>>17325000
                                                               <<07114>>17330000
                                                               <<07114>>17335000
SUBROUTINE SET'RETURN'VALUES;                                  <<07114>>17340000
                                                               <<07114>>17345000
BEGIN COMMENT --                                               <<07114>>17350000
  Some common code for EOF, EOD and EOT Gap Table entries.     <<07114>>17355000
;                                                              <<07114>>17360000
STARTGAP := ENDGAP := ENTRY'ADDRESS;                           <<07114>>17365000
GAPTYPE  := ENTRY'TYPE;                                        <<07114>>17370000
ENDINDEX := GPT'ENTRY'INDEX;                                   <<07114>>17375000
END;                                                           <<07114>>17380000
                                                               <<07114>>17385000
                                                               <<07114>>17390000
IF BACKSPACING                                                 <<07114>>17395000
   THEN GPT'ENTRY'INDEX := GPT'START                           <<07114>>17400000
   ELSE GPT'ENTRY'INDEX := CURRENTGPTENT;                      <<07114>>17405000
                                                               <<07114>>17410000
SET'UP'ENTRY;                                                  <<07114>>17415000
WHILE ENTRY'ADDRESS <= END'SECTOR DO                           <<07114>>17420000
   BEGIN   << Repeat while in range or until we find entry. >> <<07114>>17425000
   CASE * ENTRY'TYPE OF                                        <<07114>>17430000
      BEGIN                                                    <<07114>>17435000
                                                               <<07114>>17440000
<< *-*-* 0 -- End of File (EOF) entry.                *-*-* >> <<07114>>17445000
                                                               <<07114>>17450000
      BEGIN                                                    <<07114>>17455000
      IF START'SECTOR <= ENTRY'ADDRESS THEN                    <<07114>>17460000
         BEGIN   << Found an in-range EOF.                  >> <<07114>>17465000
         SET'RETURN'VALUES;                                    <<07114>>17470000
         RETURN;                                               <<07114>>17475000
         END;                                                  <<07114>>17480000
      END;                                                     <<07114>>17485000
                                                               <<07114>>17490000
<< *-*-* 1 -- End of Data (EOD) entry.                *-*-* >> <<07114>>17495000
                                                               <<07114>>17500000
      BEGIN                                                    <<07114>>17505000
      SET'RETURN'VALUES;                                       <<M7491>>17510000
      RETURN;                                                  <<M7491>>17515000
      END;                                                     <<07114>>17520000
                                                               <<07114>>17525000
<< *-*-* 2 and 3 -- BOH and EOH, no longer used.      *-*-* >> <<07114>>17530000
                                                               <<07114>>17535000
      ;                                                        <<07114>>17540000
      ;                                                        <<07114>>17545000
                                                               <<07114>>17550000
<< *-*-* 4 -- Beginning of (contiguous) Block (BOB).  *-*-* >> <<07114>>17555000
                                                               <<07114>>17560000
      BEGIN                                                    <<07114>>17565000
      IF START'SECTOR <= ENTRY'ADDRESS THEN                    <<07114>>17570000
         STARTGAP := ENTRY'ADDRESS;                            <<07114>>17575000
      END;                                                     <<07114>>17580000
                                                               <<07114>>17585000
<< *-*-* 5 -- End of (contiguous) Block (EOB) entry.  *-*-* >> <<07114>>17590000
                                                               <<07114>>17595000
      BEGIN                                                    <<07114>>17600000
      IF START'SECTOR <= ENTRY'ADDRESS THEN                    <<07114>>17605000
         BEGIN                                                 <<07114>>17610000
         IF STARTGAP = -1D THEN   << Gap began out of range >> <<07114>>17615000
            STARTGAP := START'SECTOR;                          <<07114>>17620000
         ENDGAP := ENTRY'ADDRESS;                              <<07114>>17625000
         GAPTYPE := ENTRY'TYPE;                                <<07114>>17630000
         ENDINDEX := GPT'ENTRY'INDEX;                          <<07114>>17635000
         RETURN;                                               <<07114>>17640000
         END;                                                  <<07114>>17645000
      END;                                                     <<07114>>17650000
                                                               <<07114>>17655000
<< *-*-* 6 -- End of Tape (EOT) entry.                *-*-* >> <<07114>>17660000
                                                               <<07114>>17665000
      BEGIN                                                    <<07114>>17670000
      IF START'SECTOR <= ENTRY'ADDRESS THEN                    <<07114>>17675000
         BEGIN   << Found an in-range EOT.                  >> <<07114>>17680000
         SET'RETURN'VALUES;                                    <<07114>>17685000
         RETURN;                                               <<07114>>17690000
         END;                                                  <<07114>>17695000
      END;                                                     <<07114>>17700000
                                                               <<07114>>17705000
<< *-*-* 7 -- End of Table (EOTBL) entry, shouldn't happen. >> <<07114>>17710000
                                                               <<07114>>17715000
      BEGIN                                                    <<07114>>17720000
      STARTGAP := -1D;   << Shouldn't have found BOB but... >> <<07114>>17725000
      GAPTYPE := ENDOFTABLETYPE;                               <<07114>>17730000
      RETURN;                                                  <<07114>>17735000
      END;                                                     <<07114>>17740000
                                                               <<07114>>17745000
      END;   << of CASE statement.                          >> <<07114>>17750000
                                                               <<07114>>17755000
   GPT'ENTRY'INDEX := GPT'ENTRY'INDEX + GPTENTSIZE;            <<07114>>17760000
   SET'UP'ENTRY;                                               <<07114>>17765000
   END;   << WHILE loop.                                    >> <<07114>>17770000
                                                               <<07114>>17775000
<< Here's our special case -- check terminating  entry  for >> <<07114>>17780000
<< EOB and fill in the blanks if found.                     >> <<07114>>17785000
                                                               <<07114>>17790000
IF ENTRY'TYPE = EOBTYPE THEN                                   <<07114>>17795000
   BEGIN                                                       <<07114>>17800000
   IF STARTGAP = -1D THEN STARTGAP := START'SECTOR;            <<07114>>17805000
   ENDGAP := END'SECTOR;                                       <<07114>>17810000
   GAPTYPE := ENTRY'TYPE;                                      <<07114>>17815000
   ENDINDEX := GPT'ENTRY'INDEX;                                <<07114>>17820000
   END;                                                        <<07114>>17825000
END;   << of SDISC'FINDGAP.                                 >> <<07114>>17830000
$PAGE " *** Procedure SDISCFINDGAP *** "                       <<07114>>17835000
PROCEDURE SDISCFINDGAP(STARTSECTOR,ENDSECTOR);                          17840000
VALUE STARTSECTOR,ENDSECTOR;                                            17845000
DOUBLE STARTSECTOR,ENDSECTOR;                                           17850000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>17855000
                                                                        17860000
  COMMENT -- Procedure SDISCFINDGAP scans the Gap Table  of  a <<03522>>17865000
serial  disc  and locates the first "gap" (an end-of-file, the <<03522>>17870000
"end-of-tape" reflector, the end of valid data  on  the  disc, <<03522>>17875000
the  end of the Gap Table itself, a contiguous block or a hole <<03522>>17880000
which denotes a defective area) for which any part  falls  be- <<03522>>17885000
tween  the disc addresses passed in STARTSECTOR and ENDSECTOR. <<03522>>17890000
The disc address(es) and attributes of the gap are returned in <<03522>>17895000
four global cells, RTV1-RTV4 (see below).  If no such  gap  is <<03522>>17900000
found, RTV1-RTV4 are set to -1.                                <<03522>>17905000
  NOTE:  This procedure is obsolete, and is retained only  for <<07114>>17910000
backward compatibility with serial discs of version " ".  Ser- <<07114>>17915000
ial discs of version "0" and later do not have hole entries in <<07114>>17920000
the Gap Table, and can therefore use the  newer  (and  faster) <<07114>>17925000
Gap  Table scanning routine, SDISC'FINDGAP.  Read the comments <<07114>>17930000
below with that in mind.                                       <<07114>>17935000
  To avoid having to recode all the calls to SDISCFINDGAP, the <<07114>>17940000
version test is made here.  SDISC'FINDGAP is then called  from <<07114>>17945000
SDISCFINDGAP for versions "0" and later.                       <<07114>>17950000
  The Gap Table is a linear list of sector entries,  that  is, <<03522>>17955000
any  additions  to  the Gap Table are made at its end although <<03522>>17960000
existing entries may be modified.  Disc addresses contained in <<03522>>17965000
the entries may not always be in ascending order when  scanned <<03522>>17970000
linearly.  This  only  occurs  if SDISC encounters a defective <<03522>>17975000
area while writing and must create a hole entry (Beginning  of <<03522>>17980000
Hole  -  End of Hole [BOH-EOH] pair).  The reason is that hole <<03522>>17985000
entries consume at least the entire track on which the  defec- <<03522>>17990000
tive  area  was found.  If valid data was written on the track <<03522>>17995000
before the defective area, it is moved beyond  the  hole  area <<03522>>18000000
and  any  Gap  Table entries pointing to this area (such as an <<03522>>18005000
end-of-file) are modified to point to the  new  address,  thus <<03522>>18010000
causing a local descent in addresses.                          <<03522>>18015000
  In addition, if a contiguous block straddles  the  start  of <<03522>>18020000
the  track in which the defect is found, the entire contiguous <<03522>>18025000
block is relocated to start beyond the hole, the BOH entry  is <<03522>>18030000
extended  back to the former Beginning of Block (BOB) location <<03522>>18035000
(that is, before the start of the defective  track),  and  the <<03522>>18040000
BOB  entry  is  updated  to  point to an area beyond the hole. <<03522>>18045000
In this situation, a linear scan of the Gap  Table  reveals  a <<03522>>18050000
BOH-EOH  pair nested inside a BOB-EOB pair, again with a local <<03522>>18055000
descent in addresses.                                          <<03522>>18060000
  To save time during Forward Space File, the search starts at <<03535>>18065000
the  Gap Table entry currently being pointed to by CURRENTGPT- <<03522>>18070000
ENT.  If no gap is found between  STARTSECTOR  and  ENDSECTOR, <<03522>>18075000
the  search is repeated starting at the first entry in the Gap <<03522>>18080000
Table.                                                         <<03522>>18085000
  Because it operates in split-stack  mode,  SDISCFINDGAP  re- <<03522>>18090000
turns  four  values  in global cells RTV1 through RTV4.  These <<03522>>18095000
values are shown below for each of 13  valid  combinations  of <<03522>>18100000
STARTSECTOR,  ENDSECTOR, a BOB-EOB or BOH-EOH gap, and another <<03522>>18105000
terminator which may be EOFTYPE, EODTYPE, EOTTYPE or  ENDOFTA- <<03522>>18110000
BLETYPE from the table below.  STARTGAP and ENDGAP are double- <<03522>>18115000
word disc addresses, GAPTYPE is an integer with a value from 0 <<03522>>18120000
to 7 from the table below and ENDINDEX  is  an  integer  which <<03522>>18125000
points  to the Gap Table entry which ended the search.  Due to <<03522>>18130000
space considerations in the diagram, the  following  abbrevia- <<03522>>18135000
tions were used:                                               <<03522>>18140000
$PAGE                                                          <<03522>>18145000
  STRTGAP = STARTGAP = RTV1                                    <<03522>>18150000
  ENDGAP             = RTV2                                    <<03522>>18155000
  GAPTYPE            = RTV3                                    <<03522>>18160000
  ENDINDX = ENDINDEX = RTV4                                    <<03522>>18165000
  n/a     = not applicable, situation does not occur.          <<03522>>18170000
  STRTSCT = STARTSECTOR                                        <<03522>>18175000
  ENDSECT = ENDSECTOR                                          <<03522>>18180000
  EOF/EOT = a GAPTYPE of  EOFTYPE  or  EOTTYPE,  depending  on <<03522>>18185000
            which was encountered.                             <<03522>>18190000
  EOB/EOH = a GAPTYPE of  EOBTYPE  or  EOHTYPE,  depending  on <<03522>>18195000
            which was encountered.                             <<03522>>18200000
  pointer = points to the Gap Table entry of type GAPTYPE  for <<03522>>18205000
            which  ENDGAP contains sctradr.  If GAPTYPE = EOF, <<03522>>18210000
            EOT or EOD, STARTGAP also contains sctradr.        <<03522>>18215000
  sctradr = the sector address of a STARTGAP or an ENDGAP.     <<03522>>18220000
                                                               <<03522>>18225000
   GAPTYPE     GAPTYPE                                         <<03522>>18230000
    VALUE     IDENTIFIER      Description -- disc address of:  <<03522>>18235000
 +---------+--------------+----------------------------------+ <<03522>>18240000
 |    0    |  EOFTYPE     |  End-of-file mark                | <<03522>>18245000
 |    1    |  EODTYPE     |  Last valid data on disc         | <<03522>>18250000
 |    2    |  BOHTYPE     |  Start of hole (defective area)  | <<03522>>18255000
 |    3    |  EOHTYPE     |  End of hole (defective area)    | <<03522>>18260000
 |    4    |  BOBTYPE     |  Start of contiguous block       | <<03522>>18265000
 |    5    |  EOBTYPE     |  End of contiguous block         | <<03522>>18270000
 |    6    |  EOTTYPE     |  "End of tape" reflector         | <<03522>>18275000
 |    7    |  ENDOFTABLE- |  Last entry in Gap Table (not a  | <<03522>>18280000
 |         |    TYPE      |    disc address)                 | <<03522>>18285000
 +---------+--------------+----------------------------------+ <<03522>>18290000
                                                               <<03522>>18295000
                                       x=_                     <<03522>>18300000
                                      /   \                    <<03522>>18305000
                                     /     \                   <<03522>>18310000
          START     END           EOD,      EOF,        RTV1-  <<03522>>18315000
          SCTR      SCTR         ENDTBL     EOT         RTV4   <<03522>>18320000
            |         |                                        <<03522>>18325000
          x |         |          sctradr    n/a        STRTGAP <<03522>>18330000
    +---+ | |         |          sctradr    n/a        ENDGAP  <<03522>>18335000
 1. |   | | |         |          EOD only   n/a        GAPTYPE <<03522>>18340000
    +---+ | |         |          pointer    n/a        ENDINDX <<03522>>18345000
            |         |                                        <<03522>>18350000
            |    x    |          sctradr   sctradr     STRTGAP <<03522>>18355000
    +---+   |    |    |          sctradr   sctradr     ENDGAP  <<03522>>18360000
 2. |   |   |    |    |          EOD only  EOF/EOT     GAPTYPE <<03522>>18365000
    +---+   |    |    |          pointer   pointer     ENDINDX <<03522>>18370000
            |         |                                        <<03522>>18375000
            |         |       x    -1        -1        STRTGAP <<03522>>18380000
    +---+   |         |       |    -1        -1        ENDGAP  <<03522>>18385000
 3. |   |   |         |       |    -1        -1        GAPTYPE <<03522>>18390000
    +---+   |         |       |    -1        -1        ENDINDX <<03522>>18395000
            |         |                                        <<03522>>18400000
            |    x    |          STRTSCT   STRTSCT     STRTGAP <<03522>>18405000
          +-|-+  |    |          sctradr   sctradr     ENDGAP  <<03522>>18410000
 4.       | | |  |    |          EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18415000
          +-|-+  |    |          pointer   pointer     ENDINDX <<03522>>18420000
$PAGE                                                          <<03522>>18425000
            |         |       x  STRTSCT   STRTSCT     STRTGAP <<03522>>18430000
          +-|-+       |       |  sctradr   sctradr     ENDGAP  <<03522>>18435000
 5.       | | |       |       |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18440000
          +-|-+       |       |  pointer   pointer     ENDINDX <<03522>>18445000
            |         |                                        <<03522>>18450000
            |       x |          sctradr   sctradr     STRTGAP <<03522>>18455000
            | +---+ | |          sctradr   sctradr     ENDGAP  <<03522>>18460000
 6.         | |   | | |          EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18465000
            | +---+ | |          pointer   pointer     ENDINDX <<03522>>18470000
            |         |                                        <<03522>>18475000
            |         |       x  sctradr   sctradr     STRTGAP          18480000
            | +---+   |       |  sctradr   sctradr     ENDGAP  <<03522>>18485000
 7.         | |   |   |       |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18490000
            | +---+   |       |  pointer   pointer     ENDINDX <<03522>>18495000
            |         |                                        <<03522>>18500000
            |         |       x  sctradr   sctradr     STRTGAP <<03522>>18505000
            |       +-|-+     |  ENDSECT   ENDSECT     ENDGAP  <<03522>>18510000
 8.         |       | | |     |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18515000
            |       +-|-+     |  endtbl    endtbl      ENDINDX <<03522>>18520000
            |         |                                        <<03522>>18525000
            |         |       x    -1        -1        STRTGAP <<03522>>18530000
            |         | +---+ |    -1        -1        ENDGAP  <<03522>>18535000
 9.         |         | |   | |    -1        -1        GAPTYPE <<03522>>18540000
            |         | +---+ |    -1        -1        ENDINDX <<03522>>18545000
            |         |                                        <<03522>>18550000
            |         |       x  STRTSCT   STRTSCT     STRTGAP <<03522>>18555000
          +-|---------|-+     |  ENDSECT   ENDSECT     ENDGAP  <<03522>>18560000
10.       | |         | |     |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>18565000
          +-|---------|-+     |  endtbl    endtbl      ENDINDX <<03522>>18570000
            |         |                                        <<03522>>18575000
          x |         |          sctradr     -1        STRTGAP <<03522>>18580000
          | |         |          sctradr     -1        ENDGAP  <<03522>>18585000
11.       | |         |          EOD only    -1        GAPTYPE <<03522>>18590000
          | |         |          pointer     -1        ENDINDX <<03522>>18595000
            |         |                                        <<03522>>18600000
            |    x    |          sctradr   sctradr     STRTGAP <<03522>>18605000
            |    |    |          sctradr   sctradr     ENDGAP  <<03522>>18610000
12.         |    |    |          EOD only  EOF/EOT     GAPTYPE <<03522>>18615000
            |    |    |          pointer   pointer     ENDINDX <<03522>>18620000
            |         |                                        <<03522>>18625000
            |         |       x    -1        -1        STRTGAP <<03522>>18630000
            |         |       |    -1        -1        ENDGAP  <<03522>>18635000
13.         |         |       |    -1        -1        GAPTYPE <<03522>>18640000
            |         |       |    -1        -1        ENDINDX <<03522>>18645000
;                                                              <<03522>>18650000
                                                                        18655000
BEGIN <<SDISCFINDGAP>>                                                  18660000
DOUBLE SECTORADDRESS;                                          <<03522>>18665000
INTEGER ENTRYTYPE, ENTRYINDEX, ADR1=SECTORADDRESS,             <<03522>>18670000
   ADR2=SECTORADDRESS+1;                                       <<03522>>18675000
LOGICAL                                                        <<03522>>18680000
  FIRST'TIME;  << Speed up FSF, scan 1st from CURRENTGPTENT >> <<03522>>18685000
                                                                        18690000
STARTGAP:=ENDGAP:=-1D;                                                  18695000
GAPTYPE:=-1;                                                            18700000
ENDINDEX:=-1;                                                           18705000
IF STARTSECTOR > ENDSECTOR THEN RETURN;   << Null range.    >> <<03522>>18710000
IF SDISC'VERSION <> " " THEN                                   <<07114>>18715000
   BEGIN   << O.K. to use faster Gap Table scanner.         >> <<07114>>18720000
   SDISC'FINDGAP (STARTSECTOR, ENDSECTOR);                     <<07114>>18725000
   RETURN;                                                     <<07114>>18730000
   END;                                                        <<07114>>18735000
                                                               <<07114>>18740000
FIRST'TIME := TRUE;                                            <<03522>>18745000
DO BEGIN   << Gap Table scan.                               >> <<03522>>18750000
   IF FIRST'TIME                                               <<03522>>18755000
      THEN ENTRYINDEX := CURRENTGPTENT                         <<03522>>18760000
      ELSE ENTRYINDEX := GPT'START;                            <<03522>>18765000
   DO                                                                   18770000
      BEGIN <<REPEAT FOR EVERY ENTRY>>                         <<00189>>18775000
      ADR1:=GPT(ENTRYINDEX).GPT'ADR'FIELD;                     <<00189>>18780000
      ADR2:=GPT(ENTRYINDEX+1);                                 <<00189>>18785000
      ENTRYTYPE:=GPT(ENTRYINDEX).GPT'TYPE'FIELD;               <<00189>>18790000
      IF SECTORADDRESS<=ENDSECTOR THEN                                  18795000
         BEGIN <<ENTRY MAY BE OF INTEREST>>                             18800000
         IF ENTRYTYPE=BOBTYPE OR ENTRYTYPE=BOHTYPE THEN                 18805000
            IF STARTGAP=-1D THEN                                        18810000
               BEGIN <<BEGINNING OF GAP>>                               18815000
               GAPTYPE:=ENTRYTYPE+1;                                    18820000
               STARTGAP:=SECTORADDRESS;                                 18825000
               END;  <<BEGINNING OF GAP>>                               18830000
         IF SECTORADDRESS<STARTSECTOR THEN                              18835000
            IF ENTRYTYPE=GAPTYPE THEN                                   18840000
               BEGIN <<ENTIRE GAP BEFORE RANGE>>                        18845000
               GAPTYPE:=-1;                                             18850000
               STARTGAP:=-1D;                                           18855000
               END;  <<ENTIRE GAP BEFORE RANGE>>                        18860000
         IF SECTORADDRESS>=STARTSECTOR OR                               18865000
           ENTRYTYPE = EODTYPE THEN                            <<03522>>18870000
            BEGIN <<ENTRY IN RANGE>>                                    18875000
            IF ENTRYTYPE=GAPTYPE THEN                                   18880000
               BEGIN <<FOUND END OF FIRST GAP>>                         18885000
               ENDGAP:=SECTORADDRESS;                                   18890000
               ENDINDEX:=ENTRYINDEX;                           <<00189>>18895000
               IF STARTGAP<STARTSECTOR THEN                             18900000
                 STARTGAP := STARTSECTOR;                               18905000
               RETURN;                                                  18910000
               END;  <<FOUND END OF FIRST GAP>>                         18915000
            IF ENTRYTYPE = EOFTYPE OR ENTRYTYPE = EOTTYPE      <<03522>>18920000
              OR ENTRYTYPE = EODTYPE THEN                      <<03522>>18925000
               BEGIN                                                    18930000
               STARTGAP:=ENDGAP:=SECTORADDRESS;                         18935000
               ENDINDEX:=ENTRYINDEX;                           <<00189>>18940000
               GAPTYPE:=ENTRYTYPE;                                      18945000
               RETURN;                                                  18950000
               END;                                                     18955000
            END;  <<ENTRY IN RANGE>>                                    18960000
         END;   <<ENTRY MAY BE OF INTEREST>>                            18965000
      END   <<REPEAT FOR EVERY ENTRY>>                         <<00189>>18970000
     UNTIL (ENTRYINDEX := ENTRYINDEX + GPTENTSIZE) >= GPTLEN   <<03522>>18975000
       OR ENTRYTYPE = ENDOFTABLETYPE;                                   18980000
   IF ENDGAP = -1D AND STARTGAP <> -1D THEN                             18985000
     ENDGAP := ENDSECTOR;   << End of gap > end of search.  >>          18990000
                                                                        18995000
<< Go through loop a second time only if gap not yet found. >>          19000000
                                                                        19005000
   IF STARTGAP <> -1D THEN                                     <<03522>>19010000
      BEGIN                                                    <<03522>>19015000
      IF STARTGAP < STARTSECTOR THEN STARTGAP := STARTSECTOR;  <<03522>>19020000
      RETURN;                                                  <<03522>>19025000
      END;                                                     <<03522>>19030000
   END   << Gap Table scan.                                 >> <<03522>>19035000
  UNTIL (FIRST'TIME := NOT FIRST'TIME);                        <<03522>>19040000
END;  <<SDISCFINDGAP>>                                                  19045000
$PAGE " *** Procedure ACTUAL'ADDRESS *** "                     <<07114>>19050000
DOUBLE PROCEDURE ACTUAL'ADDRESS;                               <<03522>>19055000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>19060000
                                                               <<03522>>19065000
BEGIN COMMENT --                                               <<03522>>19070000
  From time to time, SDISC must know the actual  disc  address <<03522>>19075000
of  the  current sector of the data image residing in RECBUFF. <<03522>>19080000
Since contiguous block gaps and holes ("gaps") are not put  in <<03522>>19085000
RECBUFF,  we  have a slight problem defining "current sector". <<03522>>19090000
If one or more such gaps were skipped while  we  were  filling <<03522>>19095000
RECBUFF  to read, then CURRENTADR (calculated relative to REC- <<03522>>19100000
BUFFSA) points to a different sector than that  actually  con- <<03522>>19105000
taining  the  data.  For  example,  assume RECBUFFSA = 100 and <<03522>>19110000
that a gap exists between sectors 110-115, inclusive  (6  sec- <<03522>>19115000
tors.  Also  assume  that we are in the 14th sector of RECBUFF <<03522>>19120000
(CURRENTADR = 113). If we access the disc  based  on  CURRENT- <<03522>>19125000
ADR,  we  will get (or overwrite!) a part of a gap.  Worse, if <<03522>>19130000
we blindly erase the Gap Table from CURRENTADR to the end  (as <<03522>>19135000
in  GPTMOD  (CLEAR'TO'END)), we will kill the EOB entry at 115 <<03522>>19140000
but not the BOB entry at 110.  The result  is  a  corrupt  Gap <<03522>>19145000
Table.  Note  that  EOF  and EOT marks pose no problem because <<03522>>19150000
they ARE in RECBUFF and are therefore properly  accounted  for <<03522>>19155000
by  CURRENTADR.  Since  the  sector image in RECBUFF currently <<03522>>19160000
pointed to by CURRENTADR actually exists in disc  sector  119, <<03522>>19165000
this is the actual disc address required by SDISC.             <<03522>>19170000
  Putting it another way, while reading,  CURRENTADR  is  fine <<03522>>19175000
for  managing RECBUFF but not for use with the Gap Table.  The <<03522>>19180000
problem doesn't arise while writing because gaps  are  written <<03522>>19185000
and flushed to disc immediately. Thus CURRENTADR always equals <<03522>>19190000
ACTUAL'ADDRESS and is valid at all times.                      <<03522>>19195000
  ACTUAL'ADDRESS returns the proper address  of  the  disc  by <<03522>>19200000
developing  an  offset to CURRENTADR (in GAPCOUNT) for each of <<03522>>19205000
the following situations:                                      <<03522>>19210000
1.  No gaps in the current block or CURRENTBUFINDEX is at  the <<03522>>19215000
    start of RECBUFF.  The trivial cases.                      <<03522>>19220000
2.  One or more gaps in the block, but not the end of data  on <<03522>>19225000
    the disc. We scan the Gap Table from RECBUFFSA to CURRENT- <<03522>>19230000
    ADR.  The length of any gaps are accumulated  in  GAPCOUNT <<03522>>19235000
    and  the  scan is repeated from beyond the previous gap to <<03522>>19240000
    CURRENTADR + GAPCOUNT.  When all  gaps  have  been  found, <<03522>>19245000
    CURRENTADR + GAPCOUNT will reflect the actual disc address <<03522>>19250000
    of our RECBUFF image, the elusive number we need.          <<03522>>19255000
3.  Zero or more gaps plus an end of data. This situation only <<03522>>19260000
    arises when we have read the end of file which ALWAYS pre- <<03522>>19265000
    cedes the end of data, and have returned EOF status to the <<03522>>19270000
    SDI caller.  Another read here would produce SDERR  (1)22, <<03522>>19275000
    an  attempt to read beyond EOD.  For callers who must know <<03522>>19280000
    about this situation, the contents of RTV1-RTV4 reflect  a <<03522>>19285000
    detected EOD on exit, whenever it occurs.                  <<03522>>19290000
;                                                                       19295000
INTEGER                                                        <<03522>>19300000
  GAPCOUNT;   << Totals sector length of blocks and holes.  >> <<03522>>19305000
                                                               <<03522>>19310000
DOUBLE                                                         <<03522>>19315000
  STARTSECTOR;   << Moving starting addr for gap checks.    >> <<03522>>19320000
                                                               <<03522>>19325000
GAPCOUNT := 0;                                                 <<03522>>19330000
STARTSECTOR := RECBUFFSA;                                      <<03522>>19335000
IF CURRENTBUFINDEX <> 0 THEN                                   <<03522>>19340000
   DO BEGIN   << Find EOD or all contiguous blocks or holes >> <<03522>>19345000
      SDISCFINDGAP (STARTSECTOR, CURRENTADR +                  <<03522>>19350000
                    DOUBLE (GAPCOUNT));                        <<03522>>19355000
      STARTSECTOR := ENDGAP + 1D;   << To continue if req'd >> <<03522>>19360000
      IF GAPTYPE = EOBTYPE OR GAPTYPE = EOHTYPE THEN           <<03522>>19365000
        GAPCOUNT := GAPCOUNT + INTEGER (ENDGAP - STARTGAP) + 1;<<03522>>19370000
      END     << Find EOD or all contiguous blocks or holes >> <<03522>>19375000
     UNTIL STARTGAP = -1D   << No (more) gaps in area.      >> <<03522>>19380000
       OR GAPTYPE = EODTYPE;                                   <<03522>>19385000
ACTUAL'ADDRESS := CURRENTADR + DOUBLE(GAPCOUNT);               <<03522>>19390000
END;   << of ACTUAL'ADDRESS.                                >> <<03522>>19395000
$PAGE " *** Procedure READ'BUFFER *** "                        <<07114>>19400000
PROCEDURE READ'BUFFER (STARTING'ADDRESS, OFFSET, WORD'COUNT,   <<07114>>19405000
                       PARTIAL);                               <<07114>>19410000
   VALUE STARTING'ADDRESS, OFFSET, WORD'COUNT, PARTIAL;        <<07114>>19415000
   DOUBLE STARTING'ADDRESS;                                    <<07114>>19420000
   INTEGER OFFSET, WORD'COUNT;                                 <<07114>>19425000
   LOGICAL PARTIAL;                                            <<07114>>19430000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>19435000
                                                               <<07114>>19440000
BEGIN COMMENT --                                               <<07114>>19445000
  READ'BUFFER does physical  I/O  and  buffer  management  for <<07114>>19450000
READBLOCK, its only caller.  We accept a logical starting disc <<07114>>19455000
address, an offset into a data segment, a word count to  read, <<07114>>19460000
and a flag which denotes whether the call is a partial read or <<07114>>19465000
not. All of these, including the definition of a partial read, <<07114>>19470000
are described in detail below.                                 <<07114>>19475000
  The original concept of READ'BUFFER was only to  manage  en- <<07114>>19480000
tire  (complete  data  segment) buffers, making no assumptions <<07114>>19485000
about their contents, thereby leaving it to READBLOCK  to  de- <<07114>>19490000
tect  and  crunch out any unwanted contiguous blocks or holes. <<07114>>19495000
This made a simple READ'BUFFER, but meant a redesign of  READ- <<07114>>19500000
BLOCK  to possibly return less-than-complete buffers.  This in <<07114>>19505000
turn caused wider ripples in BACKBLOCKREAD  (which  thinks  it <<07114>>19510000
knows  how  READBLOCK  works, so would also need redesign) and <<07114>>19515000
CTRLSDISC, function 12 (BackSpace Record), which makes assump- <<07114>>19520000
tions about BACKBLOCKREAD, including some tricky boundary con- <<07114>>19525000
ditions at Load Point.                                         <<07114>>19530000
  To avoid all this, we decided to leave READBLOCK pretty much <<07114>>19535000
alone.  The only change is that it now calls  READ'BUFFER  in- <<07114>>19540000
stead  of  ATACHIO.  This  means  READ'BUFFER must be somewhat <<07114>>19545000
smarter than originally intended, to wit:                      <<07114>>19550000
1.  Normal READBLOCK operation usually  reads  a  full  buffer <<07114>>19555000
    which  logically  concatenates  on to the one it just fin- <<07114>>19560000
    ished with.  This we can handle easily by  giving  it  the <<07114>>19565000
    one  we just pre-read and starting another pre-read in the <<07114>>19570000
    buffer it just returned.                                   <<07114>>19575000
2.  At other times READBLOCK must read less than a full buffer <<07114>>19580000
    (as when crunching out contiguous blocks and/or holes), or <<07114>>19585000
    must read a full buffer which does  not  logically  follow <<07114>>19590000
    the  one  it  did last.  For either of these situations it <<07114>>19595000
    has no use for any buffers we may have pre-read, so  I/O's <<07114>>19600000
    on any such buffers are aborted.                           <<07114>>19605000
3.  A partial read, which we define as a read which  does  not <<07114>>19610000
    fill  a  buffer  segment,  indicates a buffer crunch and a <<07114>>19615000
    deviation from straight serial read.  Therefore, the first <<07114>>19620000
    such partial read (detected by OFFSET = 0) clears all pre- <<07114>>19625000
    reads in progress.                                         <<07114>>19630000
4.  Since the buffer can't be processed by higher  level  rou- <<07114>>19635000
    tines  until  it's  full,  all partial reads are done with <<07114>>19640000
    wait (blocked I/O).  Note that our definition  of  partial <<07114>>19645000
    reads excludes the final read, the one that results in the <<07114>>19650000
    buffer being full.  This is done without  wait,  and  pre- <<07114>>19655000
    reads  of  all  other  buffers are started since we assume <<07114>>19660000
    they will logically concatenate on  to  this  final  read. <<07114>>19665000
    However,  READ'BUFFER  does  not return to READBLOCK until <<07114>>19670000
    the first I/O has completed.                               <<07114>>19675000
5.  When reading an entire buffer,  STARTING'ADDRESS  is  com- <<07114>>19680000
    pared  with  the  starting  address of the earliest buffer <<07114>>19685000
    currently doing I/O.  If they match, this is a normal  se- <<07114>>19690000
    rial read and the buffer is returned to READBLOCK when the <<07114>>19695000
    I/O has completed.  If the starting addresses don't match, <<07114>>19700000
    this is a non-serial read and all buffers are cleared  be- <<07114>>19705000
    fore starting pre-reads.                                   <<07114>>19710000
6.  The only time READ'BUFFER will (pre-)read less than a full <<07114>>19715000
    buffer when asked to read a full one is  if  such  a  read <<07114>>19720000
    would take us beyond the end of the medium (EODSECTR).  We <<07114>>19725000
    limit such reads to EODSECTR to avoid annoying errors from <<07114>>19730000
    ATTACHIO.  If READBLOCK subsequently asks for data  beyond <<07114>>19735000
    EODSECTR, we return an SDERR indicating tape runaway.      <<07114>>19740000
7.  We manage the current state of  the  DOING'IO  and  IN'USE <<07114>>19745000
    bits  for  each  buffer  we work with.  Other routines are <<07114>>19750000
    responsible for initializing these bits.                   <<07114>>19755000
                                                               <<07114>>19760000
Inputs:                                                        <<07114>>19765000
  STARTING'ADDRESS:  Disc sector address of start of read.     <<07114>>19770000
                                                               <<07114>>19775000
  OFFSET:  Where in destination data segment to put the data   <<07114>>19780000
           read from disc.                                     <<07114>>19785000
                                                               <<07114>>19790000
  COUNT:   The amount of data to be read (> 0 words).          <<07114>>19795000
                                                               <<07114>>19800000
  PARTIAL:  If TRUE, this read does not fill the current buf-  <<07114>>19805000
            fer.  I/O with wait is done on the current buffer. <<07114>>19810000
            If FALSE, this read does fill the current buffer,  <<07114>>19815000
            either as a full data segment read or as the last  <<07114>>19820000
            short read following a series of PARTIALs.         <<07114>>19825000
                                                               <<07114>>19830000
Output:  No functional return, but SDERR should be checked.    <<07114>>19835000
         The condition code is not changed.                    <<07114>>19840000
                                                               <<07114>>19845000
Special considerations:  DB must be at SDISC's global variable <<07114>>19850000
                         XDS, same at return.                  <<07114>>19855000
                                                               <<07114>>19860000
Called by:  READBLOCK.                                         <<07114>>19865000
                                                               <<07114>>19870000
Calls:      ATACHIO, CLEAR'ALL'BUFFERS, WAITFORIO.             <<07114>>19875000
;                                                              <<07114>>19880000
DOUBLE                                                         <<07114>>19885000
   DERR,               << For ATIOERR DEFINE.               >> <<07114>>19890000
   LOCAL'START'ADDR,                                           <<07114>>19895000
   TEMP'D;                                                     <<07114>>19900000
                                                               <<07114>>19905000
INTEGER                                                        <<07114>>19910000
   ERR1      = DERR,               << For ATIOERR DEFINE.   >> <<07114>>19915000
   LOCAL'SA0 = LOCAL'START'ADDR,   << For ATACHIO...        >> <<07114>>19920000
   LOCAL'SA1 = LOCAL'SA0 + 1;      <<   ... parameters.     >> <<07114>>19925000
$PAGE                                                          <<07114>>19930000
SUBROUTINE LIMIT'WORD'COUNT;                                   <<07114>>19935000
                                                               <<07114>>19940000
BEGIN COMMENT --  LIMIT'WORD'COUNT  limits  the  ATACHIO  word <<07114>>19945000
count  to  the  lesser  of one buffer length or the word count <<07114>>19950000
from LOCAL'START'ADDR to EODSECTR, inclusive.                  <<07114>>19955000
;                                                              <<07114>>19960000
WORD'COUNT := DATABUF'WORDS'IN'BUF := RECBUFFLEN + 1;          <<07114>>19965000
IF (TEMP'D := EODSECTR - LOCAL'START'ADDR + 1D) <              <<07114>>19970000
              DOUBLE (RECBUFFSECTORLEN) THEN                   <<07114>>19975000
   WORD'COUNT := DATABUF'WORDS'IN'BUF := INTEGER (TEMP'D) *    <<07114>>19980000
                 WORDSPERSECTR;                                <<07114>>19985000
END;   << of LIMIT'WORD'COUNT.                              >> <<07114>>19990000
                                                               <<07114>>19995000
                                                               <<07114>>20000000
                                                               <<07114>>20005000
SUBROUTINE START'IO;                                           <<07114>>20010000
                                                               <<07114>>20015000
BEGIN COMMENT -- START'IO lights off a no-wait I/O on the cur- <<07114>>20020000
rent buffer iff WORD'COUNT <> 0.  OFFSET, LOCAL'START'ADDR and <<07114>>20025000
WORD'COUNT must all be set externally.                         <<07114>>20030000
;                                                              <<07114>>20035000
IF WORD'COUNT > 0 THEN                                         <<07114>>20040000
   BEGIN   << Didn't run off end of medium.                 >> <<07114>>20045000
   TOS := ATACHIO (LDNUM, QMISC, DATABUF'DST, OFFSET, READ,    <<07114>>20050000
          WORD'COUNT, LOCAL'SA0, LOCAL'SA1, UNBLOCKED);        <<07114>>20055000
   DEL;   << TLOG word meaningless at start of no-wait I/O. >> <<07114>>20060000
   DATABUF'IOQX := TOS;                                        <<07114>>20065000
   DATABUF'DOING'IO := TRUE;                                   <<07114>>20070000
   END;    << Didn't run off end of medium.                 >> <<07114>>20075000
END;       << of START'IO.                                  >> <<07114>>20080000
                                                               <<07114>>20085000
                                                               <<07114>>20090000
                                                               <<07114>>20095000
SUBROUTINE WAIT'FOR'COMPLETION;                                <<07114>>20100000
                                                               <<07114>>20105000
BEGIN COMMENT -- WAIT'FOR'COMPLETION does  just  that  if  the <<07114>>20110000
current  buffer  is  DOING'IO.  Any  I/O error is reported via <<07114>>20115000
SDERR32.  If the buffer is not DOING'IO, it should be. The on- <<07114>>20120000
ly reason it can't be is if  WORD'COUNT  was  0,  so  START'IO <<07114>>20125000
didn't start the I/O. If THAT's so, we've been asked to return <<07114>>20130000
data from beyond EODSECTR, so we return SDERR27 (Tape Runaway) <<07114>>20135000
instead.                                                       <<07114>>20140000
;                                                              <<07114>>20145000
IF DATABUF'DOING'IO THEN                                       <<07114>>20150000
   BEGIN   << Normal I/O completion wait.                   >> <<07114>>20155000
   DATABUFD'ATTIO'RETURN := WAITFORIO (DATABUF'IOQX);          <<07114>>20160000
   IF DATABUF'ATTIO'GENL'STATUS <> NORMAL'COMPLETION THEN      <<07114>>20165000
      ERRORCODE := SDERR32;                                    <<07114>>20170000
   DATABUF'DOING'IO := FALSE;                                  <<07114>>20175000
   END                                                         <<07114>>20180000
ELSE ERRORCODE := SDERR27;                                     <<07114>>20185000
END;   << of WAIT'FOR'COMPLETION.                           >> <<07114>>20190000
$PAGE                                                          <<07114>>20195000
<< ************* Procedure body starts here. ************** >> <<07114>>20200000
                                                               <<07114>>20205000
IF PARTIAL THEN                                                <<07114>>20210000
   BEGIN   << Read less than a full buffer, with wait.      >> <<07114>>20215000
   LOCAL'START'ADDR := STARTING'ADDRESS;                       <<07114>>20220000
   IF OFFSET = 0 THEN                                          <<07114>>20225000
      BEGIN   << First partial, abort all pre-reads.        >> <<07114>>20230000
      CLEAR'ALL'BUFFERS;                                       <<07114>>20235000
      IF SDERR THEN RETURN;                                    <<07114>>20240000
      DATABUFD'SA := STARTING'ADDRESS;                         <<07114>>20245000
      DATABUF'IN'USE := TRUE;                                  <<07114>>20250000
      END;                                                     <<07114>>20255000
   DERR := ATACHIO (LDNUM, QMISC', DATABUF'DST, OFFSET, READ,  <<07114>>20260000
                   WORD'COUNT, LOCAL'SA0, LOCAL'SA1, BLOCKED); <<07114>>20265000
   IF ATIOERR THEN ERRORCODE := SDERR32;                       <<07114>>20270000
   RETURN;                                                     <<07114>>20275000
   END     << Read less than a full buffer.                 >> <<07114>>20280000
ELSE                                                           <<07114>>20285000
   BEGIN   << This read fills a buffer.                     >> <<07114>>20290000
   IF OFFSET = 0 THEN                                          <<07114>>20295000
      BEGIN   << Read complete buf, chk nxt for serial read >> <<07114>>20300000
      BUMP'CURRENT'BUFFER;                                     <<07114>>20305000
      IF STARTING'ADDRESS = DATABUFD'SA THEN                   <<07114>>20310000
         BEGIN   << Serial rd, start pre-read in prev bufr. >> <<07114>>20315000
         IF (CURRENT'BUFFER := CURRENT'BUFFER - 1) < 0 THEN    <<07114>>20320000
            CURRENT'BUFFER := NUM'BUFFERS - 1;                 <<07114>>20325000
         DATABUF'IN'USE := FALSE;                              <<07114>>20330000
         DATABUFD'SA := LOCAL'START'ADDR := STARTING'ADDRESS + <<07114>>20335000
            DOUBLE ((NUM'BUFFERS-1) * RECBUFFSECTORLEN);       <<07114>>20340000
         LIMIT'WORD'COUNT;   << Don't run off the far end.  >> <<07114>>20345000
         START'IO;           << Light off no-wait I/O.      >> <<07114>>20350000
         BUMP'CURRENT'BUFFER;   << To one we'll return.     >> <<07114>>20355000
         WAIT'FOR'COMPLETION;   << And check for errors.    >> <<07114>>20360000
         RETURN;   << Normal return for serial read.        >> <<07114>>20365000
         END       << Serial read.                          >> <<07114>>20370000
      ELSE                                                     <<07114>>20375000
         BEGIN   << Non-serial read, but complete buffer.   >> <<07114>>20380000
         CLEAR'ALL'BUFFERS;                                    <<07114>>20385000
         IF SDERR THEN RETURN;                                 <<07114>>20390000
         DATABUFD'SA := LOCAL'START'ADDR := STARTING'ADDRESS;  <<07114>>20395000
         LIMIT'WORD'COUNT;                                     <<07114>>20400000
         END;    << Non-serial read, but complete buffer.   >> <<07114>>20405000
      END     << Read complete buf, chk nxt for serial read >> <<07114>>20410000
   ELSE                                                        <<07114>>20415000
      BEGIN                                                    <<07114>>20420000
                                                               <<07114>>20425000
<< Not a complete buffer read but this read fills this buf- >> <<07114>>20430000
<< fer, or as close to full as READBLOCK wants (say  if  it >> <<07114>>20435000
<< found End of Data in the Gap Table).                     >> <<07114>>20440000
                                                               <<07114>>20445000
      LOCAL'START'ADDR := STARTING'ADDRESS;                    <<07114>>20450000
      DATABUF'WORDS'IN'BUF := OFFSET + WORD'COUNT;             <<07114>>20455000
      END;   << Not a complete buffer read.                 >> <<07114>>20460000
                                                               <<07114>>20465000
<< At this point we are ready to pre-read as  many  buffers >> <<07114>>20470000
<< as  are available, and to wait on the earliest of these. >> <<07114>>20475000
<< BUFFER'COUNT is used below to prevent  us  from  looping >> <<07114>>20480000
<< indefinitely if WORD'COUNT = 0 because we hit EODSECTR.  >> <<07114>>20485000
                                                               <<07114>>20490000
   START'IO;      << Start no-wait I/O, this buffer.        >> <<07114>>20495000
   OFFSET := 0;   << For pre-reads on other buffers.        >> <<07114>>20500000
   BUFFER'COUNT := 1;   << Not 0, one I/O already in progrs >> <<07114>>20505000
   BUMP'CURRENT'BUFFER;                                        <<07114>>20510000
   WHILE NOT DATABUF'DOING'IO OR BUFFER'COUNT < NUM'BUFFERS DO <<07114>>20515000
      BEGIN   << Start pre-read on this buffer.             >> <<07114>>20520000
      DATABUFD'SA := LOCAL'START'ADDR := LOCAL'START'ADDR +    <<07114>>20525000
         DOUBLE (WORD'COUNT / WORDSPERSECTR);                  <<07114>>20530000
      LIMIT'WORD'COUNT;   << Don't exceed end of medium.    >> <<07114>>20535000
      START'IO;                                                <<07114>>20540000
      BUMP'CURRENT'BUFFER;                                     <<07114>>20545000
      BUFFER'COUNT := BUFFER'COUNT + 1;                        <<07114>>20550000
      END;    << Start pre-read on this buffer.             >> <<07114>>20555000
                                                               <<07114>>20560000
<< At this point we should be doing I/O on all buffers. The >> <<07114>>20565000
<< only excuse for not doing so  (WORD'COUNT  =  0)  should >> <<07114>>20570000
<< rarely  happen,  since  this  indicates the previous I/O >> <<07114>>20575000
<< ended exactly at EODSECTR.                               >> <<07114>>20580000
                                                               <<07114>>20585000
   DATABUF'IN'USE := TRUE;                                     <<07114>>20590000
   WAIT'FOR'COMPLETION;   << And check for errors.          >> <<07114>>20595000
   END;   << This read fills a buffer.                      >> <<07114>>20600000
END;      << of READ'BUFFER.                                >> <<07114>>20605000
$PAGE "SDISC - READ ROUTINES"                                           20610000
PROCEDURE READBLOCK;                                                    20615000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>20620000
                                                                        20625000
COMMENT -- READBLOCK fills RECBUFF by reading physical  blocks <<03522>>20630000
from  the  serial  disc,  bypassing contiguous blocks and gaps <<03522>>20635000
(holes) as it reads.  Sector fill characters for EOT  and  EOF <<03522>>20640000
marks  and for the contiguous block interface are retained and <<03522>>20645000
are detected by READBLOCK callers.  At exit:                   <<03522>>20650000
  CURRENTBUFINDEX = 0,                                         <<03522>>20655000
  NEXTRECINBUF    = TRUE,                                      <<03522>>20660000
  WORDSINRECBUF   = RECBUFFLEN + 1 (or less, if  we  find  the <<03522>>20665000
                      end of valid data (EODTYPE) first).      <<03522>>20670000
READBLOCK begins at RECBUFFSA for all  tape  operations  which <<07114>>20675000
require  new  buffers  (BSF,  BSR, FSF and non-serial reads or <<07114>>20680000
FSRs) and at RECBUFFEA + 1D for serial reads.                  <<07114>>20685000
;                                                                       20690000
                                                                        20695000
BEGIN <<READBLOCK>>                                                     20700000
DOUBLE STARTSECTOR,                                                     20705000
       ENDSECTOR,                                                       20710000
       DERR;                                                            20715000
INTEGER OFFSET,                                                         20720000
        AVAILWORDC,                                                     20725000
        ERR1=DERR;                                                      20730000
                                                               <<07114>>20735000
DEFINE                                                         <<07114>>20740000
   FULL            = FALSE                  #,                 <<07114>>20745000
   PARTIAL         = TRUE                   #,                 <<07114>>20750000
   OFFSETSECTORLEN = OFFSET / WORDSPERSECTR #,                 <<07114>>20755000
   TRANSFERDONE    = GAPTYPE = EODTYPE      #;                 <<07114>>20760000
                                                                        20765000
OFFSET:=0;                                                              20770000
IF RECBUFFEA=-1D THEN                                                   20775000
   RECBUFFEA := RECBUFFSA - 1D  << Non-serial access.       >> <<07114>>20780000
ELSE                                                                    20785000
   RECBUFFSA := RECBUFFEA + 1D; << Serial read.             >> <<07114>>20790000
DO                                                                      20795000
   BEGIN <<TRY TO READ BLOCK FROM DISC>>                                20800000
   ENDGAP := RECBUFFEA;   << Prime ENDGAP for DO stmt below >> <<03522>>20805000
   STARTSECTOR:=RECBUFFEA:=RECBUFFEA+1D;                       <<00494>>20810000
   ENDSECTOR:=STARTSECTOR+DOUBLE(RECBUFFSECTORLEN)-            <<00494>>20815000
     DOUBLE(OFFSETSECTORLEN) - 1D;                                      20820000
   DO                                                                   20825000
      BEGIN                                                             20830000
                                                                        20835000
<< This section skips any contiguous blocks  or  holes  be- >>          20840000
<< tween the current STARTSECTOR and ENDSECTOR.  Fill char- >>          20845000
<< acters for an EOF or EOT  mark  or  for  the  contiguous >>          20850000
<< block interface are retained, since they are part of the >>          20855000
<< buffer in any calculations dealing with start of block.  >>          20860000
                                                                        20865000
      STARTSECTOR := ENDGAP + 1D;                              <<03522>>20870000
      SDISCFINDGAP(STARTSECTOR,ENDSECTOR);                              20875000
      END   << This section skips...                        >>          20880000
     UNTIL GAPTYPE <> EOFTYPE AND GAPTYPE <> EOTTYPE;          <<03522>>20885000
   IF STARTGAP=-1D THEN                                                 20890000
      BEGIN   << Transfer all or remainder of block.        >> <<03522>>20895000
COMMENT                                                        <<03522>>20900000
  On exit from READBLOCK, RECBUFFSA should point to the  first <<03522>>20905000
sector  actually  put in RECBUFF.  The statement below assures <<03522>>20910000
this in the case where a contiguous block or hole  existed  at <<03522>>20915000
the original RECBUFFSA.                                        <<03522>>20920000
;                                                              <<03522>>20925000
      IF OFFSET = 0 THEN RECBUFFSA := RECBUFFEA;               <<03522>>20930000
      READ'BUFFER (RECBUFFEA, OFFSET, RECBUFFLEN + 1 - OFFSET, <<07114>>20935000
                   FULL);   << Not a partial read.          >> <<07114>>20940000
      IF SDERR THEN RETURN;                                    <<07114>>20945000
      RECBUFFEA:=ENDSECTOR;                                    <<00494>>20950000
      CURRENTBUFINDEX:=0;                                               20955000
      NEXTRECINBUF:=TRUE;                                               20960000
      WORDSINRECBUF:=RECBUFFLEN+1;                                      20965000
      RETURN;   << This is normal exit.                     >>          20970000
      END   << Transfer all or remainder of block.          >> <<03522>>20975000
   ELSE                                                        <<03522>>20980000
      BEGIN <<GAP IN AREA>>                                             20985000
                                                               <<03522>>20990000
<< AVAILWORDC is the word count of the partial  block  read >> <<03522>>20995000
<< we  will  perform this time, namely the area from START- >> <<03522>>21000000
<< SECTOR to STARTGAP-1 (that is, to the sector before  the >> <<03522>>21005000
<< hole, contiguous block or end-of-data we just detected.  >> <<03522>>21010000
                                                               <<03522>>21015000
      AVAILWORDC:=INTEGER(STARTGAP-RECBUFFEA)*WORDSPERSECTR;   <<02025>>21020000
      IF AVAILWORDC+OFFSET>RECBUFFLEN+1 THEN                            21025000
         BEGIN   << 10 pounds for a five pound bag.         >>          21030000
         ERRORCODE := SDERR31;                                 <<07114>>21035000
         RETURN;                                                        21040000
         END;                                                           21045000
      IF AVAILWORDC>0 THEN                                              21050000
         BEGIN   << Transfer partial block from disc.       >> <<03522>>21055000
         IF OFFSET = 0 THEN RECBUFFSA := RECBUFFEA;            <<03522>>21060000
         READ'BUFFER (RECBUFFEA, OFFSET, AVAILWORDC, PARTIAL); <<07114>>21065000
         IF SDERR THEN RETURN;                                 <<07114>>21070000
         OFFSET:=OFFSET+AVAILWORDC;                                     21075000
         END;   << Transfer partial block from disc.        >> <<03522>>21080000
      RECBUFFEA:=ENDGAP;                                       <<00494>>21085000
      END;  <<GAP IN AREA>>                                             21090000
   END   <<TRY TO READ BLOCK FROM DISC>>                                21095000
                                                               <<03522>>21100000
<< The only time the loop terminating  condition  below  is >> <<03522>>21105000
<< satisfied is when the end of valid data (EODTYPE) is de- >> <<03522>>21110000
<< tected.  Only for this condition will  RECBUFF  be  less >> <<03522>>21115000
<< than  full on exit.  For all other non-error conditions, >> <<03522>>21120000
<< READBLOCK exits above with RECBUFF  full  (WORDSINRECBUF >> <<03522>>21125000
<< := RECBUFFLEN + 1). In the special case where we read no >> <<03522>>21130000
<< data at all (OFFSET = 0), we were already at the end  of >> <<03522>>21135000
<< data  when  we entered READBLOCK.  Thus we are trying to >> <<03522>>21140000
<< read beyond the end of data, ordinarily  an  error.  But >> <<03522>>21145000
<< the File System does this regularly as part of its anti- >> <<03522>>21150000
<< cipatory read algorithm. So we assume all such reads are >> <<03522>>21155000
<< due to this and return a non-fatal error code.           >> <<03522>>21160000
                                                               <<03522>>21165000
  UNTIL TRANSFERDONE;                                                   21170000
WORDSINRECBUF:=OFFSET;                                                  21175000
CURRENTBUFINDEX:=0;                                                     21180000
IF OFFSET=0 THEN                                               <<02025>>21185000
   ERRORCODE := SDERR122    <<SIGNAL FILESYSTEM THAT THIS>>    <<07114>>21190000
     <<ANTICIPATORY READ WAS BEYOND THE PHYSICAL END OF DATA>> <<02025>>21195000
ELSE                                                           <<02025>>21200000
   NEXTRECINBUF:=TRUE;  <<THERE IS ACTUALLY VALID DATA IN THE>><<02025>>21205000
                        <<BUFFER>>                             <<02025>>21210000
END;  <<READBLOCK>>                                                     21215000
$PAGE                                                          <<03522>>21220000
PROCEDURE BACKBLOCKREAD;                                                21225000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>21230000
                                                               <<03522>>21235000
  COMMENT -- BACKBLOCKREAD reads the previous  physical  block <<03522>>21240000
of the serial disc into RECBUFF. Knowing RECBUFFSA, the start- <<03522>>21245000
ing address of the current RECBUFF contents, it calculates the <<03522>>21250000
starting address required by READBLOCK to  make  the  previous <<03522>>21255000
block present, then calls READBLOCK. Since READBLOCK skips any <<03522>>21260000
contiguous block or hole gaps, BACKBLOCKREAD must also account <<03522>>21265000
for these when determining where READBLOCK is to start.        <<03522>>21270000
  BACKBLOCKREAD starts by checking for block or hole  gaps  in <<03522>>21275000
the  previous  physical  block.  If it finds none, the task is <<03522>>21280000
easy.  If it finds one or more,  it  accumulates  their  total <<03522>>21285000
length  in  GAPCOUNT, then repeats the search in GAPCOUNT sec- <<03522>>21290000
tors before the one it just tried.  The process repeats  until <<03522>>21295000
no  gaps are found, then READBLOCK is called.  Since READBLOCK <<03522>>21300000
performs the inverse process of deleting gaps, the  result  is <<03522>>21305000
usually a full RECBUFF.                                        <<03522>>21310000
  Boundary conditions may cause trouble.  If  the  load  point <<03522>>21315000
(BOT) is detected while scanning backward, the scan is aborted <<03522>>21320000
and READBLOCK will read a full RECBUFF (or until  end-of-data) <<03522>>21325000
from  there.  The  previous  block boundary is lost unless the <<03522>>21330000
load point happens to coincide with a block boundary.  To help <<03522>>21335000
callers adjust for this condition, the sector  difference  be- <<03522>>21340000
tween  the  load  point and the would-be start of the previous <<03522>>21345000
block is returned in the global value  RTV3  (because  of  our <<03522>>21350000
split-stack mode of operation), disguised as BOT'SECTOR'COUNT. <<03522>>21355000
;                                                              <<03522>>21360000
BEGIN <<BACKBLOCKREAD>>                                                 21365000
INTEGER                                                                 21370000
  DATA'SECTORS,   << No. of data sctrs read by READBLOCK.   >> <<03522>>21375000
  GAPCOUNT;   << No. sectors in search area that have gaps. >> <<03522>>21380000
DOUBLE  ENDSECTOR,                                             <<03522>>21385000
        STARTSECTOR,                                                    21390000
        LASTSTARTSECTOR;                                       <<03522>>21395000
                                                               <<03522>>21400000
DATA'SECTORS := 0;                                             <<03522>>21405000
ENDSECTOR:=RECBUFFSA-1D;                                       <<00494>>21410000
LASTSTARTSECTOR := STARTSECTOR := RECBUFFSA -                  <<03522>>21415000
                   DOUBLE (RECBUFFSECTORLEN);                  <<03522>>21420000
BACKSPACING := TRUE;   << For new SDISC'FINDGAP.            >> <<07114>>21425000
DO BEGIN   << This loop never falls through.                >> <<03522>>21430000
   GAPCOUNT := 0;                                              <<03522>>21435000
                                                               <<03522>>21440000
<< Don't extend backward search beyond load point (BOT).    >> <<03522>>21445000
                                                               <<03522>>21450000
   IF STARTSECTOR < DOUBLE (STARTADDRESS) THEN                 <<03522>>21455000
      LASTSTARTSECTOR := STARTSECTOR := DOUBLE (STARTADDRESS); <<03522>>21460000
   ENDGAP := STARTSECTOR - 1D;   << Prime for DO stmt below >> <<03522>>21465000
   DO BEGIN   << Find all gaps in current search area.      >> <<03522>>21470000
      DO BEGIN   << Find one gap.                           >> <<03522>>21475000
                                                               <<03522>>21480000
<< This section skips any contiguous blocks  or  holes  be- >> <<03522>>21485000
<< tween the current STARTSECTOR and ENDSECTOR.  Fill char- >> <<03522>>21490000
<< acters for an EOF or EOT  mark  or  for  the  contiguous >> <<03522>>21495000
<< block interface are retained, since they are part of the >> <<03522>>21500000
<< buffer in any calculations dealing with start of block.  >> <<03522>>21505000
                                                               <<03522>>21510000
         STARTSECTOR := ENDGAP + 1D;                           <<03522>>21515000
         SDISCFINDGAP (STARTSECTOR, ENDSECTOR);                <<03522>>21520000
         END   << Find one gap.                             >> <<03522>>21525000
        UNTIL GAPTYPE <> EOFTYPE AND GAPTYPE <> EOTTYPE;       <<03522>>21530000
      IF STARTGAP <> -1D THEN   << Found a gap.             >> <<03522>>21535000
        GAPCOUNT := GAPCOUNT + INTEGER(ENDGAP - STARTGAP) + 1; <<03522>>21540000
      END   << Find all gaps in current search area.        >> <<03522>>21545000
     UNTIL STARTGAP = -1D;                                     <<03522>>21550000
                                                               <<03522>>21555000
<< The following code accounts for any gaps in the  current >> <<03522>>21560000
<< search  area,  and also updates the total number of data >> <<03522>>21565000
<< sectors to be read by READBLOCK.  This is needed for our >> <<03522>>21570000
<< load point checking.  In a few lines, when it is time to >> <<03522>>21575000
<< call READBLOCK, if there is no data to be read it  indi- >> <<03522>>21580000
<< cates  that  the  caller  is trying to backspace from in >> <<03522>>21585000
<< front of the first accessible  (that  is,  non-block  or >> <<03522>>21590000
<< -hole)  record.  Doing this on a tape places the user at >> <<03522>>21595000
<< load point, but does not otherwise change the  situation >> <<03522>>21600000
<< (that  is,  the next read, write or (forward) space will >> <<03522>>21605000
<< still access the first record).  We also set BOT status. >> <<03522>>21610000
<< A backspace attempt while at BOT is an  error  (detected >> <<03522>>21615000
<< by CTRLSDISC).                                           >> <<03522>>21620000
                                                               <<03522>>21625000
   DATA'SECTORS := DATA'SECTORS + INTEGER (ENDSECTOR -         <<03522>>21630000
                   LASTSTARTSECTOR) + 1 - GAPCOUNT;            <<03522>>21635000
   ENDSECTOR := LASTSTARTSECTOR - 1D;                          <<03522>>21640000
   STARTSECTOR := LASTSTARTSECTOR := LASTSTARTSECTOR -         <<03522>>21645000
     DOUBLE (GAPCOUNT);                                        <<03522>>21650000
   IF GAPCOUNT = 0 THEN                                        <<03522>>21655000
      BEGIN   << Found starting point or load point.        >> <<03522>>21660000
                                                               <<03522>>21665000
<< If DATA'SECTORS is less than READBUFFSECTORLEN, it means >> <<03522>>21670000
<< we hit the load point and that READBLOCK will cause data >> <<03522>>21675000
<< in RECBUFF to be offset by the  difference  between  the >> <<03522>>21680000
<< two.  If DATA'SECTORS is 0, there is no data between our >> <<03522>>21685000
<< current position  and  the  load  point,  and  READBLOCK >> <<03522>>21690000
<< shouldn't even be called.                                >> <<03522>>21695000
                                                               <<03522>>21700000
      IF DATA'SECTORS = 0 THEN                                 <<03522>>21705000
         BEGIN   << No data found, must be load point.      >> <<03522>>21710000
         BOT'SENSOR := BOT'FOUND;                              <<03522>>21715000
         TAPEREWOUND := TRUE;                                  <<07114>>21720000
         CURRENTGPTENT := GPT'START;                           <<07114>>21725000
         BACKSPACING := FALSE;                                 <<07114>>21730000
         RETURN;   << Don't change any pointers.            >> <<03522>>21735000
         END;                                                  <<03522>>21740000
      RECBUFFEA:=-1D;                                                   21745000
      RECBUFFSA:=STARTSECTOR;                                  <<00494>>21750000
      NEXTRECINBUF:=FALSE;                                     <<00494>>21755000
      READBLOCK;                                                        21760000
      BOT'SECTOR'COUNT := RECBUFFSECTORLEN - DATA'SECTORS;     <<03522>>21765000
      BACKSPACING := FALSE;                                    <<07114>>21770000
      RETURN;   << This is normal exit.                     >>          21775000
      END;                                                              21780000
   END   << This loop never falls through.                  >> <<03522>>21785000
  UNTIL FALSE;                                                 <<03522>>21790000
END;  <<BACKBLOCKREAD>>                                                 21795000
$PAGE                                                          <<03522>>21800000
PROCEDURE READSDISC;                                           <<03522>>21805000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>21810000
                                                                        21815000
COMMENT:                                                                21820000
   THIS PROCEDURE IS TO TRANSFER THE NEXT LOGICAL RECORD                21825000
   FROM THE SERIAL DISC TO THE USER'S BUFFER.  IF ALL OR                21830000
   PART OF THE LOGICAL RECORD IS DISC RESIDENT, IT WILL                 21835000
   INITIATE A PHYSICAL TRANSFER OF THE NEXT BLOCK.;                     21840000
                                                                        21845000
BEGIN <<READSDISC>>                                                     21850000
                                                               <<06745>>21855000
<< The following two declarations are required by the PXGLO->> <<06745>>21860000
<< BAL $INCLUDE file.  See comments there for details.      >> <<06745>>21865000
                                                               <<06745>>21870000
LOGICAL ARRAY                                                  <<06745>>21875000
   QARRAY(*) = Q + 0;                                          <<06745>>21880000
                                                               <<06745>>21885000
INTEGER                                                        <<06745>>21890000
   PCBGLOBLOC;                                                 <<06745>>21895000
                                                               <<06745>>21900000
INTEGER NEXTWORD,                                              <<07114>>21905000
        ENTRYINDEX,                                            <<03522>>21910000
        RECLEN,                                                         21915000
        COUNT,         << Word count left to be moved.      >> <<06745>>21920000
        TEMP'ADDR,                                             <<06745>>21925000
        BYTEC,                                                          21930000
        TRANSFERC,                                                      21935000
        TRANSFERLENGTH;                                                 21940000
DOUBLE STARTSECTOR,                                                     21945000
       ENDSECTOR;                                                       21950000
LOGICAL                                                        <<00494>>21955000
        NEXTBUFINDEX,                                          <<07114>>21960000
        TRANSFERMODE,                                                   21965000
        TRANSFERCOMPLETE;                                               21970000
DEFINE  BYTES =TRUE#;                                          <<03522>>21975000
                                                               <<06745>>21980000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<06745>>21985000
                                                               <<06745>>21990000
SUBROUTINE DEF'MOVETODSEG;                                     <<06745>>21995000
                                                               <<06745>>22000000
SUBROUTINE DEF'MOVEDSEG;                                       <<07114>>22005000
                                                               <<07114>>22010000
PXGLOBAL;   << Required by the PXGLOBAL $INCLUDE file.      >> <<06745>>22015000
IF TAPEWRITTEN THEN                                                     22020000
   BEGIN <<ATTEMPTED TO READ BEYOND VALID DATA>>                        22025000
   ERRORCODE := SDERR22;                                       <<07114>>22030000
   RETURN;                                                              22035000
   END;  <<ATTEMPTED TO READ PAST VALID DATA>>                          22040000
IF CNT = 0 THEN NULLTRANSFER := TRUE;   << Becomes FSR.     >> <<06745>>22045000
                                                               <<03522>>22050000
REREAD:                                                        <<00189>>22055000
                                                               <<03522>>22060000
IF FLAGS.SYSBUFRS = 1 AND CNT <> 0 THEN                        <<M7491>>22065000
   BEGIN   << System buffers not allowed.                   >> <<07065>>22070000
   ERRORCODE := SDERR1;                                        <<07065>>22075000
   RETURN;                                                     <<07065>>22080000
   END;                                                        <<07065>>22085000
IF NOT NEXTRECINBUF THEN                                                22090000
   BEGIN <<PERFORM PHYSICAL TRANSFER>>                                  22095000
   READBLOCK;                                                           22100000
   IF SDERR THEN RETURN;                                                22105000
   END;  <<PERFORM PHYSICAL TRANSFER>>                                  22110000
IF CURRENTBUFINDEX>=WORDSINRECBUF THEN                                  22115000
   BEGIN                                                                22120000
   ERRORCODE := SDERR23;                                       <<07114>>22125000
   RETURN;                                                              22130000
   END;                                                                 22135000
STARTSECTOR := ACTUAL'ADDRESS;   << To verify EOF/T later.  >> <<03522>>22140000
RECLEN := GETRECBUFF (CURRENTBUFINDEX);                        <<07114>>22145000
IF EOT'MARK <= RECLEN <= EOF'MARK THEN                         <<03522>>22150000
   BEGIN COMMENT -- Handle special cases here:                 <<03522>>22155000
                                                               <<03522>>22160000
1.  RECLEN = -2 (EOT'MARK).  Verify that the  Gap  Table  also <<03522>>22165000
    shows  an  EOT here, then read next record since EOT's are <<03522>>22170000
    invisible during reads.  This section is left in for  com- <<03522>>22175000
    patibility  with  older serial discs.  The EOT'MARK is now <<04742>>22180000
    written only to floppy discs, and only for use by INITIALs <<04742>>22185000
    version of serial disc code. The EOT'MARK is ignored here. <<04742>>22190000
2.  RECLEN = -1 (FILLCHAR).  Since  contiguous  blocks  always <<03522>>22195000
    start on a sector boundary, FILLCHARs are used as required <<03522>>22200000
    to fill out the previous sector. This section merely skips <<03522>>22205000
    them, then reads the next  record  (since  the  contiguous <<03522>>22210000
    blocks themselves are only in RECBUFF while being written. <<03522>>22215000
3.  RECLEN = 0 (EOF'MARK).  Verify that  the  Gap  Table  also <<03522>>22220000
    shows an EOF here and return EOF status to the caller.     <<03522>>22225000
;                                                              <<03522>>22230000
   ERRORCODE:=SDERR0;                                                   22235000
   CURRENTBUFINDEX:=(CURRENTBUFINDEX/WORDSPERSECTR+1)*                  22240000
     WORDSPERSECTR;   << Make sure we skip rest of sector.  >>          22245000
   IF CURRENTBUFINDEX>=WORDSINRECBUF THEN                               22250000
      NEXTRECINBUF:=FALSE;                                              22255000
   IF RECLEN <> FILLCHAR THEN                                  <<03522>>22260000
      BEGIN   << Verify that we really have EOF/EOT here.   >> <<03522>>22265000
      SDISCFINDGAP (STARTSECTOR, STARTSECTOR);                 <<03522>>22270000
      IF RECLEN = EOF'MARK AND GAPTYPE = EOFTYPE               <<03522>>22275000
        OR RECLEN = EOT'MARK AND GAPTYPE = EOTTYPE             <<03522>>22280000
        THEN                                                   <<03522>>22285000
           BEGIN  << Found EOF/T that got us here.          >>          22290000
           ENDINDEX := ENDINDEX + GPTENTSIZE;                  <<03522>>22295000
           GPTMOD (UPDT'FOR'READ'OP);                          <<03522>>22300000
           IF SDERR THEN RETURN;                               <<03522>>22305000
           END                                                          22310000
        ELSE                                                            22315000
           BEGIN   << Belt but no suspenders -- lose pants. >>          22320000
           ERRORCODE := SDERR17;                               <<07114>>22325000
           RETURN;                                                      22330000
           END;                                                         22335000
      END;    << Verify that we really have EOF/EOT here.   >> <<03522>>22340000
                                                                        22345000
<< The EOT reflector and contiguous block  fill  characters >> <<00189>>22350000
<< are invisible during a read.                             >> <<00189>>22355000
                                                                        22360000
   IF RECLEN <> EOF'MARK THEN GO REREAD;                       <<03522>>22365000
   EOFCODE := HARDWARE'EOF;                                    <<03522>>22370000
   GO EXIT;                                                    <<03733>>22375000
   END;   << Handle special cases here.                     >> <<03522>>22380000
NEXTWORD:=CURRENTBUFINDEX+1;                                            22385000
                                                               <<03522>>22390000
  COMMENT -- As with mag tape, distinguish between the  actual <<03522>>22395000
size  of  the record in the buffer (RECLEN) and the user's re- <<03522>>22400000
quest length (CNT).  Limit the transfer to MIN (RECLEN,  CNT), <<03522>>22405000
but be sure to position CURRENTBUFINDEX to the actual start of <<03522>>22410000
the next record in RECBUFF.                                    <<03522>>22415000
  If the disc has been trashed, the RECLEN we read here has  a <<04742>>22420000
random value.  Since it is treated as integer here, it may ap- <<04742>>22425000
pear to be < 0 when TRANSFERC is initialized a few lines  from <<04742>>22430000
here,  and would win when compared with BYTEC.  When TRANSFERC <<04742>>22435000
is later used as a positive byte count to  move  data  to  the <<04742>>22440000
caller's buffer, half a memory bank would be clobbered result- <<04742>>22445000
ing in any number of system failures.  The next line  of  code <<04742>>22450000
prevents  this.  Note  that  a RECLEN of -1 or -2 is O.K., but <<04742>>22455000
that has already been dealt with before now.  Also,  a  random <<04742>>22460000
RECLEN  >  0  will  lose when compared with BYTEC, so will not <<04742>>22465000
cause massive system amnesia.                                  <<04742>>22470000
;                                                              <<03522>>22475000
IF RECLEN < 0 THEN                                             <<04742>>22480000
   BEGIN                                                       <<04742>>22485000
   ERRORCODE := SDERR22;                                       <<07114>>22490000
   RETURN;                                                     <<04742>>22495000
   END;                                                        <<04742>>22500000
NEXTBUFINDEX:=CURRENTBUFINDEX+(RECLEN+1)&LSR(1)+2;                      22505000
IF CNT<0 THEN TRANSFERMODE:=BYTES; <<TRUE>>                             22510000
BYTEC:=IF CNT<0 THEN -CNT ELSE CNT&LSL(1);                              22515000
TRANSFERC:=IF BYTEC>RECLEN THEN RECLEN ELSE BYTEC;                      22520000
XMITLOG:=IF CNT<0 THEN -TRANSFERC ELSE                                  22525000
  (TRANSFERC+1) & LSR(1);                                               22530000
IF NULLTRANSFER THEN TRANSFERC := RECLEN;                      <<06745>>22535000
TRANSFERCOMPLETE:=FALSE;                                                22540000
IF DSTX=USERSTACK THEN                                                  22545000
   DBOFFSET := PXG'RELATIVE'DB                                 <<06745>>22550000
ELSE                                                                    22555000
   DBOFFSET:=0;                                                         22560000
TEMP'ADDR := ADDR;                                             <<06745>>22565000
DO BEGIN   << Move record to user's buffer.                 >> <<06745>>22570000
   IF WORDSINRECBUF - CURRENTBUFINDEX >                        <<07114>>22575000
      (TRANSFERC + 1) & LSR(1) THEN                            <<07114>>22580000
         BEGIN   << Transfer can be completed.              >> <<06745>>22585000
         IF NOT NULLTRANSFER THEN                              <<06745>>22590000
            BEGIN   << Function is READ, not FSR.           >> <<06745>>22595000
            COUNT := TRANSFERC & LSR(1);  << For odd byte.  >> <<06745>>22600000
            MOVEDSEG (DSTX, TEMP'ADDR + DBOFFSET,              <<07114>>22605000
                     DATABUF'DST, NEXTWORD, COUNT);            <<07114>>22610000
            IF TRANSFERMODE AND LOGICAL (TRANSFERC) THEN       <<06745>>22615000
               BEGIN                                           <<06745>>22620000
                                                               <<06745>>22625000
  COMMENT -- Users can request a byte  transfer  with  an  odd <<06745>>22630000
number  of bytes.  The only time this causes us problems is if <<06745>>22635000
the requested length (CNT) is  less  than  the  actual  record <<06745>>22640000
length (RECLEN).  (If RECLEN is smaller there's no problem be- <<06745>>22645000
cause we always write to a  word  boundary).  The  code  below <<06745>>22650000
merges  the last (odd) byte of such a transfer with the exist- <<06745>>22655000
ing right byte in the user's buffer, then writes the word back <<06745>>22660000
leaving the right byte unchanged.                              <<06745>>22665000
;                                                              <<06745>>22670000
               MOVEFROMDSEG (@TEMP, DSTX, TEMP'ADDR + DBOFFSET <<06745>>22675000
                             + COUNT, 1);                      <<06745>>22680000
               TEMP.(0:8) :=                                   <<07114>>22685000
                  GETRECBUFF (NEXTWORD+COUNT+1).(0:8);         <<07114>>22690000
               MOVETODSEG (DSTX, TEMP'ADDR + DBOFFSET + COUNT, <<06745>>22695000
                           @TEMP, 1);                          <<06745>>22700000
               END;   << Move last (odd) byte.              >> <<06745>>22705000
            END;      << Function is READ, not FSR.         >> <<06745>>22710000
         TRANSFERCOMPLETE := TRUE;                             <<06745>>22715000
         IF NEXTBUFINDEX > LOGICAL (WORDSINRECBUF) THEN        <<07114>>22720000
            BEGIN   << Next record not in buf, do pre-read. >> <<06745>>22725000
            NEXTBUFINDEX := NEXTBUFINDEX -                     <<07114>>22730000
               LOGICAL (WORDSINRECBUF);                        <<07114>>22735000
            READBLOCK;                                         <<06745>>22740000
            IF SDERR THEN RETURN;                              <<06745>>22745000
            END;                                               <<06745>>22750000
         END   << Transfer can be completed.                >> <<06745>>22755000
   ELSE                                                                 22760000
      BEGIN   << Transfer remainder of RECBUFF.             >>          22765000
      TRANSFERLENGTH := WORDSINRECBUF - NEXTWORD;              <<06745>>22770000
      IF NOT NULLTRANSFER THEN                                 <<06745>>22775000
         MOVEDSEG (DSTX, TEMP'ADDR + DBOFFSET,                 <<07114>>22780000
             DATABUF'DST, NEXTWORD, TRANSFERLENGTH);           <<07114>>22785000
      NEXTBUFINDEX := NEXTBUFINDEX - LOGICAL (WORDSINRECBUF);  <<07114>>22790000
      READBLOCK;                                                        22795000
      IF SDERR THEN RETURN;                                    <<00189>>22800000
      NEXTWORD := 0;                                                    22805000
      TRANSFERC := TRANSFERC - TRANSFERLENGTH & LSL(1);                 22810000
      TEMP'ADDR := TEMP'ADDR + TRANSFERLENGTH;                 <<06745>>22815000
      END;  << Transfer remainder of RECBUFF.               >>          22820000
   END   << Transfer record to user buffer.                 >>          22825000
  UNTIL TRANSFERCOMPLETE;                                               22830000
IF NEXTBUFINDEX >= LOGICAL (WORDSINRECBUF) THEN                <<07114>>22835000
  NEXTRECINBUF := FALSE;                                                22840000
IF NEXTBUFINDEX > 0 THEN                                       <<03640>>22845000
   IF NEXTBUFINDEX < LOGICAL (WORDSINRECBUF) THEN              <<07114>>22850000
      IF INTEGER (GETRECBUFF (NEXTBUFINDEX-1)) <> RECLEN THEN  <<07114>>22855000
         BEGIN   << Leading & trailing RECLEN's don't match >>          22860000
         ERRORCODE := -SDERR30;                                <<07114>>22865000
         GO EXIT;                                              <<06745>>22870000
         END;                                                           22875000
CURRENTBUFINDEX := NEXTBUFINDEX;                               <<03640>>22880000
                                                               <<03522>>22885000
<< Since holes and contiguous blocks are not placed in REC- >> <<03522>>22890000
<< BUFF, the just-completed read may have taken us over one >> <<03522>>22895000
<< or more of them. This code makes sure that CURRENTGPTENT >> <<03522>>22900000
<< is updated appropriately.                                >> <<03522>>22905000
                                                               <<03522>>22910000
ENTRYINDEX := -1;   << In case we don't find any gaps.      >> <<03522>>22915000
STARTSECTOR := RECBUFFSA;                                      <<03522>>22920000
ENDSECTOR := ACTUAL'ADDRESS - 1D;                              <<03522>>22925000
DO BEGIN   << This loop skips one hole or block.            >> <<03522>>22930000
   SDISCFINDGAP (STARTSECTOR, ENDSECTOR);                      <<03522>>22935000
   STARTSECTOR := ENDGAP + 1D;                                 <<03522>>22940000
   IF STARTGAP <> -1D THEN ENTRYINDEX := ENDINDEX;             <<03522>>22945000
   END                                                         <<03522>>22950000
  UNTIL STARTGAP = -1D;   << Scanned all pertinent entries. >> <<03522>>22955000
IF ENTRYINDEX <> -1 THEN                                       <<03522>>22960000
   BEGIN   << Found some kind of entry.                     >> <<03522>>22965000
   ENDINDEX := ENTRYINDEX + GPTENTSIZE;                        <<03522>>22970000
   GPTMOD (UPDT'FOR'READ'OP);                                  <<03522>>22975000
   IF SDERR THEN RETURN;                                       <<03522>>22980000
   END;                                                        <<03522>>22985000
                                                               <<03522>>22990000
EXIT:                                                          <<03733>>22995000
                                                               <<03733>>23000000
NULLTRANSFER := FALSE;                                         <<06745>>23005000
TAPEREWOUND := FALSE;   << Make sure we get off Load Point. >> <<03733>>23010000
CHECK'FOR'EOT;   << Set EOTSENSOR if we passed over EOT.    >> <<03522>>23015000
BOT'SENSOR := BOT'NOT'FOUND;                                   <<03522>>23020000
END;  <<READSDISC>>                                                     23025000
$PAGE "SDISC - WRITE ROUTINES"                                          23030000
PROCEDURE CHECK'WRITE'RING;                                    <<03522>>23035000
  OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                     <<06745>>23040000
                                                               <<03522>>23045000
BEGIN COMMENT --                                               <<03522>>23050000
  Checks for a "write ring" (meaning, the operator has allowed <<03522>>23055000
writing in the :REPLY), notifies the operator if the "ring" is <<03522>>23060000
missing and asks him/her to O.K. writing. The two messages are <<03522>>23065000
only displayed once per serial disc open.  This code was moved <<03522>>23070000
unaltered from both the RITESDISC and CTRLSDISC procedures.    <<03522>>23075000
;                                                              <<03522>>23080000
INTEGER                                                                 23085000
  QDSTN,    << Q-relative SDI data segment number.          >>          23090000
  QLDNUM;   << Q-relative LDEV number of serial disc.       >>          23095000
                                                                        23100000
IF NOT WRITERING THEN                                                   23105000
   BEGIN                                                                23110000
   QDSTN := DSTN;                                                       23115000
   QLDNUM := LDNUM;                                                     23120000
   IF NOT ALREADYREJECTED THEN                                 <<00189>>23125000
      BEGIN   << Haven't been here before, ask op for ring. >> <<00189>>23130000
      EXCHANGEDB (0);                                          <<00189>>23135000
      GENMSG (SET1,MESS220,%10000,QLDNUM,,,,,0); << No ring >> <<00189>>23140000
      GENMSG (SET1, MESS274, %10000, QLDNUM,,,,,0, 1,          <<00189>>23145000
        @WRITERING, QDSTN);   << Do you want one? (Y/N)     >> <<00189>>23150000
      EXCHANGEDB (QDSTN);                                      <<00189>>23155000
      END;                                                     <<00189>>23160000
   IF NOT WRITERING THEN                                                23165000
      BEGIN   << Operator said NO.                          >>          23170000
      ERRORCODE := SDERR40;                                    <<07114>>23175000
      ALREADYREJECTED := TRUE;   << Don't come back.        >> <<00189>>23180000
      END;                                                              23185000
   END;                                                                 23190000
END;   << of CHECK'WRITE'RING.                              >> <<03522>>23195000
$PAGE                                                          <<03522>>23200000
$PAGE " *** Procedure WRITE'BUFFER *** "                       <<07114>>23205000
PROCEDURE WRITE'BUFFER (LENGTH);                               <<07114>>23210000
   VALUE   LENGTH;                                             <<07114>>23215000
   INTEGER LENGTH;                                             <<07114>>23220000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>23225000
                                                               <<07114>>23230000
BEGIN COMMENT --                                               <<07114>>23235000
  WRITE'BUFFER handles physical I/O and buffer management  for <<07114>>23240000
SDISC  data  write operations (including contiguous blocks and <<07114>>23245000
EOF, EOT and contiguous  block  fill  characters).  Gap  Table <<07114>>23250000
writes  (with wait) are handled elsewhere.  Writes in here are <<07114>>23255000
done unblocked (without wait).                                 <<07114>>23260000
  Physical I/O is performed when a buffer is filled or when  a <<07114>>23265000
user performs a non-write operation following a write.         <<07114>>23270000
  We do two checks of user parameters.  One is that LENGTH  is <<07114>>23275000
an integral multiple of WORDSPERSECTR. This is a holdover from <<07114>>23280000
original SDISC and is retained only because the associated er- <<07114>>23285000
ror message is documented in user manuals.  The other check is <<07114>>23290000
that the physical I/O does not extend  beyond  EODSECTR.  This <<07114>>23295000
keeps the driver and ATTACHIO happy.                           <<07114>>23300000
  The target address on the disc must be in DATABUFD'SA at en- <<07114>>23305000
try.  We calculate the disc address of the next buffer by add- <<07114>>23310000
ing the sectors represented by LENGTH to DATABUFD'SA.  The re- <<07114>>23315000
sult is placed in DATABUFD'SA of the next buffer.              <<07114>>23320000
  The integrated cartridge tape in the  7908,  7911,  7912  or <<07114>>23325000
7914  disc automatically generates spare blocks if an error is <<07114>>23330000
detected while writing.  Two sparing algorithms are available, <<07114>>23335000
selected  by the state of P1.(0:1) in the ATTACHIO write call. <<07114>>23340000
P1.(0:1) = 0 selects jump sparing, corresponding to track  re- <<07114>>23345000
assignment  in the 7920/7925, in which downstream data is pre- <<07114>>23350000
served at the cost of a non-sequential access  of  the  spared <<07114>>23355000
block.  P1.(0:1)  = 1 selects skip sparing, in which the erro- <<07114>>23360000
neous block is deleted from the address space (made invisible) <<07114>>23365000
and downstream addresses are adjusted accordingly.  This  pre- <<07114>>23370000
serves  sequential  access (important on a cartridge tape) but <<07114>>23375000
trashes all downstream data.                                   <<07114>>23380000
  Since we treat the cartridge tape like  a  conventional  mag <<07114>>23385000
tape, for which writing makes any existing downstream data in- <<07114>>23390000
accessible, skip sparing is the ideal choice in this  routine. <<07114>>23395000
The  routines  which  update the Gap Table, on the other hand, <<07114>>23400000
equire jump sparing, inefficient as it is, to  preserve  user <<FASTGF>>23405000
data is a Gap Table block should require sparing.              <<07114>>23410000
  Note that P1.(0:1) is only interpreted as a jump/skip choice <<07114>>23415000
when the cartridge tape is used.  For all disc devices, all of <<07114>>23420000
P1 is used as the upper word of the double disc address, as in <<07114>>23425000
the past.                                                      <<07114>>23430000
                                                               <<07114>>23435000
  Input:    The LENGTH, in words, of the current buffer to  be <<07114>>23440000
            written.  This  may be adjusted if the write would <<07114>>23445000
            extend beyond EODSECTR.                            <<07114>>23450000
                                                               <<07114>>23455000
  Returns:    No direct return, but SDERR should be checked.   <<07114>>23460000
              CURRENT'BUFFER is set to  the  next  BUFFER'INFO <<07114>>23465000
            block  to  be  used, and DATABUFD'SA is set in its <<07114>>23470000
            proper place in the new block.                     <<07114>>23475000
              The condition code is not changed.               <<07114>>23480000
                                                               <<07114>>23485000
  Errors:     SDERR4 if LENGTH is not an integral multiple  of <<07114>>23490000
            WORDSPERSECTR.  No data is written.                <<07114>>23495000
              SDERR7 if the  original  LENGTH  would  cause  a <<07114>>23500000
            write  beyond EODSECTR.  Data is written up to and <<07114>>23505000
            including EODSECTR before the error is returned.   <<07114>>23510000
              SDERR16 if writing is not  allowed  because  the <<07114>>23515000
            Read  Only  switch is set on the drive (7906/20/25 <<07114>>23520000
            only.                                              <<07114>>23525000
              SDERR20 if no available spare blocks on a  cart- <<07114>>23530000
            ridge tape.                                        <<07114>>23535000
              SDERR21 if a cartridge tape is uninitialized.    <<07114>>23540000
              SDERR29 for any other ATTACHIO error.            <<07114>>23545000
                                                               <<07114>>23550000
  Special considerations:  DB must be at SDISC's global varia- <<07114>>23555000
                           ble XDS, same at return.            <<07114>>23560000
                                                               <<07114>>23565000
  Called by:  CTRLSDISC, RITESDISC.                            <<07114>>23570000
                                                               <<07114>>23575000
  Calls:      ATACHIO, WAITFORIO.                              <<07114>>23580000
;                                                              <<07114>>23585000
EQUATE                                                         <<07114>>23590000
   BLANK'TAPE = %154,   << Cartridge tape ATTACHIO...       >> <<07114>>23595000
   NO'SPARES  = %164;   << ...failure codes.                >> <<07114>>23600000
                                                               <<07114>>23605000
DOUBLE                                                         <<07114>>23610000
   START'ADDRESS,                                              <<07114>>23615000
   TEMP'D;                                                     <<07114>>23620000
                                                               <<07114>>23625000
LOGICAL                                                        <<07114>>23630000
   START'ADDRESS0 = START'ADDRESS,                             <<07114>>23635000
   START'ADDRESS1 = START'ADDRESS0 + 1;                        <<07114>>23640000
                                                               <<07114>>23645000
IF LENGTH MOD WORDSPERSECTR <> 0 THEN                          <<07114>>23650000
   BEGIN                                                       <<07114>>23655000
   ERRORCODE := SDERR4;                                        <<07114>>23660000
   RETURN;                                                     <<07114>>23665000
   END;                                                        <<07114>>23670000
START'ADDRESS := DATABUFD'SA;                                  <<07114>>23675000
IF (TEMP'D := EODSECTR - START'ADDRESS + 1D) < DOUBLE          <<07114>>23680000
   (LENGTH / WORDSPERSECTR) THEN                               <<07114>>23685000
      BEGIN   << Error, and limit write to end of medium.   >> <<07114>>23690000
      LENGTH := INTEGER (TEMP'D) * WORDSPERSECTR;              <<07114>>23695000
      ERRORCODE := SDERR7;                                     <<07114>>23700000
      END;                                                     <<07114>>23705000
IF LENGTH > 0 THEN   << Not at end of medium.               >> <<07114>>23710000
   BEGIN                                                       <<07114>>23715000
   DATABUF'WORDS'IN'BUF := LENGTH;                             <<07114>>23720000
   TOS := ATACHIO (LDNUM, QMISC', DATABUF'DST, 0 <<seg base>>, <<07114>>23725000
          WRITE, LENGTH, START'ADDRESS0 LOR (CARTRIDGE'TAPE) & <<07114>>23730000
          LSL(15), START'ADDRESS1, UNBLOCKED);                 <<07114>>23735000
   DEL;                                                        <<07114>>23740000
   DATABUF'IOQX := TOS;                                        <<07114>>23745000
   DATABUF'DOING'IO := TRUE;                                   <<07114>>23750000
   DATABUFD'ATTIO'RETURN := NO'ATIOERROR;                      <<07114>>23755000
   END;                                                        <<07114>>23760000
BUMP'CURRENT'BUFFER;                                           <<07114>>23765000
IF DATABUF'DOING'IO THEN                                       <<07114>>23770000
   BEGIN   << Validate earlier I/O before re-using buffer.  >> <<07114>>23775000
   DATABUFD'ATTIO'RETURN := WAITFORIO (DATABUF'IOQX);          <<07114>>23780000
   DATABUF'FLAGS := 0;   << Clear Write, Doing'IO, In'Use.  >> <<07114>>23785000
   DATABUF'IOQX := 0;                                          <<07114>>23790000
   IF DATABUF'ATTIO'GENL'STATUS <> NORMAL'COMPLETION THEN      <<07114>>23795000
      BEGIN   << Bad news, decide which error to report.    >> <<07114>>23800000
      IF CARTRIDGE'TAPE THEN                                   <<07114>>23805000
         IF DATABUF'ATTIO'STATUS = NO'SPARES THEN              <<07114>>23810000
            ERRORCODE := SDERR20                               <<07114>>23815000
         ELSE IF DATABUF'ATTIO'STATUS = BLANK'TAPE THEN        <<07114>>23820000
            ERRORCODE := SDERR21                               <<07114>>23825000
         ELSE ERRORCODE := SDERR29       << Catch-all.      >> <<07114>>23830000
      ELSE                                                     <<07114>>23835000
         BEGIN   << See if Read Only switch is on (always.. >> <<07114>>23840000
         TOS := REQSTATUS (LDNUM);   << ...false for CS80). >> <<07114>>23845000
         IF TOS.(9:1)                                          <<07114>>23850000
            THEN ERRORCODE := SDERR16      << Read Only.    >> <<07114>>23855000
            ELSE ERRORCODE := SDERR29;     << Catch-all.    >> <<07114>>23860000
         DEL;                                                  <<07114>>23865000
         END;    << Read Only switch check.                 >> <<07114>>23870000
      END;       << ATTACHIO error.                         >> <<07114>>23875000
   END           << I/O in progress on buffer.              >> <<07114>>23880000
ELSE   << No I/O in progress, simulate normal completion.   >> <<07114>>23885000
   DATABUFD'ATTIO'RETURN := NO'ATIOERROR;                      <<07114>>23890000
RECBUFFSA := DATABUFD'SA := START'ADDRESS +                    <<07114>>23895000
             DOUBLE (LENGTH / WORDSPERSECTR);                  <<07114>>23900000
RECBUFFEA := -1D;                                              <<07114>>23905000
NEXTRECINBUF := FALSE;                                         <<07114>>23910000
CURRENTBUFINDEX := 0;                                          <<07114>>23915000
WORDSINRECBUF := DATABUF'WORDS'IN'BUF := 0;                    <<07114>>23920000
END;   << of WRITE'BUFFER                                   >> <<07114>>23925000
$PAGE " *** Procedure RITESDISC *** "                          <<07114>>23930000
PROCEDURE RITESDISC;                                                    23935000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>23940000
                                                                        23945000
COMMENT:                                                                23950000
   EXECUTE A LOGICAL TRANSFER OF ONE RECORD TO THE                      23955000
   SERIAL DISC.  IF THE SERIAL DISC BUFFER IS FILLED,                   23960000
   INITIATE A PHYSICAL TRANSFER.  HANDLE ENABLE/DISABLE                 23965000
   OF THE CONTIGUOUS BLOCK FEATURE.                                     23970000
SPECIAL CONTROL CODES:                                                  23975000
   %1001-START CONTIGUOUS BLOCK                                <<00079>>23980000
   %2001-END CONTIGUOUS BLOCK                                  <<00079>>23985000
   %3001-WRITE SPECIAL EOD MARK FOR USER LOGGING               <<06745>>23990000
;                                                                       23995000
  BEGIN <<RITESDISC>>                                                   24000000
                                                               <<06745>>24005000
<< The following two declarations are required by the PXGLO->> <<06745>>24010000
<< BAL $INCLUDE file.  See comments there for details.      >> <<06745>>24015000
                                                               <<06745>>24020000
LOGICAL ARRAY                                                  <<06745>>24025000
   QARRAY(*) = Q + 0;                                          <<06745>>24030000
                                                               <<06745>>24035000
INTEGER                                                        <<06745>>24040000
   PCBGLOBLOC;                                                 <<06745>>24045000
                                                               <<06745>>24050000
    INTEGER TEMP, TEMP'ADDR, RECLENGTH, COUNT, WCOUNT;         <<03522>>24055000
    LOGICAL TEMP'FUNC;                                         <<04249>>24060000
                                                               <<04249>>24065000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<06745>>24070000
SUBROUTINE DEF'MOVEDSEG;                                       <<07114>>24075000
                                                               <<04249>>24080000
SUBROUTINE TIME'TO'WRITE'EOT;                                  <<04249>>24085000
                                                               <<04249>>24090000
BEGIN COMMENT --                                               <<04249>>24095000
  TIME'TO'WRITE'EOT calls CTRLSDISC to write the simulated EOT <<04249>>24100000
mark.  CTRLSDISC will do this only if we are  using  a  floppy <<04249>>24105000
disc.  TIME'TO'WRITE'EOT  is  separated out because it must be <<04249>>24110000
called from two locations in RITESDISC.                        <<04249>>24115000
;                                                              <<04249>>24120000
TEMP'FUNC := FUNC;                                             <<04249>>24125000
FUNC := WRITE'EOT;                                             <<04249>>24130000
CTRLSDISC;            << Sets EOT'WRITTEN.                  >> <<04249>>24135000
IF SDERR THEN RETURN;                                          <<04249>>24140000
FUNC := TEMP'FUNC;                                             <<04249>>24145000
END;                  << of TIME'TO'WRITE'EOT               >> <<04249>>24150000
                                                               <<04249>>24155000
                                                               <<03522>>24160000
  PXGLOBAL;   << Required by the PXGLOBAL $INCLUDE file.    >> <<06745>>24165000
  XMITLOG:=CNT;                                                <<DL003>>24170000
                                                               <<03606>>24175000
<< By convention, a write with CNT = 0  is  a  NOP,  except >> <<03606>>24180000
<< that  a  write ring check is performed for those devices >> <<03606>>24185000
<< which support it.  This causes problems for SYSDUMP  and >> <<03606>>24190000
<< its  cousins (SOFTDUMP, TPSTOMP, etc.), because they use >> <<03606>>24195000
<< zero-length writes to  close  their  contiguous  blocks. >> <<03606>>24200000
<< Ideally  these  modules would each be modified to follow >> <<03606>>24205000
<< the convention.  The actual code  makes  such  a  change >> <<03606>>24210000
<< quite difficult as well as requiring it in many modules. >> <<03606>>24215000
<< So we bend here instead, allowing only those zero-length >> <<03606>>24220000
<< writes which are to close an open contiguous block.      >> <<03606>>24225000
                                                               <<03606>>24230000
  CHECK'WRITE'RING;   << Make sure we can write.            >> <<03522>>24235000
  IF SDERR THEN RETURN;                                        <<03522>>24240000
  IF CNT = 0 AND FUNC <> ENDCONTIG AND FUNC <> PRIV'WRITE'EOD  <<03733>>24245000
     THEN RETURN;                                              <<03733>>24250000
  IF FUNC = PRIV'WRITE'EOD THEN                                <<03733>>24255000
     BEGIN                                                     <<03733>>24260000
  COMMENT -- This function makes it possible to easily recover <<03733>>24265000
a user logging file during  a  warmstart  following  a  system <<03733>>24270000
crash.  It  is  invoked  by the user logging facility when the <<03733>>24275000
file is opened, and causes an EOD mark  with  an  artificially <<03733>>24280000
large address (EOTSECTR) to be entered at the current location <<03733>>24285000
in the Gap Table, then flushed to the media.  CURRENTGPTENT is <<03733>>24290000
then backed up to point to the EOD mark so that  if  the  user <<03733>>24295000
logging  file  is closed normally, a valid EOF and EOD will be <<03733>>24300000
written and flushed.                                           <<03733>>24305000
  The strange EOD allows SDISC to read all the data which  has <<03733>>24310000
been written to the media (within 4K of all data for a disc or <<03733>>24315000
16K for a cartridge tape. The user logging facility can recov- <<07114>>24320000
er the remaining data from  its  own  buffers).  Without  this <<07114>>24325000
function  and  its resulting EOD, EOD on the media would point <<07114>>24330000
to the start of the media and SDISC would not be able to  read <<07114>>24335000
beyond it.                                                     <<07114>>24340000
  This scam depends on the following two conditions:           <<03733>>24345000
1.  The user logging file is always one long file.  Any  EOF's <<03733>>24350000
    written  to the Gap Table before closing the file will not <<03733>>24355000
    be flushed to the media and will not survive a crash.      <<03733>>24360000
2.  SDERR 30 (non-matching  leading/trailing  record  lengths) <<03733>>24365000
    must  not  be a fatal error.  This is how user logging de- <<03733>>24370000
    tects the end of valid data during recovery.  It  must  be <<03733>>24375000
    allowed to continue using SDISC after detecting the error. <<03733>>24380000
  All of this is being arranged for the benefit of  the  cart- <<07114>>24385000
ridge tape.  A more straightforward way would be to backspace/ <<07114>>24390000
forward space record after each write, thus flushing both data <<07114>>24395000
buffer and Gap Table to the media.  This is fine  for  a  true <<07114>>24400000
random access device such as a disc, but would cause unaccept- <<07114>>24405000
able performance problems for a cartridge tape.                <<07114>>24410000
;                                                              <<03733>>24415000
     GPTMOD (WRITE'EOD'AND'POST, EOTSECTR);                    <<03733>>24420000
     CURRENTGPTENT := CURRENTGPTENT - GPTENTSIZE;              <<03733>>24425000
     RETURN;                                                   <<03733>>24430000
     END;   << of writing artificial EOD.                  >>  <<03733>>24435000
  IF FLAGS.SYSBUFRS = 1 AND CNT <> 0 THEN                      <<M7491>>24440000
     BEGIN   << System buffers not allowed.                 >> <<07065>>24445000
     ERRORCODE := SDERR1;                                      <<07065>>24450000
     RETURN;                                                   <<07065>>24455000
     END;                                                      <<07065>>24460000
  TEMP'ADDR:=ADDR;                                                      24465000
  IF TAPEREWOUND THEN                                                   24470000
     BEGIN <<SET TO START OF REEL>>                                     24475000
     GPTMOD (BRAND'NEW'TAPE);                                  <<03522>>24480000
     IF SDERR THEN RETURN;                                              24485000
     END;   << Set to start of reel.                        >> <<07114>>24490000
  IF NOT TAPEWRITTEN THEN GPTMOD (CLEAR'TO'END);               <<07114>>24495000
  IF (P2.(13:1) = 0) AND (EOTSENSOR = EOTFOUND) THEN           <<03522>>24500000
     BEGIN   << Not allowed to write beyond EOT.            >> <<03522>>24505000
                                                               <<03522>>24510000
<< Flush buffer before generating error. The next statement >> <<03522>>24515000
<< gets us to a sector boundary, as required by WRITE'BUFFER>> <<07114>>24520000
                                                               <<03522>>24525000
     CURRENTBUFINDEX := CURRENTBUFINDEX + (WORDSPERSECTR -     <<03522>>24530000
                        CURRENTBUFINDEX MOD WORDSPERSECTR);    <<03522>>24535000
     IF CURRENTBUFINDEX > 0 THEN                               <<07114>>24540000
        BEGIN                                                  <<07114>>24545000
        DATABUF'WRITE := TRUE;                                 <<07114>>24550000
        DATABUF'IN'USE := TRUE;                                <<07114>>24555000
        WRITE'BUFFER (CURRENTBUFINDEX);                        <<07114>>24560000
        END;                                                   <<07114>>24565000
     ERRORCODE := SDERR37;                                     <<07114>>24570000
     RETURN;                                                   <<00494>>24575000
     END;                                                      <<00494>>24580000
                                                               <<04249>>24585000
<< Write EOT mark (if required) only if user is  not  in  a >> <<04249>>24590000
<< contiguous block.  If s/he is in a contiguous block, any >> <<04249>>24595000
<< required EOT mark will be  written  when  the  block  is >> <<04249>>24600000
<< closed.                                                  >> <<04249>>24605000
                                                               <<04249>>24610000
  IF EOTSENSOR = EOTFOUND AND CONTIGSTARTSECT = -1D THEN       <<04249>>24615000
     TIME'TO'WRITE'EOT;                                        <<04249>>24620000
  IF FUNC=SETCONTIG THEN                                                24625000
    BEGIN <<OPEN CONTIGUOUS BLOCK>>                                     24630000
    IF CONTIGSTARTSECT <> -1D THEN                             <<04249>>24635000
       BEGIN   << Close this block before starting next one >> <<04249>>24640000
       FUNC := ENDCONTIG;                                      <<04249>>24645000
       COUNT := CNT;                                           <<04249>>24650000
       CNT := 0;                                               <<04249>>24655000
       RITESDISC;                                              <<04249>>24660000
       IF SDERR THEN RETURN;                                   <<04249>>24665000
       FUNC := SETCONTIG;                                      <<04249>>24670000
       CNT := COUNT;                                           <<04249>>24675000
       END;    << Close this block before starting next one >> <<04249>>24680000
    TEMP := (CURRENTBUFINDEX/WORDSPERSECTR + 1) * WORDSPERSECTR         24685000
      -CURRENTBUFINDEX;                                                 24690000
    IF 1<=TEMP<=WORDSPERSECTR-1 THEN                                    24695000
      BEGIN <<SECTOR NEEDS FILL CHARACTERS>>                            24700000
      PUTRECBUFF (CURRENTBUFINDEX, FILLCHAR);                  <<07114>>24705000
      MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1,                <<07114>>24710000
         DATABUF'DST, CURRENTBUFINDEX, TEMP);                  <<07114>>24715000
      CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP;                            24720000
      END;  <<SECTOR NEEDS FILL CHARACTERS>>                            24725000
    CONTIGSTARTSECT := CURRENTADR;                             <<00494>>24730000
    END;  <<OPEN CONTIGUOUS BLOCK>>                                     24735000
  TAPEWRITTEN:=TRUE;                                                    24740000
  RECLENGTH:=IF CNT<0 THEN -CNT ELSE  <<BYTE LENGTH>>                   24745000
    CNT & LSL(1);                                                       24750000
  COUNT:=(RECLENGTH+1)&LSR(1); <<WORD LENGTH>>                          24755000
  IF CONTIGSTARTSECT=-1D THEN                                           24760000
     PUTRECBUFF (CURRENTBUFINDEX, RECLENGTH)                   <<07114>>24765000
  ELSE                                                                  24770000
    <<COMPENSATE FOR NO REC LENGTH HEADER WHEN CONTIGUOUS>>             24775000
      <<WRITE OPTION IS ON>>                                            24780000
    CURRENTBUFINDEX:=CURRENTBUFINDEX-1;                                 24785000
  IF DSTX=USERSTACK THEN                                                24790000
     DBOFFSET := PXG'RELATIVE'DB                               <<06745>>24795000
  ELSE                                                                  24800000
     DBOFFSET:=0;                                                       24805000
FILLBUFFER:                                                             24810000
  DATABUF'WRITE := TRUE;                                       <<07114>>24815000
  DATABUF'IN'USE := TRUE;                                      <<07114>>24820000
  IF RECBUFFLEN-CURRENTBUFINDEX-1>=COUNT THEN                           24825000
    BEGIN <<WHOLE RECORD WILL FIT INTO RECBUFF>>                        24830000
    MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1, DSTX,            <<07114>>24835000
                  TEMP'ADDR + DBOFFSET, COUNT);                <<06745>>24840000
    IF CONTIGSTARTSECT=-1D THEN                                         24845000
      PUTRECBUFF (TEMP := CURRENTBUFINDEX+COUNT+1, RECLENGTH)  <<07114>>24850000
    ELSE                                                                24855000
      <<COMPENSATE FOR NO REC LENGTH TRAILER WHEN>>                     24860000
      <<CONTIGUOUS WRITE OPTION IS ON>>                                 24865000
      TEMP := CURRENTBUFINDEX + COUNT;                         <<07114>>24870000
    CURRENTBUFINDEX := TEMP + 1;                               <<07114>>24875000
    WORDSINRECBUF:=CURRENTBUFINDEX;                            <<00494>>24880000
    IF CURRENTBUFINDEX>RECBUFFLEN THEN                                  24885000
      BEGIN <<BUFFER IS EXACTLY FULL>>                                  24890000
      WRITE'BUFFER (CURRENTBUFINDEX);                          <<07114>>24895000
      IF SDERR THEN RETURN;                                             24900000
      END;  <<BUFFER IS EXACTLY FULL>>                                  24905000
    IF FUNC=ENDCONTIG THEN                                              24910000
      BEGIN <<FLUSH BUFFER AT END OF CONTIG BLOCK>>                     24915000
      IF CONTIGSTARTSECT = -1D THEN                            <<03522>>24920000
         BEGIN   << Can't finish what you haven't started.  >> <<03522>>24925000
         ERRORCODE := SDERR9;                                  <<07114>>24930000
         RETURN;                                               <<03522>>24935000
         END;                                                  <<03522>>24940000
      TEMP := (CURRENTBUFINDEX/WORDSPERSECTR+1)*WORDSPERSECTR           24945000
        - CURRENTBUFINDEX;                                              24950000
      IF 1<=TEMP<=WORDSPERSECTR-1 THEN                                  24955000
        BEGIN <<SECTOR NEEDS FILL CHARACTERS>>                          24960000
        PUTRECBUFF (CURRENTBUFINDEX, FILLCHAR);                <<07114>>24965000
        MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1,              <<07114>>24970000
           DATABUF'DST, CURRENTBUFINDEX, TEMP-1);              <<07114>>24975000
        CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP;                          24980000
        END;  <<SECTOR NEEDS FILL CHARACTERS>>                          24985000
      GPTMOD (ENTER'CONTIG'BLOCK, CONTIGSTARTSECT,             <<04249>>24990000
              CURRENTADR - 1D);                                <<04249>>24995000
      IF SDERR THEN RETURN;                                             25000000
      CONTIGSTARTSECT:=-1D;                                             25005000
      IF EOTSENSOR = EOTFOUND THEN TIME'TO'WRITE'EOT;          <<04249>>25010000
      END;  <<FLUSH BUFFER AT END OF CONTIG BLOCK>>                     25015000
    CHECK'FOR'EOT;   << Set EOTSENSOR and status if req'd.  >> <<03522>>25020000
    BOT'SENSOR := BOT'NOT'FOUND;                               <<03522>>25025000
    RETURN;   << Normal exit here.                          >>          25030000
    END   <<WHOLE RECORD WILL FIT INTO RECBUFF>>                        25035000
  ELSE                                                                  25040000
    BEGIN   << It doesn't all fit, move the part that does. >> <<06745>>25045000
    WCOUNT := RECBUFFLEN - CURRENTBUFINDEX;                    <<06745>>25050000
    MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1, DSTX,            <<07114>>25055000
                  TEMP'ADDR + DBOFFSET, WCOUNT);               <<06745>>25060000
    CURRENTBUFINDEX:=RECBUFFLEN+1;                                      25065000
    END;    << It doesn't all fit...                        >> <<06745>>25070000
  WRITE'BUFFER (RECBUFFLEN + 1);   << Buffer full, write it >> <<07114>>25075000
  IF SDERR THEN RETURN;                                                 25080000
  COUNT:=COUNT-WCOUNT; <<SHORTEN LENGTH FOR NEXT PASS>>                 25085000
  TEMP'ADDR:=TEMP'ADDR+WCOUNT; <<ADVANCE TARGET POINTER>>               25090000
                                                                        25095000
<< Compensate for missing record length header on next part >>          25100000
                                                                        25105000
  CURRENTBUFINDEX := CURRENTBUFINDEX - 1;                               25110000
  GOTO FILLBUFFER; <<PUT NEXT PART IN RECBUFF>>                         25115000
  END;  <<RITESDISC>>                                                   25120000
$PAGE "SDISC - CONTROL CODE ROUTINES"                          <<03522>>25125000
PROCEDURE LOCK'CS80'DEVICE;                                    <<03522>>25130000
  OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                     <<06745>>25135000
                                                               <<03522>>25140000
BEGIN                                                          <<03522>>25145000
  COMMENT -- LOCK'CS80'DEVICE (alternate entry  point  UNLOCK' <<03522>>25150000
CS80'DEVICE)  is  responsible  for sending the LOCK and UNLOCK <<03522>>25155000
ATTACHIO functions to the driver. These instruct the driver to <<03522>>25160000
disallow or allow the operator to unload the device. In theory <<03522>>25165000
this mechanism can prevent devices from being  unloaded  while <<03522>>25170000
users are accessing them.                                      <<03522>>25175000
;                                                              <<03522>>25180000
ENTRY UNLOCK'CS80'DEVICE;                                      <<03522>>25185000
                                                               <<03522>>25190000
DOUBLE                                                         <<03522>>25195000
  DERR;          << Receives ATTACHIO result.               >> <<03522>>25200000
                                                               <<03522>>25205000
INTEGER                                                        <<03522>>25210000
  ERR1 = DERR,                                                 <<03522>>25215000
  CS80'FUNC,     << Holds LOCK or UNLOCK function code.     >> <<03522>>25220000
  LENGTH := 0;   << Dummy, for ATACHIO call.  Must be 0.    >> <<04742>>25225000
                                                               <<03522>>25230000
LOGICAL ARRAY                                                  <<03522>>25235000
  BUFFER(*) = LENGTH;   << Dummy, for ATACHIO call.         >> <<03522>>25240000
                                                               <<03522>>25245000
CS80'FUNC := LOCK;                                             <<03522>>25250000
WHILE FALSE DO                                                 <<03522>>25255000
                                                               <<03522>>25260000
UNLOCK'CS80'DEVICE:                                            <<03522>>25265000
                                                               <<03522>>25270000
CS80'FUNC := UNLOCK;                                           <<03522>>25275000
                                                               <<03522>>25280000
IF TYPE <> CS80 THEN RETURN;                                   <<03522>>25285000
DERR := ATACHIO (LDNUM, QMISC', DSTN, @BUFFER,                 <<03680>>25290000
                 CS80'FUNC, LENGTH, READ0, READ1, BLOCKED);    <<07114>>25295000
IF ATIOERR THEN ERRORCODE := SDERR38;                          <<07114>>25300000
END;                                                           <<03522>>25305000
$PAGE                                                          <<03522>>25310000
PROCEDURE CTRLSDISC;                                                    25315000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                       <<06745>>25320000
                                                                        25325000
COMMENT:                                                                25330000
   PROCEDURE TO IMPLEMENT TAPE CONTROL FOR THE SERIAL DISC.             25335000
   CONTROL CODES ACCEPTED:                                              25340000
      0-Write EOT mark (internal to SDISC).                    <<04249>>25345000
      5-REWIND                                                 <<00189>>25350000
      6-WRITE EOF                                                       25355000
      7-FORWARD SPACE FILE                                              25360000
      8-BACKSPACE FILE                                                  25365000
      9-REWIND AND UNLOAD                                               25370000
      11-FORWARD SPACE RECORD                                           25375000
      12-BACKSPACE RECORD                                               25380000
      15-FETCH HARDWARE STATUS                                 <<03522>>25385000
;                                                                       25390000
BEGIN <<CTRLSDISC>>                                                     25395000
INTEGER RECLEN,                                                         25400000
        ENTRYINDEX=RECLEN,                                              25405000
        LPDT'INDEX,   << Required by INCLLPDT.              >> <<M7478>>25410000
        LENGTH,                                                         25415000
        TEMP,                                                           25420000
        ENTRYTYPE,                                             <<03522>>25425000
        LAST'CB,                                               <<07114>>25430000
        LASTCBI, <<LAST CURRENTBUFINDEX>>                      <<00494>>25435000
        LAST'DBUF'WIB,                                         <<07114>>25440000
        LASTWIRB;                                              <<03522>>25445000
                                                               <<03522>>25450000
DOUBLE                                                         <<03522>>25455000
  DERR;   << Receives result of ATTACHIO.                   >> <<03522>>25460000
                                                               <<03522>>25465000
INTEGER                                                        <<03522>>25470000
  ERR1 = DERR;   << Holds ATTACHIO completion status.       >> <<03522>>25475000
                                                               <<03522>>25480000
LOGICAL                                                                 25485000
       LASTNRIB; <<LAST NEXTRECINBUF>>                                  25490000
                                                               <<03522>>25495000
DOUBLE LASTRBSA,   << Last RECBUFF starting address.        >> <<03522>>25500000
       LAST'DBUF'SA,                                           <<07114>>25505000
       BOFSECTOR;                                                       25510000
INTEGER BOFSECTOR0=BOFSECTOR,                                           25515000
        BOFSECTOR1=BOFSECTOR+1;                                <<03522>>25520000
                                                               <<07114>>25525000
SUBROUTINE DEF'MOVEDSEG;                                       <<07114>>25530000
                                                               <<03522>>25535000
CASE FUNC OF                                                            25540000
   BEGIN <<CASE STATEMENT>>                                             25545000
                                                               <<04249>>25550000
      BEGIN   << 0 - Write EOT mark (internal to SDISC).    >> <<04249>>25555000
                                                               <<04249>>25560000
  COMMENT -- This is an internal SDISC function, that  is,  it <<04249>>25565000
is  impossible (it says here) for a user to call this function <<04249>>25570000
directly.  It fills the current sector with -2's [the  end-of- <<04249>>25575000
tape  (EOT)  fill  character].  If  we are exactly at a sector <<04249>>25580000
boundary when called, we must fill an entire sector  with  EOT <<04249>>25585000
fill  characters.  SDISC ignores this field when reading.  The <<04249>>25590000
only known user of this feature is INITIAL, whose serial  disc <<04249>>25595000
code  calls  for a volume switch when the EOT mark is found in <<04249>>25600000
the system area (before user files).  This  currently  happens <<04249>>25605000
only when the cold-load medium is a floppy disc set. Therefore <<04249>>25610000
the EOT mark will be written only if the serial disc device is <<04249>>25615000
a floppy disc.                                                 <<04249>>25620000
;                                                              <<04249>>25625000
      IF TYPE = FLOPPY'DISC THEN                               <<04249>>25630000
         BEGIN   << We have to work.                        >> <<04249>>25635000
                                                               <<04249>>25640000
<< Fill remainder of current  sector  (TEMP+1  words)  with >> <<04249>>25645000
<< EOT'MARK and set CURRENTBUFINDEX to next sector.         >> <<04249>>25650000
                                                               <<04249>>25655000
         TEMP := (CURRENTBUFINDEX/WORDSPERSECTR + 1)           <<04249>>25660000
                 * WORDSPERSECTR - CURRENTBUFINDEX - 1;        <<04249>>25665000
         PUTRECBUFF (CURRENTBUFINDEX, EOT'MARK);               <<07114>>25670000
         MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1,             <<07114>>25675000
             DATABUF'DST, CURRENTBUFINDEX, TEMP);              <<07114>>25680000
         CURRENTBUFINDEX := CURRENTBUFINDEX + TEMP + 1;        <<04249>>25685000
         WORDSINRECBUF := CURRENTBUFINDEX;                     <<04249>>25690000
         IF CURRENTBUFINDEX >= RECBUFFLEN THEN                 <<04249>>25695000
            BEGIN   << Dump full buffer to disc.            >> <<04249>>25700000
            WRITE'BUFFER (RECBUFFLEN + 1);                     <<07114>>25705000
            IF SDERR THEN RETURN;                              <<04249>>25710000
            END;                                               <<04249>>25715000
         GPTMOD (WRITE'EOT'MARK, CURRENTADR - 1D);             <<04249>>25720000
         IF SDERR THEN RETURN;                                 <<04249>>25725000
         CHECK'FOR'EOT;                                        <<04249>>25730000
         BOT'SENSOR := BOT'NOT'FOUND;                          <<04249>>25735000
         END;   << We have to work.                         >> <<04249>>25740000
      EOTSENSOR := EOT'WRITTEN;   << Don't come here again. >> <<04249>>25745000
      END;    << 0 - Write EOT mark (internal to SDISC).    >> <<04249>>25750000
                                                               <<04249>>25755000
      ERRORCODE := SDERR14;   <<1>>                            <<07114>>25760000
      ERRORCODE := SDERR14;   <<2>>                            <<07114>>25765000
      ERRORCODE := SDERR14;   <<3>>                            <<07114>>25770000
      ERRORCODE := SDERR14;   <<4>>                            <<07114>>25775000
                                                                        25780000
      BEGIN   << 5 - Rewind.                                >>          25785000
      GOTO NINE; <<USE REWIND CODE OF REWIND-UNLOAD>>                   25790000
      END;    << 5 - Rewind.                                >>          25795000
                                                                        25800000
      BEGIN   << 6 - Write EOF.                             >>          25805000
      CHECK'WRITE'RING;   << Make sure we can write.        >> <<03522>>25810000
      IF SDERR THEN RETURN;                                    <<03522>>25815000
      IF P2.(13:1) = 0 AND EOTSENSOR = EOTFOUND THEN           <<03522>>25820000
         BEGIN   << Can't write past EOT -- even an EOF.    >> <<03522>>25825000
         CURRENTBUFINDEX := CURRENTBUFINDEX + WORDSPERSECTR -  <<03522>>25830000
                            CURRENTBUFINDEX MOD WORDSPERSECTR; <<03522>>25835000
         WRITE'BUFFER (CURRENTBUFINDEX);         << Flush.. >> <<07114>>25840000
         ERRORCODE := SDERR37;      << ..then report error. >> <<07114>>25845000
         RETURN;                                               <<03522>>25850000
         END;                                                  <<03522>>25855000
      IF TAPEREWOUND THEN                                               25860000
         BEGIN <<ASSUME VIRGIN TAPE>>                                   25865000
         GPTMOD (BRAND'NEW'TAPE);                              <<03522>>25870000
         IF SDERR THEN RETURN;                                          25875000
         END;   << Assume virgin tape.                      >> <<07114>>25880000
      IF NOT TAPEWRITTEN THEN GPTMOD (CLEAR'TO'END);           <<07114>>25885000
                                                                        25890000
<< Make sure we can't read until after backspace or rewind. >>          25895000
                                                                        25900000
      TAPEWRITTEN := TRUE;                                     <<03522>>25905000
      IF CONTIGSTARTSECT <> -1D THEN                           <<03522>>25910000
         BEGIN                                                 <<03522>>25915000
                                                               <<03522>>25920000
<< An open contiguous block.  We must close it and flush it >> <<03522>>25925000
<< to the disc before generating the EOF.                   >> <<03522>>25930000
                                                               <<03522>>25935000
         CNT := 0;                                             <<04249>>25940000
         FUNC := ENDCONTIG;                                    <<04249>>25945000
         RITESDISC;                                            <<04249>>25950000
         IF SDERR THEN RETURN;                                 <<04249>>25955000
         FUNC := WRITE'EOF;                                    <<04249>>25960000
         END;   << An open contiguous block.                >> <<03522>>25965000
      IF EOTSENSOR = EOTFOUND THEN                             <<04249>>25970000
         BEGIN   << Write EOT mark before writing EOF.      >> <<04249>>25975000
         FUNC := WRITE'EOT;                                    <<04249>>25980000
         CTRLSDISC;                                            <<04249>>25985000
         IF SDERR THEN RETURN;                                 <<04249>>25990000
         FUNC := WRITE'EOF;                                    <<04249>>25995000
         END;                                                  <<04249>>26000000
                                                               <<03522>>26005000
<< Fill remainder of current  sector  (TEMP+1  words)  with >> <<03522>>26010000
<< EOF'MARK and set CURRENTBUFINDEX to next sector.         >> <<03522>>26015000
                                                               <<03522>>26020000
                                                               <<03522>>26025000
      TEMP := (CURRENTBUFINDEX/WORDSPERSECTR+1)*WORDSPERSECTR-          26030000
        CURRENTBUFINDEX - 1;                                            26035000
      PUTRECBUFF (CURRENTBUFINDEX, EOF'MARK);                  <<07114>>26040000
      MOVEDSEG (DATABUF'DST, CURRENTBUFINDEX+1,                <<07114>>26045000
         DATABUF'DST, CURRENTBUFINDEX, TEMP);                  <<07114>>26050000
      CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP+1;                          26055000
      WORDSINRECBUF := CURRENTBUFINDEX;                        <<00494>>26060000
      IF CURRENTBUFINDEX>=RECBUFFLEN THEN                               26065000
        BEGIN <<OUTPUT FULL BUFFER>>                                    26070000
        WRITE'BUFFER (RECBUFFLEN + 1);                         <<07114>>26075000
        IF SDERR THEN RETURN;                                           26080000
        END;  <<OUTPUT FULL BUFFER>>                                    26085000
      GPTMOD (WRITE'EOF'MARK, CURRENTADR - 1D);                <<03522>>26090000
      IF SDERR THEN RETURN;                                    <<03522>>26095000
      CHECK'FOR'EOT;   << Set EOTSENSOR and status if req'd >> <<03522>>26100000
      BOT'SENSOR := BOT'NOT'FOUND;                             <<03522>>26105000
      END;    << 6 - Write EOF.                             >>          26110000
                                                                        26115000
      BEGIN   << 7 - Forward Space File.                    >>          26120000
      IF TAPEWRITTEN THEN                                      <<03522>>26125000
         BEGIN   << Attempt to space beyond end of data.    >> <<03522>>26130000
         ERRORCODE := SDERR22;                                 <<07114>>26135000
         RETURN;                                               <<03522>>26140000
         END;                                                  <<03522>>26145000
      DO                                                                26150000
         BEGIN <<SCAN GPT LOOKING FOR EOFMARK>>                         26155000
         SDISCFINDGAP (ACTUAL'ADDRESS, EODSECTR);              <<03522>>26160000
         RECBUFFSA:=ENDGAP+1D;                                 <<00494>>26165000
         END   <<SCAN GPT LOOKING FOR EOFMARK>>                         26170000
        UNTIL GAPTYPE = EOFTYPE OR GAPTYPE = EODTYPE OR        <<03522>>26175000
          STARTGAP = -1D;                                      <<03522>>26180000
      IF GAPTYPE <> EOFTYPE THEN                               <<03522>>26185000
         BEGIN   << Runaway condition.                      >>          26190000
         ERRORCODE := SDERR27;                                 <<07114>>26195000
         RETURN;                                                        26200000
         END;                                                           26205000
      RECBUFFEA := -1D;                                        <<03522>>26210000
      CURRENTBUFINDEX := 0;                                    <<03522>>26215000
      NEXTRECINBUF := FALSE;                                   <<07114>>26220000
      ENDINDEX := ENDINDEX + GPTENTSIZE;                       <<03522>>26225000
      GPTMOD (UPDT'FOR'READ'OP);                               <<03522>>26230000
      IF SDERR THEN RETURN;                                    <<00189>>26235000
      CLEAR'ALL'BUFFERS;                                       <<07114>>26240000
      IF SDERR THEN RETURN;                                    <<07114>>26245000
      EOFCODE := HARDWARE'EOF;                                 <<03522>>26250000
      CHECK'FOR'EOT;   << Set EOTSENSOR if required.        >> <<03522>>26255000
      BOT'SENSOR := BOT'NOT'FOUND;                             <<03522>>26260000
      TAPEREWOUND := FALSE;                                    <<07114>>26265000
      END;    << 7 - Forward Space File.                    >>          26270000
                                                                        26275000
      BEGIN   << 8 - Backspace File.                        >>          26280000
      IF TAPEWRITTEN THEN                                               26285000
                                                               <<03522>>26290000
<< If you have just written data and  now  try  backspacing >> <<03522>>26295000
<< without writing an EOF, the File System does it for you. >> <<03522>>26300000
<< Thus there is no danger of having an  incomplete  sector >> <<03522>>26305000
<< flushed to disc here.                                    >> <<03522>>26310000
                                                               <<03522>>26315000
        BEGIN <<FLUSH BUFFER TO DISC>>                                  26320000
        LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                      26325000
          WORDSPERSECTR * WORDSPERSECTR;                                26330000
        WRITE'BUFFER (LENGTH);                                 <<07114>>26335000
        IF SDERR THEN RETURN;                                           26340000
        GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);                <<03522>>26345000
        IF SDERR THEN RETURN;                                           26350000
        TAPEWRITTEN := FALSE;                                  <<03522>>26355000
        END;  <<FLUSH BUFFER TO DISC>>                                  26360000
      IF BOT'SENSOR = BOT'FOUND THEN                           <<03522>>26365000
         BEGIN  << Trying to backspace while at load point. >>          26370000
         ERRORCODE := -SDERR24;      << Non-fatal error.    >> <<07114>>26375000
         RETURN;                                                        26380000
         END;                                                           26385000
      ENTRYINDEX := CURRENTGPTENT;                             <<03522>>26390000
      WHILE ENTRYINDEX > GPT'START AND EOFCODE = NO'EOF DO     <<03522>>26395000
         BEGIN   << Scan GPT backwards looking for EOF.     >>          26400000
         ENTRYINDEX := ENTRYINDEX - GPTENTSIZE;                         26405000
         ENTRYTYPE := GPT(ENTRYINDEX).GPT'TYPE'FIELD;          <<00189>>26410000
         IF ENTRYTYPE = EOFTYPE THEN                                    26415000
         BEGIN                                                          26420000
            BOFSECTOR0 := GPT(ENTRYINDEX).GPT'ADR'FIELD;       <<00189>>26425000
            BOFSECTOR1 := GPT (X := X+1);                      <<03522>>26430000
            EOFCODE := HARDWARE'EOF;                           <<03522>>26435000
            END;                                               <<03522>>26440000
         END;   << Scan GPT backwards looking for EOF.      >> <<03522>>26445000
      IF EOFCODE = NO'EOF THEN                                 <<03522>>26450000
         BEGIN   << Backspaced all the way to load point.   >> <<03522>>26455000
         BOFSECTOR := DOUBLE (STARTADDRESS);                   <<03522>>26460000
         BOT'SENSOR := BOT'FOUND;                              <<03522>>26465000
         TAPEREWOUND := TRUE;                                  <<07114>>26470000
         END;                                                  <<03522>>26475000
      ENDINDEX := ENTRYINDEX;                                  <<03522>>26480000
      GPTMOD (UPDT'FOR'READ'OP);                               <<03522>>26485000
      IF SDERR THEN RETURN;                                    <<00189>>26490000
      CLEAR'ALL'BUFFERS;                                       <<07114>>26495000
      IF SDERR THEN RETURN;                                    <<07114>>26500000
      RECBUFFSA:=BOFSECTOR;                                    <<00494>>26505000
      RECBUFFEA:=-1D;                                                   26510000
      NEXTRECINBUF:=FALSE;                                     <<00494>>26515000
      READBLOCK; <<SETS CURRENTBUFINDEX=0>>                    <<00298>>26520000
      IF SDERR THEN RETURN;                                    <<07114>>26525000
      IF EOFCODE = HARDWARE'EOF THEN                           <<03522>>26530000
         BEGIN   << Stopped backspacing before we hit BOT.  >> <<03522>>26535000
         CURRENTBUFINDEX := WORDSPERSECTR - 1;                 <<03522>>26540000
         WHILE GETRECBUFF (CURRENTBUFINDEX) = EOF'MARK         <<07114>>26545000
           AND CURRENTBUFINDEX >=0 DO     << Backspace over >> <<03522>>26550000
           CURRENTBUFINDEX := CURRENTBUFINDEX - 1;   << EOF >> <<03522>>26555000
         CURRENTBUFINDEX := CURRENTBUFINDEX + 1;               <<03522>>26560000
         END;    << Stopped backspacing before we hit BOT.  >> <<03522>>26565000
      CHECK'FOR'EOT;   << Reset EOTSENSOR if we're in front >> <<03522>>26570000
      END;    << 8 - Backspace File.                        >>          26575000
                                                                        26580000
      BEGIN   << 9 - Rewind and Unload.                     >>          26585000
NINE:                                                                   26590000
      LPDT'INDEX := LDNUM * INTEGER (LPDT'ENTRY'SIZE);         <<M7478>>26595000
      IF NOT TAPEREWOUND THEN                                           26600000
        BEGIN <<TAPE NEEDS REWINDING>>                                  26605000
        IF TAPEWRITTEN THEN                                             26610000
          BEGIN <<WRITE EOF AND FLUSH BUFFER TO DISC>>         <<00189>>26615000
          LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                    26620000
            WORDSPERSECTR * WORDSPERSECTR;                              26625000
          WRITE'BUFFER (LENGTH);                               <<07114>>26630000
          IF SDERR THEN RETURN;                                         26635000
          GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);              <<03522>>26640000
          IF SDERR THEN RETURN;                                         26645000
          TAPEWRITTEN := FALSE;                                <<07114>>26650000
          END; <<FLUSH BUFFER TO DISC>>                                 26655000
        CURRENTGPTENT:=GPT'START;                                       26660000
        END;  <<TAPE NEEDS REWINDING>>                                  26665000
      TAPEREWOUND:=TRUE;                                                26670000
      NEXTRECINBUF:=FALSE;                                              26675000
      BOT'SENSOR := BOT'FOUND;                                 <<03522>>26680000
      EOTSENSOR := EOTNOTFOUND;                                <<03522>>26685000
      RECBUFFSA:=DOUBLE(STARTADDRESS);                         <<00494>>26690000
      RECBUFFEA:=-1D;                                                   26695000
      CURRENTBUFINDEX:=0;                                               26700000
      CLEAR'ALL'BUFFERS;                                       <<07114>>26705000
      IF SDERR THEN RETURN;                                    <<07114>>26710000
      IF FUNC = REW'UNLOAD AND LPDT'RDY'SER'FRN'DISC THEN      <<06745>>26715000
         BEGIN <<UNLOAD DEVICE>>                                        26720000
         UNLOCK'CS80'DEVICE;                                   <<03522>>26725000
         IF SDERR THEN RETURN;                                 <<03522>>26730000
         IF CARTRIDGE'TAPE THEN                                <<07114>>26735000
            BEGIN   << Physical I/O required.               >> <<03522>>26740000
            DERR := ATACHIO (LDNUM, QMISC', DSTX, ADDR,        <<03522>>26745000
                    UNLOAD, 0, P1, P2, BLOCKED);               <<07114>>26750000
            IF ATIOERR THEN                                    <<03522>>26755000
               BEGIN                                           <<03522>>26760000
               ERRORCODE := SDERR38;                           <<07114>>26765000
               RETURN;                                         <<03522>>26770000
               END;                                            <<03522>>26775000
            END;   << Physical I/O required.                >> <<03522>>26780000
         DISABLE;                                              <<06745>>26785000
         LPDT'RDY'SER'FRN'DISC := 0;   << Not Ready.        >> <<06745>>26790000
         ENABLE;                                               <<06745>>26795000
         JUSTALLOCATED:=TRUE;                                           26800000
         END;  <<UNLOAD DEVICE>>                                        26805000
      END;    << 9 - Rewind and Unload.                     >>          26810000
                                                                        26815000
      ERRORCODE := SDERR14;     << 10 - GAP not supported.  >> <<07114>>26820000
                                                                        26825000
      BEGIN   << 11 - Forward Space Record.                 >>          26830000
      NULLTRANSFER := TRUE;   << Set FALSE by READSDISC.    >> <<06745>>26835000
      READSDISC;                                                        26840000
      IF SDERR THEN RETURN;                                    <<00494>>26845000
      END;    << 11 - Forward Space Record.                 >>          26850000
                                                                        26855000
      BEGIN   << 12 - Backspace Record.                     >>          26860000
      IF TAPEWRITTEN THEN                                      <<00494>>26865000
        BEGIN   << Write EOD and flush Gap Table to disc.   >> <<00494>>26870000
                                                               <<03522>>26875000
<< If you have just written data and  now  try  backspacing >> <<03522>>26880000
<< without writing an EOF, the File System does it for you. >> <<03522>>26885000
<< Thus there is no danger of having an  incomplete  sector >> <<03522>>26890000
<< flushed to disc here.                                    >> <<03522>>26895000
                                                               <<03522>>26900000
        LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                      26905000
          WORDSPERSECTR * WORDSPERSECTR;                                26910000
                                                                        26915000
COMMENT --                                                              26920000
  Backspace Record is the ugly duckling of  SDISC.  More  pro- <<07114>>26925000
gramming  crimes  are committed in its name than for any other <<07114>>26930000
tape simulation function.  Proper buffer  management  requires <<07114>>26935000
this to be so. In the present instance we must save everything <<07114>>26940000
we know about the current buffer, flush the contents to assure <<07114>>26945000
an up-to-date disc, then restore the buffer to its pre-flushed <<07114>>26950000
state so we can do the backspace we came here for. Fortunately <<07114>>26955000
the contents aren't erased so we can continue to use them even <<07114>>26960000
after they've been written out.                                <<07114>>26965000
;                                                              <<07114>>26970000
        LASTCBI:=CURRENTBUFINDEX;                                       26975000
        LASTWIRB:=WORDSINRECBUF;                                        26980000
        LASTNRIB:=NEXTRECINBUF;                                         26985000
        LASTRBSA:=RECBUFFSA;                                            26990000
        LAST'DBUF'SA := DATABUFD'SA;                           <<07114>>26995000
        LAST'CB := CURRENT'BUFFER;                             <<07114>>27000000
        LAST'DBUF'WIB := DATABUF'WORDS'IN'BUF;                 <<07114>>27005000
        WRITE'BUFFER (LENGTH);                                 <<07114>>27010000
        IF SDERR THEN RETURN;                                           27015000
        GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);                <<03522>>27020000
        IF SDERR THEN RETURN;                                  <<03522>>27025000
        CLEAR'ALL'BUFFERS;                                     <<07114>>27030000
        IF SDERR THEN RETURN;                                  <<07114>>27035000
        CURRENTBUFINDEX:=LASTCBI;                                       27040000
        WORDSINRECBUF:=LASTWIRB;                                        27045000
        NEXTRECINBUF:=LASTNRIB;                                         27050000
        RECBUFFSA:=LASTRBSA;                                            27055000
        CURRENT'BUFFER := LAST'CB;   << Must restore first! >> <<07114>>27060000
        DATABUFD'SA := LAST'DBUF'SA;                           <<07114>>27065000
        DATABUF'WORDS'IN'BUF := LAST'DBUF'WIB;                 <<07114>>27070000
        CURRENTGPTENT:=CURRENTGPTENT-GPTENTSIZE;               <<00494>>27075000
        TAPEWRITTEN := FALSE;                                  <<03522>>27080000
        END;    << Write EOD and flush Gap Table to disc.   >> <<00494>>27085000
      IF BOT'SENSOR = BOT'FOUND THEN                           <<03522>>27090000
         BEGIN   << Can't backspace if already at BOT.      >> <<03522>>27095000
         ERRORCODE := -SDERR25;      << Non-fatal error.    >> <<07114>>27100000
         RETURN;                                               <<03522>>27105000
         END;                                                  <<03522>>27110000
      IF CURRENTBUFINDEX>0 THEN                                         27115000
         BEGIN <<RECLEN OF LAST REC IS IN BUFF>>                        27120000
         RECLEN := GETRECBUFF (CURRENTBUFINDEX-1);             <<07114>>27125000
         IF RECLEN <= EOF'MARK THEN                            <<03522>>27130000
            BEGIN                                                       27135000
                                                                        27140000
<< Found EOT (-2), contiguous block fill (-1) or  EOF  (0). >> <<03522>>27145000
<< In addition to backspacing over the obstruction, we must >> <<03522>>27150000
<< account for the Gap Table entrie(s) associated with  it. >> <<03522>>27155000
<< That's  easy  for  EOF or EOT (except that we have to be >> <<03522>>27160000
<< careful to space over only one EOF if more than one  ex- >> <<03522>>27165000
<< ists -- that was an earlier bug fixed this time).  But a >> <<03522>>27170000
<< contiguous block or hole takes up at least  two  entries >> <<03522>>27175000
<< and maybe more (if there was a DECLAREHOLE while writing >> <<03522>>27180000
<< a contiguous block, for example). To synchronize our Gap >> <<03522>>27185000
<< Table properly requires a few more smarts.               >> <<03522>>27190000
                                                                        27195000
            LASTCBI := CURRENTBUFINDEX - WORDSPERSECTR;        <<03522>>27200000
            DO CURRENTBUFINDEX := CURRENTBUFINDEX - 1                   27205000
              UNTIL CURRENTBUFINDEX < 0 OR                              27210000
              INTEGER (GETRECBUFF (CURRENTBUFINDEX)) > 0;      <<07114>>27215000
            CURRENTBUFINDEX:=CURRENTBUFINDEX+1;                         27220000
            CURRENTGPTENT:=CURRENTGPTENT-GPTENTSIZE;                    27225000
            IF RECLEN = EOF'MARK                               <<03522>>27230000
              THEN                                             <<03522>>27235000
               BEGIN   << EOF found.                        >> <<03522>>27240000
               NEXTRECINBUF := TRUE;                           <<03522>>27245000
               IF CURRENTBUFINDEX < LASTCBI THEN               <<03522>>27250000
                  CURRENTBUFINDEX := LASTCBI; << 1 EOF only >> <<03522>>27255000
                  EOFCODE := HARDWARE'EOF;                     <<03522>>27260000
               END                                             <<03522>>27265000
              ELSE                                             <<03522>>27270000
               BEGIN   << EOT or contiguous block.          >> <<03522>>27275000
               IF RECLEN = FILLCHAR THEN                       <<03522>>27280000
                  BEGIN   << Must search for start of entry >> <<03522>>27285000
                  TEMP := GPT (CURRENTGPTENT).GPT'TYPE'FIELD;  <<03522>>27290000
                  DO CURRENTGPTENT := CURRENTGPTENT -          <<03522>>27295000
                                      GPTENTSIZE               <<03522>>27300000
                     UNTIL GPT (CURRENTGPTENT).GPT'TYPE'FIELD  <<03522>>27305000
                           = LOGICAL (TEMP - 1)                <<03522>>27310000
                           OR CURRENTGPTENT <= GPT'START;      <<03522>>27315000
                  IF GPT (CURRENTGPTENT).GPT'TYPE'FIELD <>     <<03522>>27320000
                    LOGICAL (TEMP - 1) THEN                    <<03522>>27325000
                     BEGIN   << Couldn't find beg of entry. >> <<03522>>27330000
                     ERRORCODE := SDERR17;                     <<07114>>27335000
                     RETURN;                                   <<03522>>27340000
                     END;                                      <<03522>>27345000
                  END;   << RECLEN = FILLCHAR               >> <<03522>>27350000
               CTRLSDISC;   << Ignore EOT, contig block.    >> <<03522>>27355000
               END;    << EOT or contiguous block.          >> <<03522>>27360000
            CHECK'FOR'EOT;   << Reset EOT if we're in front >> <<03522>>27365000
            RETURN;                                                     27370000
            END;                                                        27375000
         IF (RECLEN+1)&LSR(1)<=CURRENTBUFINDEX-2 THEN                   27380000
            BEGIN <<ENTIRE LAST REC IS IN BUFF>>                        27385000
            CURRENTBUFINDEX := CURRENTBUFINDEX                          27390000
              - (RECLEN+1)&LSR(1) - 2;                                  27395000
            END   <<ENTIRE LAST REC IS IN BUFF>>                        27400000
         ELSE                                                           27405000
            BEGIN <<LEADING RECLEN OF LAST REC IS IN>>                  27410000
                  <<LAST BLOCK>>                                        27415000
            LASTCBI:=CURRENTBUFINDEX;                          <<00494>>27420000
            BACKBLOCKREAD;                                              27425000
            IF SDERR THEN RETURN;                                       27430000
                                                               <<03522>>27435000
<< If BACKBLOCKREAD ran into the load  point,  our  LASTCBI >> <<03522>>27440000
<< may  be  in the middle of the block currently in RECBUFF >> <<03522>>27445000
<< instead of just beyond the end.  The correction term (in >> <<03522>>27450000
<< BOT'SECTOR'COUNT) is used to place CURRENTBUFINDEX  pro- >> <<03522>>27455000
<< perly.  The parentheses assure no local integer overflow >> <<03522>>27460000
<< if LASTCBI + RECBUFFLEN + 1 should be > 32767.           >> <<03522>>27465000
                                                               <<03522>>27470000
            CURRENTBUFINDEX := LASTCBI - (RECLEN+1)&LSR(1) - 1 <<00494>>27475000
              + RECBUFFLEN - BOT'SECTOR'COUNT*WORDSPERSECTR;   <<03522>>27480000
            IF CURRENTBUFINDEX<0 THEN                          <<00494>>27485000
                                                               <<03522>>27490000
<< Record is larger than RECBUFF.  Keep going until we find >> <<03522>>27495000
<< the beginning.                                           >> <<03522>>27500000
                                                               <<03522>>27505000
              DO                                               <<00494>>27510000
                BEGIN                                          <<00494>>27515000
                LASTCBI:=CURRENTBUFINDEX;                      <<00494>>27520000
                BACKBLOCKREAD;                                 <<00494>>27525000
                CURRENTBUFINDEX := LASTCBI + (RECBUFFLEN + 1   <<03522>>27530000
                  - BOT'SECTOR'COUNT*WORDSPERSECTR);           <<03522>>27535000
                END                                            <<00494>>27540000
              UNTIL CURRENTBUFINDEX>=0;                        <<00494>>27545000
            END;  <<LEADING RECLEN OF LAST REC IS IN>>                  27550000
                  <<LAST BLOCK>>                                        27555000
         END   <<RECLEN OF LAST REC IS IN BUFF>>                        27560000
      ELSE                                                              27565000
         BEGIN <<TRAILING RECLEN OF LAST REC IS IN>>                    27570000
               <<LAST BLOCK>>                                           27575000
         IF CURRENTBUFINDEX<>0 THEN                                     27580000
            BEGIN                                                       27585000
            ERRORCODE := SDERR23;                              <<07114>>27590000
            RETURN;                                                     27595000
            END                                                         27600000
         ELSE                                                           27605000
            BEGIN <<CAN BE RETRIEVED FROM LAST BLOCK>>                  27610000
            BACKBLOCKREAD;                                              27615000
            IF SDERR THEN RETURN;                                       27620000
            IF BOT'SENSOR = BOT'NOT'FOUND THEN                 <<03522>>27625000
               BEGIN   << Didn't back into Load Point.      >> <<03522>>27630000
               CURRENTBUFINDEX := RECBUFFLEN + 1               <<03522>>27635000
                 - BOT'SECTOR'COUNT*WORDSPERSECTR;             <<03522>>27640000
               CTRLSDISC;                                      <<00494>>27645000
               END;                                            <<03522>>27650000
            RETURN;                                                     27655000
            END;  <<CAN BE RETRIEVED FROM LAST BLOCK>>                  27660000
         END;  <<TRAILING RECLEN OF LAST REC IS IN>>                    27665000
               <<LAST BLOCK>>                                           27670000
      NEXTRECINBUF:=TRUE;                                      <<00494>>27675000
      CHECK'FOR'EOT;   << Reset EOT if we're in front.      >> <<03522>>27680000
      END;    << 12 - Backspace Record.                     >>          27685000
                                                                        27690000
      ERRORCODE := SDERR14;    <<13 - INVALID FUNCTION>>       <<07114>>27695000
                                                                        27700000
      ERRORCODE := SDERR14;    <<14 - INVALID FUNCTION>>       <<07114>>27705000
                                                                        27710000
      BEGIN   << 15 - Fetch hardware status.                >>          27715000
      ATACHIO (LDNUM, QMISC', DSTX, ADDR, FUNC, CNT, P1, P2,   <<03522>>27720000
               BLOCKED);                                       <<07114>>27725000
      END;    << 15 - Fetch hardware status.                >>          27730000
   END;  <<CASE STATEMENT>>                                             27735000
END;  <<CTRLSDISC>>                                                     27740000
$PAGE                                                          <<07114>>27745000
PROCEDURE CLOSE'DEVICE;                                        <<07114>>27750000
   OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                    <<07114>>27755000
                                                               <<07114>>27760000
BEGIN COMMENT --                                               <<07114>>27765000
  CLOSE'DEVICE implements the ATTACHIO Device Close  function. <<07114>>27770000
This involves logically dismounting the device in the LPDT and <<07114>>27775000
rewinding, unloading and unlocking the cartridge  tape.  Other <<07114>>27780000
CS80  devices  must  be  unlocked.  This is all handled by the <<07114>>27785000
REW'UNLOAD function of  CTRLSDISC.  Setting  DEVICE'CLOSE'FLAG <<07114>>27790000
disables  all  the IF SDERR checks, because this function must <<07114>>27795000
run to completion (that is, we must guarantee to do  our  best <<07114>>27800000
to  unlock  any CS80 device, lest a user think a crowbar works <<07114>>27805000
better).  CLOSE'DEVICE also gives back SDISCs data buffers. >> <<07114>>27810000
;                                                              <<07114>>27815000
DEVICE'CLOSE'FLAG := TRUE;                                     <<07114>>27820000
FUNC := REW'UNLOAD;                                            <<07114>>27825000
CTRLSDISC;                                                     <<07114>>27830000
DEVICE'CLOSE'FLAG := FALSE;                                    <<07114>>27835000
DEALLOCATE'BUFFERS;                                            <<07114>>27840000
END;                   << of CLOSE'DEVICE;                  >> <<07114>>27845000
$PAGE "SDISC - SERIAL DISC INTERFACE TO ATTACHIO AND USER"              27850000
INTEGER PROCEDURE FINDSDISCGAP(LDNUM,BLOCK,ADR,LEN);                    27855000
VALUE LDNUM,BLOCK;                                                      27860000
INTEGER LDNUM,BLOCK;                                                    27865000
DOUBLE ADR,LEN;                                                         27870000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                                  27875000
                                                                        27880000
BEGIN <<FINDSDISCGAP>>                                                  27885000
                                                               <<06745>>27890000
DEFINE                                                         <<06745>>27895000
   DB'IS'ABSOLUTE = DBXDSINFO.ABSDBFLAG#;                      <<06745>>27900000
                                                               <<06745>>27905000
INTEGER ERRCODE=FINDSDISCGAP;                                           27910000
INTEGER QDSTN;                                                          27915000
INTEGER QUSERDST;                                                       27920000
DOUBLE QSTARTBLOCK,QBLOCKLENGTH;                                        27925000
LOGICAL ABS'DB := FALSE;                                       <<03558>>27930000
DEFINE DB'WAS'ABSOLUTE=ABS'DB = TRUE#;                         <<03558>>27935000
INTEGER POINTER                                                <<06745>>27940000
   LDT,                  << Used only to get us to LDTX.    >> <<06745>>27945000
   LDTX;                 << For XDS# of SDISC variables DSEG>> <<06745>>27950000
                                                               <<06745>>27955000
INTEGER                                                        <<06745>>27960000
   LDTX'INDEX,                                                 <<06745>>27965000
   PCBPT;                                                      <<06745>>27970000
                                                                        27975000
LOGICAL PARMS=Q-4;                                                      27980000
DOUBLE QLEN,QADR;                                                       27985000
                                                                        27990000
IF PARMS.(15:1)=1 THEN                                                  27995000
   QLEN:=LEN;                                                           28000000
IF PARMS.(14:1)=1 THEN                                                  28005000
   QADR:=ADR;                                                           28010000
PCBPT := CURPRC;                                               <<06745>>28015000
IF DB'IS'ABSOLUTE THEN                                                  28020000
   BEGIN                                                       <<03558>>28025000
                                                               <<03558>>28030000
COMMENT -- DB is at SYSGLOB (%1000), remember this in  ABS'DB. <<03558>>28035000
Since DB is not at a stack or data segment, if we try to do an <<03558>>28040000
EXCHANGEDB to our data segment, the system will  crash.  Isn't <<03558>>28045000
that (interesting, unfriendly, pathetic) (pick any three). The <<03558>>28050000
RESETDB call below does nothing except put DB at some stack or <<03558>>28055000
data segment (we don't know or care which one,  but  it's  the <<03558>>28060000
one  the  system  was  at before DB was set to SYSGLOB).  Then <<03558>>28065000
we are free to EXCHANGEDB to our heart's content.              <<03558>>28070000
;                                                              <<03558>>28075000
   ABS'DB := TRUE;                                             <<03558>>28080000
   RESETDB (-1);                                               <<03558>>28085000
   END;                                                        <<03558>>28090000
QUSERDST := EXCHANGEDB (LDT'DST);                              <<06745>>28095000
@LDT := 0;                                                     <<06745>>28100000
@LDTX := LDTX'BASE;                                            <<06745>>28105000
LDTX'INDEX := LDNUM * LDTX'ENTRY'SIZE;                         <<06745>>28110000
QDSTN := LDTX'SDISC'GPT'XDS;                                   <<06745>>28115000
IF QDSTN>0 THEN                                                         28120000
   EXCHANGEDB(QDSTN)                                                    28125000
ELSE                                                                    28130000
   BEGIN <<INVALID DST#>>                                               28135000
   FINDSDISCGAP:=SDERR35;                                               28140000
   GOTO RETURNN;                                                        28145000
   END;  <<INVALID DST#>>                                               28150000
IF JUSTALLOCATED THEN                                                   28155000
   BEGIN <<CAN'T CALL UNTIL OPENED>>                                    28160000
   FINDSDISCGAP:=SDERR10;                                               28165000
   GOTO RETURNN;                                                        28170000
   END;                                                                 28175000
ERRORCODE:=SDERR0;                                                      28180000
IF PARMS.(14:1)=0 THEN                                                  28185000
   BEGIN <<REQUIRED PARAMETER>>                                         28190000
   FINDSDISCGAP:=SDERR43;                                               28195000
   GOTO RETURNN;                                                        28200000
   END;  <<REQUIRED PARAMETER>>                                         28205000
IF BLOCK <= 0 THEN                                             <<03522>>28210000
   BEGIN   << Illegal parameter, must be positive.          >> <<03522>>28215000
   FINDSDISCGAP := SDERR11;                                    <<03522>>28220000
   GO TO RETURNN;                                              <<03522>>28225000
   END;                                                        <<03522>>28230000
GPTMOD (-BLOCK, QADR);   << Find BLOCKth contiguous block.  >> <<07114>>28235000
FINDSDISCGAP:=ERRORCODE;                                                28240000
QSTARTBLOCK:=STARTBLOCK;                                                28245000
QBLOCKLENGTH:=BLOCKLENGTH;                                              28250000
RETURNN:                                                                28255000
EXCHANGEDB(QUSERDST);                                                   28260000
IF ERRCODE=0 THEN                                                       28265000
   BEGIN <<RETURN VALUES>>                                              28270000
   ADR:=QSTARTBLOCK;                                                    28275000
   IF PARMS.(15:1)=1 THEN                                               28280000
      LEN:=QBLOCKLENGTH;                                                28285000
   END;  <<RETURN VALUES>>                                              28290000
IF ERRCODE>0 THEN                                                       28295000
   BEGIN                                                                28300000
   IF QUSERDST<>0 THEN EXCHANGEDB(0);                                   28305000
   GENMSG(SET19,ERRCODE,%10000,LDNUM);                                  28310000
   IF QUSERDST<>0 THEN EXCHANGEDB(QUSERDST);                            28315000
   END;                                                                 28320000
IF DB'WAS'ABSOLUTE THEN                                                 28325000
   SETSYSDB;   << Leave DB at SYSGLOB if there at entry.       <<03558>>28330000
END;  <<FINDSDISCGAP>>                                                  28335000
$PAGE                                                          <<03522>>28340000
DOUBLE PROCEDURE SDISCIO(LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,                28345000
                         P1,P2,FLAGS);                                  28350000
VALUE LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                       28355000
INTEGER LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     28360000
OPTION PRIVILEGED,UNCALLABLE;                                           28365000
                                                                        28370000
BEGIN <<SDISCIO>>                                                       28375000
INTEGER POINTER                                                <<06745>>28380000
   LDT,                  << Used only to get us to LDTX.    >> <<06745>>28385000
   LDTX,                 << For XDS#.                       >> <<06745>>28390000
   PCB = SYSPCBINDEX;    << Required by PCB $INCLUDE file.  >> <<06745>>28395000
                                                               <<06745>>28400000
INTEGER                                                        <<06745>>28405000
   LDTX'INDEX,                                                 <<06745>>28410000
   PCBPT;                                                      <<06745>>28415000
                                                               <<06745>>28420000
INTEGER QDSTN,QERRORCODE;                                               28425000
                                                               <<06745>>28430000
DEFINE                                                         <<06745>>28435000
   DB'IS'ABSOLUTE = DBXDSINFO.ABSDBFLAG#;                      <<07065>>28440000
                                                               <<03522>>28445000
INTEGER QUSERDST,QUSERSTACK;                                            28450000
LOGICAL ABS'DB := FALSE;                                       <<03558>>28455000
DEFINE DB'WAS'ABSOLUTE=ABS'DB = TRUE#;                         <<03558>>28460000
INTEGER RETVAL0=SDISCIO, <<WORD0 OF RETURN VALUE>>                      28465000
        RETVAL1=SDISCIO+1;<<WORD1 OF RETURN VALUE>>                     28470000
INTEGER ARRAY ERRORS(0:49)=PB:=<<ATTACHIO ERRORCODES FOR SDISC>>        28475000
         %1,%124, %74,%124,%124, %31, %74, %10, %74,%124,      <<M7478>>28480000
         %0,%124, %74, %74,  %4,  %0,  %0,  %0,%124,%124,      <<M7478>>28485000
       %164,%154,%103,%124, %73, %73,%124,%103,  %0,  %0,      <<M7478>>28490000
       %124,%124, %74,  %0,%124,%124,%124,%113,  %0,  %0,      <<M7478>>28495000
       %123,%124,%124,  %0,  %0,  %0,  %0,  %0,  %0,  %0;      <<00137>>28500000
                               <<ERRORS>>                               28505000
<<** NOTE ** : DB ANYWHERE ON ENTRY; SAME ON RETURN>>                   28510000
QERRORCODE:=SDERR0; <<INITIALLY-ALL OKAY>>                              28515000
PCBPT := CURPRC;                                               <<06745>>28520000
IF DB'IS'ABSOLUTE THEN                                                  28525000
   BEGIN                                                       <<03558>>28530000
                                                               <<03558>>28535000
COMMENT -- DB is at SYSGLOB (%1000), remember this in  ABS'DB. <<03558>>28540000
Since DB is not at a stack or data segment, if we try to do an <<03558>>28545000
EXCHANGEDB to our data segment, the system will  crash.  Isn't <<03558>>28550000
that (interesting, unfriendly, pathetic) (pick any three). The <<03558>>28555000
RESETDB call below does nothing except put DB at some stack or <<03558>>28560000
data segment (we don't know or care which one,  but  it's  the <<03558>>28565000
one  the  system  was  at before DB was set to SYSGLOB).  Then <<03558>>28570000
we are free to EXCHANGEDB to our heart's content.              <<03558>>28575000
;                                                              <<03558>>28580000
   ABS'DB := TRUE;                                             <<03558>>28585000
   RESETDB (-1);                                               <<03558>>28590000
   END;                                                        <<03558>>28595000
QUSERSTACK := SPCBSTKDST;                                      <<06745>>28600000
QUSERDST := EXCHANGEDB (LDT'DST);                              <<06745>>28605000
@LDT := 0;                                                     <<06745>>28610000
@LDTX := LDTX'BASE;                                            <<06745>>28615000
LDTX'INDEX := LDNUM * LDTX'ENTRY'SIZE;                         <<06745>>28620000
QDSTN := LDTX'SDISC'GPT'XDS;                                   <<06745>>28625000
IF QDSTN>0 THEN                                                         28630000
   EXCHANGEDB (QDSTN)                                          <<07065>>28635000
ELSE                                                                    28640000
   QERRORCODE := SDERR35;                                      <<03640>>28645000
IF QERRORCODE = 0 AND NOT FATALERROR THEN                      <<07114>>28650000
   BEGIN <<MOVE PARMS AND EXECUTE>>                                     28655000
   BACKSPACING := FALSE;   << For new SDISC'FINDGAP.        >> <<07114>>28660000
   DSTN:=QDSTN;                                                         28665000
   ERRORCODE:=SDERR0;                                                   28670000
   EOFCODE := NO'EOF;                                          <<03522>>28675000
   USERSTACK:=QUSERSTACK;                                               28680000
   PARMARRAY(0)     :=LDNUM;                                            28685000
   PARMARRAY(X:=X+1):=QMISC;                                            28690000
   IF DSTX=0 THEN DSTX:=QUSERSTACK;                                     28695000
   PARMARRAY(X:=X+1):=DSTX;                                             28700000
   PARMARRAY(X:=X+1):=ADDR;                                             28705000
   PARMARRAY(X:=X+1):=FUNC;                                             28710000
   PARMARRAY(X:=X+1):=CNT;                                              28715000
   PARMARRAY(X:=X+1):=P1;                                               28720000
   PARMARRAY(X:=X+1):=P2;                                               28725000
   PARMARRAY(X:=X+1):=FLAGS.(7:9);                                      28730000
   IF JUSTALLOCATED THEN                                                28735000
      BEGIN <<INITIALIZE GLOBAL VARIABLES TO LOAD-POINT>>               28740000
      CONTIGSTARTSECT:=-1D;                                             28745000
      CURRENTBUFINDEX:=0;                                               28750000
                                                               <<07114>>28755000
<< Clearing SDISC'FLAGS, next, initializes ALREADYREJECTED, >> <<07114>>28760000
<< BACKSPACING, DEVICE'CLSE'FLAG, NEXTRECINBUF,  NULLTRANS- >> <<07114>>28765000
<< FER, TAPEREWOUND and TAPEWRITTEN to False and BOT'SENSOR >> <<07114>>28770000
<< and EOTSENSOR both to Not Found. This leaves TAPEREWOUND >> <<07114>>28775000
<< and BOT'SENSOR in the wrong state, so we fix that.       >> <<07114>>28780000
                                                               <<07114>>28785000
      SDISC'FLAGS := 0;                                        <<07114>>28790000
      WORDSINRECBUF:=0;                                                 28795000
      BOT'SENSOR := BOT'FOUND;                                 <<03522>>28800000
      TAPEREWOUND := TRUE;                                     <<03733>>28805000
      JUSTALLOCATED:=FALSE;                                             28810000
      IF CLOSE'FILE <= FUNC <= REWIND                          <<03733>>28815000
        OR FUNC = REW'UNLOAD THEN                              <<03733>>28820000
         BEGIN                                                 <<07114>>28825000
         JUSTALLOCATED := TRUE;                                <<07114>>28830000
         IF FUNC = CLOSE'DEVC THEN DEALLOCATE'BUFFERS;         <<07114>>28835000
         END                                                   <<07114>>28840000
      ELSE                                                     <<00212>>28845000
         BEGIN                                                 <<03522>>28850000
                                                               <<03680>>28855000
  COMMENT -- If we're here, we're about to perform  our  first <<03680>>28860000
logical operation on this "reel". Make sure the device is log- <<03680>>28865000
ically mounted (WAITFORDISC waits until this  happens)  before <<03680>>28870000
we  continue.  Note  that  any CS80 device is unlocked at this <<03680>>28875000
point, so an UNLOCK and re-LOCK does not need to  be  done  in <<03680>>28880000
WAITFORDISC.                                                   <<03680>>28885000
;                                                              <<03680>>28890000
         IF WAITFORDISC THEN                                   <<M7478>>28895000
            GPTMOD (NEW'VOLUME)                                <<M7478>>28900000
         ELSE   << Label error or no serialized media avail >> <<M7478>>28905000
            IF NOT (SDERR) THEN ERRORCODE := SDERR26;          <<M7478>>28910000
         IF NOT (SDERR) THEN LOCK'CS80'DEVICE;                 <<03640>>28915000
         END;                                                  <<03522>>28920000
      END;  <<INITIALIZE GLOBAL VARIABLES TO LOAD-POINT>>               28925000
   XMITLOG:=0;                                                 <<00189>>28930000
                                                               <<04742>>28935000
  COMMENT -- JUSTALLOCATED is TRUE for new  device  allocation <<04742>>28940000
and whenever  a "reel" is switched.  If it is still TRUE here, <<04742>>28945000
we have not yet initialized the part of our extra data segment <<04742>>28950000
which comes from the label sector of our device (this is  done <<04742>>28955000
in  the  GPTMOD  (NEW'VOLUME) call above when JUSTALLOCATED is <<04742>>28960000
FALSE).  So we can't allow the CASE statement below to  invoke <<04742>>28965000
one  of  the command processors which depends on those values. <<07114>>28970000
We're also stuck if the  WAITFORDISC  or  GPTMOD  (NEW'VOLUME) <<M7478>>28975000
call fails, which is why we test SDERR here.                   <<M7478>>28980000
;                                                              <<04742>>28985000
   IF NOT (JUSTALLOCATED LOR SDERR) THEN                       <<04742>>28990000
     CASE FUNC.(12:4) OF                                                28995000
      BEGIN <<CASE STATEMENT>>                                          29000000
      READSDISC;      <<READ>>                                          29005000
      RITESDISC;      <<WRITE>>                                         29010000
      ;               <<OPEN FILE>>                                     29015000
      ;               <<CLOSE FILE>>                           <<00494>>29020000
      CLOSE'DEVICE;                                            <<07114>>29025000
      CTRLSDISC;      <<REWIND>>                                        29030000
      CTRLSDISC;      <<WRITE EOF>>                                     29035000
      CTRLSDISC;      <<FORWARD SPACE FILE>>                            29040000
      CTRLSDISC;      <<BACK SPACE FILE>>                               29045000
      CTRLSDISC;      <<REWIND & UNLOAD>>                               29050000
      DEALLOCATE'BUFFERS;     << For PVPROC.                >> <<07114>>29055000
      CTRLSDISC;      <<FORWARD SPACE RECORD>>                          29060000
      CTRLSDISC;      <<BACK SPACE RECORD>>                             29065000
      ERRORCODE := SDERR14;   <<INVALID FUNCTION>>             <<07114>>29070000
      ERRORCODE := SDERR14;   <<INVALID FUNCTION>>             <<07114>>29075000
      CTRLSDISC;      <<FETCH SERIAL DISC HARDWARE STATUS>>    <<01958>>29080000
      END;  <<CASE STATEMENT>>                                          29085000
   RETVAL1:=XMITLOG; <<#CHARACTERS/WORDS TRANSFERED>>                   29090000
   IF ERRORCODE=0 THEN                                                  29095000
      BEGIN <<NO ABNORMAL CONDITIONS MET>>                              29100000
      IF EOFCODE<>0 THEN                                                29105000
         RETVAL0:=EOFCODE&LSL(3)+2                                      29110000
      ELSE                                                              29115000
         RETVAL0:=1;                                                    29120000
      END                                                               29125000
   ELSE                                                                 29130000
      RETVAL0:=IF ERRORCODE>99 THEN                            <<00189>>29135000
         ERRORS(\ERRORCODE-100\)                               <<00189>>29140000
      ELSE                                                     <<00189>>29145000
         ERRORS(\ERRORCODE\);                                  <<00189>>29150000
   END   <<MOVE PARMS AND EXECUTE>>                                     29155000
ELSE IF FUNC = CLOSE'DEVC THEN                                 <<07114>>29160000
        BEGIN                                                  <<07114>>29165000
                                                               <<07114>>29170000
  COMMENT -- If we're here, we're trying to close and  deallo- <<07114>>29175000
cate the device after some kind of fatal error. Normally SDISC <<07114>>29180000
won't operate in this mode, however we MUST  unlock  any  CS80 <<07114>>29185000
device  and release SDISC's data buffers to complete the deal- <<07114>>29190000
location.  This code assures this.                             <<07114>>29195000
;                                                              <<07114>>29200000
        ATACHIO (LDNUM, QMISC, DSTX, 0, UNLOCK, 0, 0, 0,       <<07114>>29205000
                 BLOCKED);                                     <<07114>>29210000
        DEALLOCATE'BUFFERS;                                    <<07114>>29215000
        END                                                    <<07114>>29220000
ELSE                                                                    29225000
   BEGIN <<INVALID CALL>>                                               29230000
   IF FATALERROR AND QDSTN>0 THEN QERRORCODE:=SDERR3;                   29235000
   RETVAL1:=0; <<NO TRANSMISSION>>                                      29240000
   RETVAL0:=ERRORS(\QERRORCODE\);                                       29245000
   END;  <<INVALID CALL>>                                               29250000
IF QERRORCODE=0 AND QDSTN>0 THEN                                        29255000
   QERRORCODE:=ERRORCODE;                                               29260000
IF 1<=QERRORCODE<=99 AND QDSTN>0 THEN                                   29265000
   BEGIN                                                                29270000
   IF NOT FATALERROR THEN                                      <<00513>>29275000
      BEGIN                                                    <<00513>>29280000
      EXCHANGEDB(0);                                           <<00513>>29285000
      GENMSG(SET19,QERRORCODE,%10000,LDNUM);                   <<00513>>29290000
      EXCHANGEDB(QDSTN);                                       <<00513>>29295000
      DEALLOCATE'BUFFERS;   << Won't need them again.       >> <<07114>>29300000
      FATALERROR:=TRUE;                                        <<00513>>29305000
      END;                                                     <<00513>>29310000
   END;                                                                 29315000
EXCHANGEDB(QUSERDST);                                                   29320000
IF DB'WAS'ABSOLUTE THEN                                                 29325000
   SETSYSDB;   << Leave DB at SYSGLOB if there at entry.       <<03558>>29330000
END;  <<SDISCIO>>                                                       29335000
$PAGE " *** Global symbol table ***"                           <<07114>>29340000
$PAGE                                                          <<07114>>29345000
$CONTROL SEGMENT=MAIN                                                   29350000
END.  <<SDISC>>                                                         29355000
