$CONTROL MAP,CODE,USLINIT                                               00010000
<<SDISC - MODULE 87>>                                                   00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL SEGMENT=SDISC,MAIN=SDISC                                       00028000
$CONTROL USLINIT, MAP, CODE                                    <<03522>>00030000
BEGIN   << Serial Disc Interface, SDISC.                    >> <<03522>>00032000
$PAGE  "SDISC -- FIX HISTORY"                                  <<03522>>00034000
COMMENT --                                                     <<03522>>00036000
  This fix number encompasses two changes:                     <<00189>>00038000
1.  Makes the Gap Table memory-resident.                       <<00189>>00040000
2.  Only asks once for operator to O.K. "write ring".          <<00189>>00042000
  This fix allows REWIND or REWIND  AND  UNLOAD  to  the  disc <<00212>>00044000
after  it  has  already  been  unloaded, without requiring the <<00212>>00046000
operator to toggle the RUN/LOAD switch.                        <<00212>>00048000
  This fix installs FATALERROR flag to prevent further use  of <<00239>>00050000
SDISC following an error. It also prevents calling DECLAREHOLE <<00239>>00052000
if a write error occurs because the Read Only switch is set.   <<00239>>00054000
  This fix enlarges the extra data segment for  a  larger  Gap <<00467>>00056000
Table  for  the  7925.  Forward  Space File is also sped up by <<00467>>00058000
starting the Gap Table search at the current entry rather than <<00467>>00060000
the beginning.                                                 <<00467>>00062000
  Major rewrite to install debug/dump code and correct bugs in <<00494>>00064000
backspacing algorithms.                                        <<00494>>00066000
  A fatal error message is now printed only once.              <<00513>>00068000
  Deletes all PRINT'FILE'INFO calls.                           <<00823>>00070000
  Changes to support Foreign Disc Facility.                    <<01115>>00072000
  Install four retries in case of write error.                 <<01598>>00074000
  Install CTRLSDISC function code 15 (Physical Status Request) <<01958>>00076000
  Correctly handle End of Data when reading.                   <<02025>>00078000
  Install CS80 disc (including LINUS) support.  Also the  fol- <<03522>>00080000
lowing fixes:                                                  <<03522>>00082000
1.  READBLOCK now skips contiguous  blocks/holes  larger  than <<03522>>00084000
    RECBUFF.                                                   <<03522>>00086000
2.  Numerous BACKBLOCKREAD problems relating  to  blocks/holes <<03522>>00088000
    and finding the load point while backspacing.              <<03522>>00090000
3.  Users can no longer write EOF's beyond End of Tape  unless <<03522>>00092000
    P2 bit 13 is set.                                          <<03522>>00094000
4.  Gap Table length now varies with the device and is  calcu- <<03522>>00096000
    lated from quantities in the label sector.  The 7920 ratio <<03522>>00098000
    of entries to address space is used on  the  7925  and  on <<03522>>00100000
    LINUS.  We  can't use it on the 7935, since the length re- <<03522>>00102000
    quired (45,400 words) is more than  the  largest  possible <<03522>>00104000
    data  segment.  For the 7935, we restrict the Gap Table to <<03522>>00106000
    what fills the largest possible data segment, allowing for <<03522>>00108000
    RECBUFF and the other segment-resident variables.          <<03522>>00110000
5.  An early warning End of Tape status is now  returned  when <<03522>>00112000
    the user is within 10 Gap Table entries of the end.        <<03522>>00114000
6.  A write request of 0 length now only checks for write ring.<<03522>>00116000
7.  Load point sensing and reporting is now handled properly.  <<03522>>00118000
8.  ACTUAL'ADDRESS installed to determine proper disc  address <<03522>>00120000
    when reading or spacing.                                   <<03522>>00122000
9.  A Backspace Record at a location containing  two  or  more <<03522>>00124000
    file marks now backspaces over only one.                   <<03522>>00126000
10. The EOT flag is now cleared if the user backspaces over it.<<03522>>00128000
11. The EOT burst is no longer written to  the  disc,  but  is <<03522>>00130000
    still  detected and ignored (for compatibility with exist- <<03522>>00132000
    ing serial disc packs) when reading or spacing.            <<03522>>00134000
  This fix prevents reading a just >SERIALized pack.           <<03535>>00136000
  DB now handled properly at entry and  exit  to  SDISCIO  and <<03558>>00138000
FINDSDISCGAP.  Fixed CURRENTGPTENT bug from <<03535>>.         <<03558>>00140000
  Allow 0 length write when closing contiguous block.  Put the <<03606>>00142000
REW'UNLOAD function in XDS (not Q-) during Device Close.    >> <<03606>>00144000
1.  Update comments at beginning.                              <<03640>>00146000
2.  Make SDERR 30 non-fatal.                                   <<03640>>00148000
3.  Solve 7935 Unlock problem by always reading label sector.  <<03640>>00150000
  Check for mounted disc (WAITFORDISC) in  SDISCIO.  Can  then <<03680>>00152000
delete  UN/LOCK'CS80'DEVICE  calls  from WAITFORDISC, which in <<03680>>00154000
turn makes all FORCE'ATACHIO references unnecessary. Fix #3 of <<03680>>00156000
MPE Fix #03640 is also deleted, since this fix makes it  unne- <<03680>>00158000
cessary.                                                       <<03680>>00160000
  Allow function code %3001 for priv mode programs. Writes EOD <<03733>>00162000
to media using EOTSECTR address. Allows user logging recovery. <<03733>>00164000
  Allow CLOSE'DEVC after FATALERROR, else CS80 device can't be <<03733>>00166000
UNLOCKed.                                                      <<03733>>00168000
  Initialize TAPEREWOUND in SDISCIO when starting new  "reel". <<03733>>00170000
Make sure it gets cleared when we move off of Load Point.      <<03733>>00172000
1.  Partially cancels #11 of Fix 03522.  The EOT burst is  now <<04249>>00174000
    written  on a floppy disc when EOTSECTR is detected.  INI- <<04249>>00176000
    TIAL needs it to know when to change system area volumes.  <<04249>>00178000
2.  Beginning-of-block is now entered in the  Gap  Table  just <<04249>>00180000
    before  End-of-block.  This  prevents  a  hole  entry from <<04249>>00182000
    splitting a BOB/EOB entry pair, which  caused  a  bug.  In <<04249>>00184000
    addition,  DECLAREHOLE  was  changed  to make a hole entry <<04249>>00186000
    extend from RECBUFFSA  or  CONTIGSTARTSECT  (whichever  is <<04249>>00188000
    less)  to  the last sector of the current track.  The pre- <<04249>>00190000
    vious starting address was the first sector of the current <<04249>>00192000
    track or CONTIGSTARTSECT (whichever was less), which  pro- <<04249>>00194000
    duced a corrupt Gap Table if a previously-written contigu- <<04249>>00196000
    ous block ended on the current track.                      <<04249>>00198000
Q-MIT fixes:                                                   <<04742>>00200000
1.  Prevent system failures from random  record  lengths  when <<04742>>00202000
    reading.                                                   <<04742>>00204000
2.  Prevent SDISCIO function execution when the  label  sector <<04742>>00206000
    has not been read to initialize parts of the XDS.          <<04742>>00208000
3.  (UN)LOCK'CS80'DEVICE now calls ATTACHIO with LENGTH = 0.   <<04742>>00210000
4.  Don't update Gap Table if operator doesn't allow writing.  <<04742>>00212000
5.  Replace ATTACHIO call with P'ATTACHIO in ATACHIO.          <<04742>>00214000
  Modify P'ATTACHIO declaration for new parms, O-V.            <<04828>>00216000
;                                                              <<03522>>00218000
$PAGE "SDISC - STRUCTURE AND OPERATION"                        <<03522>>00220000
COMMENT --                                                     <<03522>>00222000
INTRODUCTION:                                                  <<03522>>00224000
  This is the Serial Disc Interface (SDI or SDISC), Module  87 <<03522>>00226000
of  MPE.  The  purpose of the SDI is to simulate magnetic tape <<03522>>00228000
operations on a direct access device.  As of the  current  re- <<03522>>00230000
lease, the following peripherals may be used as serial discs:  <<03522>>00232000
                                                               <<03522>>00234000
       HP7920      50-megabyte hard disc                       <<03522>>00236000
       HP7925     120-megabyte hard disc                       <<03522>>00238000
       HP7935     404-megabyte hard disc                       <<03522>>00240000
       HP7902 or      Floppy                                   <<03522>>00242000
       HP9895           discs                                  <<03522>>00244000
       HP9110      17- or 65-megabyte integrated cartridge     <<03640>>00246000
                      tape (ICT).                              <<03640>>00248000
                                                               <<03522>>00250000
The ICT is supported only as a serial disc.                    <<03640>>00252000
  Both labelled and unlabelled tape operations are  supported, <<03522>>00254000
although the differences are invisible at the SDI level.       <<03522>>00256000
  SDISC may be thought of as a logical driver  for  the  above <<03522>>00258000
physical  devices.  It  is  invoked  by FOPENing a device in a <<03522>>00260000
serial disc class.  Such a device must be in the direct access <<03522>>00262000
hardware type group (type = 0-7), have a valid subtype for its <<03522>>00264000
type, and have a device class type = %37 (stored in the Device <<03522>>00266000
Class Table).  This class type is entered in the DCT  whenever <<03522>>00268000
the SYSDUMP or INITIAL user responds "yes" to "IS xxxx A SERI- <<03522>>00270000
AL DISC CLASS".  The reason for the special device class  type <<03522>>00272000
and user question is twofold:                                  <<03522>>00274000
1.  A serial disc differs from most other MPE disc devices  in <<03522>>00276000
    that it is owned (non-sharable), and therefore must be al- <<03522>>00278000
    located like a magnetic tape.                              <<03522>>00280000
2.  The HP7920 or HP7925 may also be supported  as  a  private <<03522>>00282000
    volume  in  the non-system domain.  In this mode of opera- <<03522>>00284000
    tion the device is sharable and is therefore not owned.    <<03522>>00286000
Use of a serial disc class name tells MPE to allocate the  de- <<03522>>00288000
vice as non-sharable.                                          <<03522>>00290000
  Labelled tape operations to a serial disc behave in the same <<03522>>00292000
fashion as they would to a magnetic tape.  Consult  the  docu- <<03522>>00294000
mentation on labelled tapes for further details.               <<03522>>00296000
$PAGE                                                          <<03522>>00298000
OPERATION -- Overview:                                         <<03522>>00300000
                                                               <<03522>>00302000
  SDI is entered via the uncallable procedure SDISCIO,  called <<03522>>00304000
only  from  the  general  I/O system entry procedure ATTACHIO. <<03522>>00306000
(Another procedure, FINDSDISCGAP, is called by  SYSDUMP.  More <<03522>>00308000
on this later).  ATTACHIO calls SDISCIO if and only if:        <<03522>>00310000
1.  The device is of a type and subtype supported as a  serial <<03522>>00312000
    disc, -AND-                                                <<03522>>00314000
2.  The device is owned (that is, has been allocated as a non- <<03522>>00316000
    sharable device), -AND-                                    <<03522>>00318000
3.  Bit 10 of the FLAGS parameter of ATTACHIO is 0.            <<03522>>00320000
                                                               <<03522>>00322000
Condition 2 is met if the DRSTATE field of the LPDT entry  for <<03522>>00324000
the device (word 1, bits 0:2) equals 1.  Consult the I/O chap- <<03522>>00326000
ter of the MPE Tables Manual for further details.              <<03522>>00328000
  The parameter list of SDISCIO is identical to  that  of  AT- <<03522>>00330000
TACHIO. It is a double procedure whose return fields are iden- <<03522>>00332000
tical to those of ATTACHIO.  It works like this:               <<03522>>00334000
  The File System (say) calls ATTACHIO with parameters  appro- <<03522>>00336000
priate to a magnetic tape I/O request, but with FLAGS.(10:1) = <<03522>>00338000
0.  ATTACHIO tests the above 3 conditions and  calls  SDISCIO, <<03522>>00340000
passing on all the parameters of its own call.  SDISCIO massa- <<03522>>00342000
ges the parameters and fashions its own ATTACHIO call, if  ne- <<03522>>00344000
cessary,  with  parameters  appropriate to a disc I/O request. <<03522>>00346000
Most importantly, it sets FLAGS.(10:1) = 1, so that  we  don't <<03522>>00348000
loop  forever.  ATTACHIO  handles the disc I/O request and re- <<03522>>00350000
turns two words to SDISCIO in  normal  fashion.  SDISCIO  pro- <<03522>>00352000
cesses this so that its two word return is appropriate for mag <<03522>>00354000
tape completion status.  The outer ATTACHIO call returns these <<03522>>00356000
two words to the original caller, in our example the File Sys- <<03522>>00358000
tem.                                                           <<03522>>00360000
$PAGE                                                          <<03522>>00362000
OPERATION -- Details:                                          <<03522>>00364000
                                                               <<03522>>00366000
  Data structures -- Data records and end-of-files:            <<03522>>00368000
                                                               <<03522>>00370000
  The primary purpose of  SDISC  is  to  adapt  the  undefined <<03522>>00372000
length  transfers  characteristic  of  mag  tape  to the fixed <<03522>>00374000
length environment of a disc or ICT.  To accomplish this, data <<03640>>00376000
is buffered within SDISC.  The buffer is an integral number of <<03522>>00378000
sectors (blocks for the ICT) long.  Files always  start  on  a <<03640>>00380000
sector  boundary, but data records within files may start any- <<03522>>00382000
where and straddle sector boundaries.  A record in the  buffer <<03522>>00384000
is structured as follows:                                      <<03522>>00386000
                                                               <<03522>>00388000
     +---------+-----------------------------+---------+       <<03522>>00390000
     | record  |                             | record  |       <<03522>>00392000
     | length  |             data            | length  |       <<03522>>00394000
     | (bytes) |                             | (bytes) |       <<03522>>00396000
     +---------+-----------------------------+---------+       <<03522>>00398000
                                                               <<03522>>00400000
The record length is always a  one-word  positive  byte  count <<03522>>00402000
which  includes  only  the data portion of the record, not the <<03522>>00404000
length words themselves. Records within a file might be stored <<03522>>00406000
on the disc as follows:                                        <<03522>>00408000
                                                               <<03522>>00410000
     +----+---------------------------+---       -----         <<03522>>00412000
     | RL |///////////////////////////|            ^           <<03522>>00414000
     +----+------+----+----+----------+            |           <<03522>>00416000
     |///////////| RL | RL |//////////|            |           <<03522>>00418000
     +-----------+----+--+-+--+----+--|       Sector N-1       <<03522>>00420000
     |///////////////////| RL | RL |//|            |           <<03522>>00422000
     +-------------------+----+----+--|            |           <<03522>>00424000
     |////////////////////////////////|            v           <<03522>>00426000
     +---+----+----+------------------+---       -----         <<03522>>00428000
     |///| RL | RL |//////////////////|            ^           <<03522>>00430000
     +---+----+--+-+--+----+----------+            |           <<03522>>00432000
     |///////////| RL | RL |//////////|            |           <<03522>>00434000
     +-----------+----+----++----+----+       Sector N         <<03522>>00436000
     |//////////////////////| RL | RL |            |           <<03522>>00438000
     +----------------------+----+----+            |           <<03522>>00440000
     |////////////////////////////////|            v           <<03522>>00442000
     +-----+----+----+----------------+---       -----         <<03522>>00444000
     |/////| RL | RL | .....          |                        <<03522>>00446000
     +-----+----+----+----------------+                        <<03522>>00448000
                                                               <<03522>>00450000
The reason for the trailing byte count is to implement an easy <<03522>>00452000
way to backspace records.                                      <<03522>>00454000
$PAGE                                                          <<03522>>00456000
  Since files always start on a sector  boundary,  it  follows <<04249>>00458000
that they also end on one.  End of files consist of a 0 record <<04249>>00460000
length and 0-fill to the end of the current sector as follows: <<04249>>00462000
                                                               <<04249>>00464000
     +--------------------------------+                        <<04249>>00466000
     |//////////////////////// RL RL /|                        <<04249>>00468000
     |////////////////////////////////|                        <<04249>>00470000
     |//////// RL RL /////////////////|       Sector N         <<04249>>00472000
     |                    +-----------+                        <<04249>>00474000
     |///////////////| RL | 0         |                        <<04249>>00476000
     +--------------------+           |                        <<04249>>00478000
     |                                |                        <<04249>>00480000
     |          Zero fill             |                        <<04249>>00482000
     +--------------------------------+---                     <<04249>>00484000
$PAGE                                                          <<04249>>00486000
  Data structures -- End-of-tape:                              <<04249>>00488000
                                                               <<04249>>00490000
  (Note: The function of the EOT reflector, described  in  the <<04249>>00492000
next  paragraph,  no  longer holds fully.  The mechanism below <<04249>>00494000
mistakenly assumed that a running MPE was  interested  in  the <<04249>>00496000
EOT reflector while reading.  In fact, the only time a running <<04249>>00498000
MPE cares about EOT is while writing, and SDISC can detect and <<04249>>00500000
manage the EOT condition while writing without writing a  spe- <<04249>>00502000
cial mark to the disc.  However, INITIAL needs the EOT reflec- <<04249>>00504000
tor when the system area (first two files) it  is  loading  is <<04249>>00506000
contained  on  two  or more volumes.  INITIAL uses the EOT re- <<04249>>00508000
flector to tell it when to request the next volume.  The stan- <<04249>>00510000
dard end-of-volume convention (two  EOF's)  cannot  be  easily <<04249>>00512000
used  because INITIAL gets confused and thinks it has detected <<04249>>00514000
the end of the system area (that is, the  start  of  any  user <<04249>>00516000
files).                                                        <<04249>>00518000
  Currently the only serial disc medium  which  requires  more <<04249>>00520000
than  one  volume  for  the  system  area  is the floppy disc. <<04249>>00522000
Therefore, the -2 mechanism described below  is  written  only <<04249>>00524000
when  the  serial  medium  is a floppy disc.  Code in SDISC to <<04249>>00526000
detect and ignore record lengths and  fill  characters  of  -2 <<04249>>00528000
while  reading has been retained for compatibility with serial <<04249>>00530000
discs written with this field.  The explanation below has been <<04249>>00532000
left in for historical purposes).                              <<04249>>00534000
  There were several considerations affecting  the  format  of <<04249>>00536000
the  EOT  reflector.  On  a tape drive, there is room to write <<04249>>00538000
beyond the reflector, so it was determined that the first sec- <<04249>>00540000
tor of the last track should trigger the EOT mechanism  during <<04249>>00542000
a  write  operation.  On a read cycle, it is critical that the <<04249>>00544000
same record that triggered the EOT mechanism on  write  do  it <<04249>>00546000
here.  As  all records are buffered, and the physical write of <<04249>>00548000
the buffer is what triggers the EOT on write, it was  impossi- <<04249>>00550000
ble  to tell which record in the buffer should have the honor. <<04249>>00552000
For this reason, a marker like the EOF mark was implemented to <<04249>>00554000
represent the EOT reflector.  This marker is like the  EOF  in <<04249>>00556000
every way except that the reclength is -2. When a read detects <<04249>>00558000
a record count of -2, the end of tape condition is returned to <<04249>>00560000
the user.                                                      <<04249>>00562000
                                                               <<04249>>00564000
             +--------------------------------+                <<04249>>00566000
             |//////////////////////// RL RL /|                <<04249>>00568000
             |////////////////////////////////|                <<04249>>00570000
             |//////// RL RL /////////////////|       Sector N <<04249>>00572000
             |                    +-----------+                <<04249>>00574000
             |///////////////| RL | -2        |                <<04249>>00576000
             +--------------------+           |                <<04249>>00578000
             |                                |                <<04249>>00580000
             |           -2 fill              |                <<04249>>00582000
             +--------------------------------+---             <<04249>>00584000
$PAGE                                                          <<04249>>00586000
  Data structures -- Contiguous blocks:                        <<03522>>00588000
                                                               <<03522>>00590000
  So much for data records.  But a serial disc, if it  can  do <<03522>>00592000
everything a mag tape can do, must also be a cold-load device. <<03522>>00594000
This means that machine microcode must be able to read a boot- <<03522>>00596000
strap channel program and the  resident  segments  of  INITIAL <<03522>>00598000
from the disc into memory.  The microcode and channel programs <<03522>>00600000
cannot deal with the record length words which surround stand- <<03522>>00602000
ard data records, so for them we have a  structure,  called  a <<03522>>00604000
CONTIGUOUS BLOCK, which has the data without the length words. <<03522>>00606000
Information as to the length of  each  contiguous  block  must <<03522>>00608000
therefore  be  kept  elsewhere, so there is a Gap Table (about <<03522>>00610000
which more later), which holds the beginning and ending sector <<03522>>00612000
addresses of each contiguous block.  This  implies  that  each <<03522>>00614000
block  must  begin  and end on a sector boundary.  In this way <<03522>>00616000
they are similar to data files.  To set contiguous blocks  off <<03522>>00618000
from  normal  data,  and  to reach a sector boundary, a record <<03522>>00620000
length and fill character = %177777 is used, as follows:       <<03522>>00622000
                                                               <<03522>>00624000
     +-------------------------------+---       -----          <<03522>>00626000
     |/////// Previous records //////|            ^            <<03522>>00628000
     |///////////////////////////////|            |            <<03522>>00630000
     |             +-----------------+            |            <<03522>>00632000
     |////////| RL | -1              |        Sector N-1       <<03522>>00634000
     +-------------+                 |            |            <<03522>>00636000
     |                               |            |            <<03522>>00638000
     |            -1 fill            |            |            <<03522>>00640000
     |                               |            v            <<03522>>00642000
     +-------------------------------+---       -----          <<03522>>00644000
     |                               |            ^            <<03522>>00646000
     |         Contiguous block      |        Sector N         <<03522>>00648000
     |                               |            v            <<03522>>00650000
     |                               +---       -----          <<03522>>00652000
     |                               |            ^            <<03522>>00654000
     |                +--------------+            |            <<03522>>00656000
     |                |              |        Sector N+1       <<03522>>00658000
     +----------------+              |            |            <<03522>>00660000
     |            -1 fill            |            v            <<03522>>00662000
     +-------------------------------+---       -----          <<03522>>00664000
$PAGE                                                          <<03522>>00666000
  Data structures -- Holes:                                    <<03522>>00668000
                                                               <<03522>>00670000
  Another fact of serial disc life  is  the  HOLE,  supposedly <<03522>>00672000
generated  while  writing  to the disc to avoid defective disc <<03522>>00674000
areas.  In reality, any I/O error  other  than  the  Read-Only <<03522>>00676000
switch  being  on will cause SDISC to generate a hole, even if <<03522>>00678000
the error had nothing to do with  a  disc  defect.  Holes  are <<03640>>00680000
generated only when the device is an HP7920, HP7925, HP7902 or <<03640>>00682000
HP9895.  The ICT and its physical  driver  automatically  deal <<03640>>00684000
with  media  defects found while writing.  The HP7935 does not <<03640>>00686000
detect media defects when writing,  so  the  hole  concept  is <<03640>>00688000
meaningless for this device and is not supported by the SDI.   <<03640>>00690000
  A hole consists of at least one track, and  always  consists <<03522>>00692000
of  an  integral number of tracks unless a contiguous block is <<03522>>00694000
involved (more on that in a moment).  If a write error is  de- <<03522>>00696000
tected on a given track, data already written on that track is <<03522>>00698000
transferred to the next track (repeatedly, if additional  err- <<03522>>00700000
ors are detected), until a good track is found or the simulat- <<03522>>00702000
ed End of Tape reflector is passed.  The "defective" track  is <<03522>>00704000
then  given  a beginning-end entry pair in the Gap Table so it <<03522>>00706000
will not be used again, and writing continues.                 <<03522>>00708000
  If the data in the defective track is part of  a  contiguous <<03522>>00710000
block,  the  entire  block is relocated even if it began on an <<03522>>00712000
earlier track, and the logical beginning address of the defec- <<03522>>00714000
tive area in the Gap Table  is  moved  back  to  the  original <<03522>>00716000
starting  address of the contiguous block.  In this case only, <<03522>>00718000
a hole might include the latter  part  of  an  otherwise  good <<03522>>00720000
track.  Thus  a  contiguous  block  is guaranteed to really be <<03522>>00722000
physically contiguous on the disc.                             <<03522>>00724000
  Holes are generated  automatically  by  SDISC  whenever  re- <<03522>>00726000
quired.  Contiguous  blocks may be written by any program run- <<03522>>00728000
ning in privileged mode.  A  carriage-control  code  of  %1001 <<03522>>00730000
tells SDISC to start a contiguous block, while a CCTL of %2001 <<03522>>00732000
ends it.  A CCTL of %1001 while already in a contiguous  block <<03522>>00734000
closes  that block and opens another.  A CCTL of %2001 without <<03522>>00736000
an earlier %1001 is an error.  While in the contiguous  block, <<03522>>00738000
no  special  CCTL  codes are needed.  In practice, SYSDUMP and <<03640>>00740000
its cousins SDUP and TPSTOMP are the only programs  which  use <<03640>>00742000
this  feature,  since they write all the channel microcode re- <<03640>>00744000
quired for cold-loading.                                       <<03640>>00746000
$PAGE                                                          <<03522>>00748000
  Data structures -- Gap Table:                                <<03522>>00750000
                                                               <<03522>>00752000
  Now what about this Gap Table we've been reading about. It's <<03522>>00754000
a series of two-word device address entries.  A permanent copy <<03522>>00756000
lives on the device, starting in sector  4,  while  a  working <<03522>>00758000
copy  lives  in  main memory.  The copy in memory is posted to <<03522>>00760000
the disc only when a backspace or rewind operation occurs  af- <<03522>>00762000
ter  writing.  The length is device-dependent according to the <<03522>>00764000
table below:                                                   <<03522>>00766000
                                                               <<03522>>00768000
         Device           Number of sectors (or ICT blocks)    <<03640>>00770000
         ------           ---------------------------------    <<03640>>00772000
                                                               <<03522>>00774000
         HP7920           44                                   <<03522>>00776000
         HP7925           106                                  <<03522>>00778000
         HP7935           219                                  <<03522>>00780000
         HP7902/9895      26                                   <<03522>>00782000
         ICT              4 blocks                             <<03640>>00784000
                                                               <<03522>>00786000
  SDISC calculates the length for a given device using parame- <<03522>>00788000
ters kept in the label sector. These parameters are calculated <<03522>>00790000
by the VINIT subsystem according to device and are  placed  in <<03522>>00792000
the label sector when SERIAL <ldev> is entered.  The layout of <<03522>>00794000
a serial disc in general, and the label sector in  particular, <<03522>>00796000
is described later on.  Here we'll just say that  the  alloca- <<03522>>00798000
tion  of  Gap  Table and data space on the disc is not optimal <<03522>>00800000
and can result in the Gap Table expanding so much that it runs <<03522>>00802000
into the data space.  When this happens, SDISC terminates with <<03522>>00804000
an error and a very unhappy user.  So the user  can't  say  we <<03522>>00806000
didn't warn him/her, we have implemented an early warning sys- <<03522>>00808000
tem with the current release.  When we are within ten  entries <<03522>>00810000
of  the end of the Gap Table, we return End of Tape (EOT) sta- <<03522>>00812000
tus, just as we would if we were actually running out of  data <<03522>>00814000
space.  Users who ignore this warning get the same fatal error <<03522>>00816000
as before.                                                     <<03522>>00818000
  The reason for the wide disparity in Gap  Table  lengths  is <<03522>>00820000
because  the  Gap Table is a sector (or ICT block) address ta- <<03640>>00822000
ble.  Its length is therefore related to the address space  of <<03522>>00824000
the device as well as the sector (block) length.  The 7920 Gap <<03522>>00826000
Table can hold 2814 entries (44 sectors * 128 words - 4  words <<03522>>00828000
of  header,  all  divided  by  2  words/entry) to take care of <<03522>>00830000
195552 sector addresses (815 logical  cylinders  *  5  tracks/ <<03522>>00832000
cylinder  - 1 track for the label, Gap Table, etc., all multi- <<03522>>00834000
plied by 48 sectors per track).  Users have experienced no Gap <<03522>>00836000
Table overflow with the 7920, so the 7920's ratio  of  address <<03522>>00838000
space to Gap Table entries (69.44) has been taken as a  figure <<03522>>00840000
of merit to determine the Gap Table length for the other devi- <<03522>>00842000
ces.  Those of you who are mathematically inclined  can  check <<03522>>00844000
this out.                                                      <<03522>>00846000
  The HP7935 is an exception.  With 404 Mbytes of  storage  it <<03522>>00848000
is  so  large that the Gap Table called for by the above ratio <<03522>>00850000
requires 355 sectors, or 45.4 Kwords.  This is more  than  the <<03522>>00852000
largest  MPE data segment can hold (32K).  Time constraints on <<03522>>00854000
the current  release  prevented  implementation  of  a  paging <<03522>>00856000
scheme  or  multiple  extra  data  segments,  so the Gap Table <<03640>>00858000
length has been arbitrarily set to 28,000 words.  This  allows <<03522>>00860000
for  the  other  storage which must also live in the data seg- <<03522>>00862000
ment.  This means the early warning mentioned above will occur <<03522>>00864000
when the HP7935 is about 5/8 full (assuming  the  magic  69.44 <<03522>>00866000
sectors/Gap Table entry ratio).                                <<03522>>00868000
                                                               <<03522>>00870000
The Gap Table looks like this:                                 <<03522>>00872000
                                                               <<03522>>00874000
    +---------------------------+                              <<03522>>00876000
  0 | sector addr of load point |\                             <<03522>>00878000
  1 |          unused           | \                            <<03522>>00880000
  2 |          unused           | Gap Table header             <<03522>>00882000
  3 |          unused           |/                             <<03522>>00884000
    +------+--------------------+                              <<03522>>00886000
    | type |                    |                              <<03522>>00888000
    +------+   Sector address   |   Entry (two words)          <<03522>>00890000
    |                           |                              <<03522>>00892000
    +------+--------------------+                              <<03522>>00894000
    | type |                    |                              <<03522>>00896000
    +------+   Sector address   |   Entry (two words)          <<03522>>00898000
    |                           |                              <<03522>>00900000
    +---------------------------+                              <<03522>>00902000
                  .                                            <<03522>>00904000
                  .                                            <<03522>>00906000
                  .                                            <<03522>>00908000
                                                               <<03522>>00910000
The type field is bits 0, 1 and 2  of  the  first  word.   The <<03522>>00912000
eight possible types are:                                      <<03522>>00914000
                                                               <<03522>>00916000
0.  End of File.  The associated sector address  contains  one <<03522>>00918000
    or  more  end of file fill characters (0) to fill out that <<03522>>00920000
    sector.  In the worst case (the previous record ended  ex- <<03522>>00922000
    actly  at the end of the previous sector), the end of file <<03522>>00924000
    sector contains all zeros.                                 <<03522>>00926000
1.  End of data.  The associated sector address  is  the  last <<03522>>00928000
    address  of  valid  data  plus 1, in other words, the next <<03640>>00930000
    available address.  In practice, such an entry is  usually <<03640>>00932000
    preceded  by  an end-of-file entry, since the EOD entry is <<03640>>00934000
    written when you stop writing, and the  file  system  will <<03522>>00936000
    not  let  you  backspace  or  rewind after writing without <<03522>>00938000
    sending a Write End of File.  An EOD entry is also written <<03640>>00940000
    at the beginning of the Gap  Table  when  new  (unwritten) <<03640>>00942000
    media  is  inserted.  This  prevents  erroneous reading of <<03640>>00944000
    blank media.                                               <<03640>>00946000
2.  Beginning of Hole.  The starting address of a  "defective" <<03522>>00948000
    area of the disc.  Usually on a track boundary, but may be <<03522>>00950000
    in mid-track if a contiguous block was being written  when <<03522>>00952000
    the "defect" was encountered.                              <<03522>>00954000
3.  End of Hole.  The corresponding ending address of the "de- <<03522>>00956000
    fective" area.  Always at a track  boundary.  The  end  of <<03640>>00958000
    hole  type must always be one larger than the beginning of <<03522>>00960000
    hole type, or else procedure SDISCFINDGAP will not work.   <<03522>>00962000
4.  Beginning of (contiguous) Block.  The starting address  of <<03522>>00964000
    a  contiguous  block,  exclusive of the -1 fill characters <<03522>>00966000
    which may have been required to get us to a sector bounda- <<03522>>00968000
    ry.  Unlike the End of File fill  characters,  there  need <<03522>>00970000
    not be any -1 characters if the previous record or contig- <<03522>>00972000
    uous block (with or without the trailing length word) end- <<03522>>00974000
    ed exactly on a sector boundary.                           <<03522>>00976000
$PAGE                                                          <<03522>>00978000
5.  End of (contiguous) Block.  The address of the last sector <<03522>>00980000
    containing contiguous block  data.  The  sector  may  also <<03522>>00982000
    contain -1 fill characters to get us to a sector boundary, <<03522>>00984000
    but as with the beginning of block they are  not  required <<03522>>00986000
    if the contiguous block ends exactly on a sector boundary. <<03522>>00988000
    The end of block type must always be one larger  than  the <<03522>>00990000
    beginning  of  block  type, or else procedure SDISCFINDGAP <<03522>>00992000
    will not work.                                             <<03522>>00994000
6.  End of Tape mark.  The sector address of the simulated End <<03522>>00996000
    of Tape reflector.  This type is currently used  only  for <<04249>>00998000
    floppy  discs  so that INITIAL can handle volume switching <<04249>>01000000
    while cold-loading from a multiple volume floppy disc set. <<04249>>01002000
7.  End of Gap Table.  No associated sector  address.  If  you <<03522>>01004000
    hit  this  while  scanning  the Gap Table, you've gone too <<03522>>01006000
    far.  In practice, this type is created whenever  the  Gap <<03522>>01008000
    Table is cleared, by the simple device of initializing the <<03640>>01010000
    table to -1.                                               <<03640>>01012000
                                                               <<03522>>01014000
  Data structures -- RECBUFF:                                  <<03522>>01016000
                                                               <<03522>>01018000
  To increase performance, the Serial Disc Interface maintains <<03522>>01020000
and manages a data buffer (called RECBUFF), exclusive  of  any <<03522>>01022000
File System buffers which might also be in use.  Caller I/O is <<03522>>01024000
to and from this buffer.  A full buffer while  writing  or  an <<03522>>01026000
empty one while reading cause SDISC to generate an actual disc <<03522>>01028000
I/O request to satisfy  the  problem.  This  I/O  is  blocked, <<03522>>01030000
meaning that the caller's process is waited until the I/O com- <<03522>>01032000
pletes.  SDISC also posts RECBUFF to the  disc  (even  if  not <<03522>>01034000
full) whenever a backspace or rewind occurs after writing.  As <<03522>>01036000
mentioned before, the File System guarantees that  we  have  a <<03522>>01038000
trailing  end  of  file  before the backspace or rewind is al- <<03522>>01040000
lowed.  RECBUFF is usually 4096 words long, since  performance <<03522>>01042000
measurements  have shown this to be the optimum compromise be- <<03522>>01044000
tween too small a buffer and hogging large amounts of contigu- <<03522>>01046000
ous main memory on small  systems.  Performance  and  lifetime <<03522>>01048000
constraints  of  the  ICT require a larger RECBUFF, so for the <<03640>>01050000
ICT a 16K-word RECBUFF is used.                                <<03640>>01052000
$PAGE                                                          <<03522>>01054000
  Data structures -- extra data segment:                       <<03522>>01056000
                                                               <<03522>>01058000
  You've been waiting for the other shoe to drop -- well  here <<03522>>01060000
it is!  With insignificant exceptions, SDISC operates entirely <<03522>>01062000
in split-stack mode, that is, using an extra data segment  for <<03522>>01064000
its  working  storage.  Since SDISCIO runs on the user's stack <<03522>>01066000
(under the File System and ATTACHIO), it really wouldn't do to <<03522>>01068000
have the user support a 16K RECBUFF (for an ICT)  or  a  13.6K <<03640>>01070000
Gap Table (for a 7925) on his stack.                           <<03522>>01072000
  Although SDISCIO spends most of its time communicating  with <<03522>>01074000
its  extra  data segment, it may be called with DB anywhere (a <<03522>>01076000
stack, another extra data segment, or SYSGLOB (%1000).  It re- <<03558>>01078000
turns with DB set as it was on entry.                          <<03522>>01080000
  The extra data segment is usually acquired by  the  external <<03522>>01082000
procedure  ALLOCATE  when  the serial disc device is first as- <<03522>>01084000
signed to a user as part of an FOPEN.  The external  procedure <<03522>>01086000
DEALLOCATE  makes the XDS go away as part of its processing of <<03522>>01088000
the final FCLOSE against the device. The system program PVPROC <<03522>>01090000
may also acquire and release an XDS so  that  the  tape  label <<03522>>01092000
routines in LABSEG may also use SDISC for their work when DEV- <<03522>>01094000
REC processes a device on-line interrupt.                      <<03522>>01096000
  In addition to the RECBUFF and Gap Table already  described, <<03522>>01098000
the  XDS contains SDISC's global storage area and a small buf- <<03522>>01100000
fer (called WORKTABLE) used to hold data while moving it  from <<03522>>01102000
a  "defective"  disc  area  to its new location as part of the <<03522>>01104000
process of creating a hole.  WORKTABLE also holds the contents <<03522>>01106000
of the Serial Disc label sector when SDISC reads it in as part <<03522>>01108000
of its self-configuration.  This is done in  GPTMOD,  function <<03522>>01110000
2, and further comments may be found there.                    <<03522>>01112000
  The three arrays in the XDS (WORKTABLE, RECBUFF and GPT (Gap <<03522>>01114000
Table) are all dynamically configured by SDISC as vanilla  in- <<03522>>01116000
direct  arrays,  such  as  might have been constructed by SPL. <<03522>>01118000
This is done by declaring the array names  as  pointers,  then <<03522>>01120000
inserting  appropriately computed element-0 addresses in them. <<03522>>01122000
The pointers used to reside immediately after XMITLOG,  which  <<03522>>01124000
was  the  last simple variable declared.  The first condition  <<03522>>01126000
was a holdover from when we actually used fixed length arrays  <<03522>>01128000
constructed by SPL.  With the present scheme the pointers may  <<03522>>01130000
live anywhere in the XDS, but XMITLOG must still be the  last  <<03522>>01132000
variable  so that we know where "secondary DB" starts for the  <<03522>>01134000
arrays.                                                        <<03522>>01136000
                                                               <<03522>>01140000
  The extra data segment is organized as follows:              <<03522>>01142000
                                                               <<03522>>01144000
    +-------------------+   These twelve words are reserved    <<03522>>01146000
  0 | WORDSPERSECTR     |   for use by ALLOCATE when the data  <<03522>>01148000
    |. . . . . . . . . .|   segment is created.  However, AL-  <<03522>>01150000
  1 | SECTORSPERTRAK    |   LOCATE only stuffs the last five   <<03522>>01152000
    |. . . . . . . . . .|   of them.  We fill the first seven  <<03522>>01154000
  2 | STARTADDRESS (BOT)|   ourselves with information we get  <<03522>>01156000
    |. . . . . . . . . .|   from the label sector.             <<03522>>01158000
  3 | EOTSECTR (disc    |                                      <<03522>>01160000
    | address of simu-  |                                      <<03522>>01162000
  4 | lated end of tape)|                                      <<03522>>01164000
    |. . . . . . . . . .|                                      <<03522>>01166000
$PAGE                                                          <<03522>>01168000
    |. . . . . . . . . .|                                      <<03522>>01170000
  5 | EODSECTR (last    |                                      <<03522>>01172000
    | sector of disc)   |   Simulates tape runoff.             <<03522>>01174000
  6 |                   |                                      <<03522>>01176000
    |. . . . . . . . . .|                                      <<03522>>01178000
  7 | JUSTALLOCATED     |   Tells us to initialize SDISC       <<03522>>01180000
    |. . . . . . . . . .|     parameters to BOT if true.       <<03522>>01182000
  8 | WRITERING         |   Simulation of tape write ring.     <<03522>>01184000
    |. . . . . . . . . .|                                      <<03522>>01186000
  9 | FATALERROR        |   Disables SDISC when true.          <<03522>>01188000
    |. . . . . . . . . .|                                      <<03522>>01190000
 10 | LPERRORLOG        |   Dumps XDS and user stack to LP     <<03522>>01192000
    |                   |     if true and FATALERROR occurs.   <<03522>>01194000
    |                   |     Currently may be set only in     <<03522>>01196000
    |. . . . . . . . . .|     DEBUG.                           <<03522>>01198000
 11 | MAX'DSEG'SIZE     |   Max size of our XDS, so we can     <<03522>>01200000
    +-------------------+     check that it's big enough.      <<03522>>01202000
    | SDISC global vari-|                                      <<03522>>01204000
    |   ables, including|                                      <<03522>>01206000
    |   array pointers. |                                      <<03522>>01208000
    +-------------------+                                      <<03522>>01210000
    | W                 |                                      <<03522>>01212000
    |   O               |   Length is WORDSPERSECTR *          <<03522>>01214000
    |     R             |     PORT'SECT'LEN.                   <<03522>>01216000
    |       K           |                                      <<03522>>01218000
    |         T         |                                      <<03522>>01220000
    |           A       |                                      <<03522>>01222000
    |             B     |                                      <<03522>>01224000
    |               L   |                                      <<03522>>01226000
    |                 E |                                      <<03522>>01228000
    +-------------------+                                      <<03522>>01230000
    | R                 |                                      <<03522>>01232000
    |   E               |   Length is RECBUFFLEN, which is     <<03522>>01234000
    |     C             |     calculated as 32 * WORDSPER-     <<03522>>01236000
    |       B           |     SECTR (32 blocks if ICT).        <<03640>>01238000
    |         U         |                                      <<03522>>01240000
    |           F       |                                      <<03522>>01242000
    |             F     |                                      <<03522>>01244000
    +-------------------+                                      <<03522>>01246000
    | G                 |   Length is GPTLEN, which is cal-    <<03522>>01248000
    |   A               |     culated as (STARTADDRESS -       <<03522>>01250000
    |     P             |     GPT'START) * WORDSPERSECTR.      <<03522>>01252000
    |                   |     Currently GPT'START is EQUATEd   <<03522>>01254000
    |         T         |     to 4.                            <<03522>>01256000
    |           A       |                                      <<03522>>01258000
    |             B     |                                      <<03522>>01260000
    |               L   |                                      <<03522>>01262000
    |                 E |                                      <<03522>>01264000
    +-------------------+                                      <<03522>>01266000
$PAGE                                                          <<03522>>01268000
  Data structures -- disc (or cartridge tape) organization:    <<03522>>01270000
                                                               <<03522>>01272000
  The disc is organized as follows:                            <<03522>>01274000
                                                               <<03522>>01276000
    +-------------------+                                      <<03522>>01278000
    | Label sector      |   0   See expanded view below.       <<03522>>01280000
    +-------------------+                                      <<03522>>01282000
    | Defective Trk Tbl |   1   Maintained by disc driver, not <<03640>>01284000
    +-------------------+         used by SDISC.               <<03640>>01286000
    | Cold load         |   2   HP-IB cold load channel prog.  <<03522>>01288000
    +-------------------+                                      <<03522>>01290000
    | Soft dump         |   3   SOFTDUMP channel program.      <<03522>>01292000
    +-------------------+                                      <<03522>>01294000
    | Gap Table         |   4 to STARTADDRESS - 1.             <<03522>>01296000
    |     .             |                                      <<03522>>01298000
    |     .             |                                      <<03522>>01300000
    +-------------------+                                      <<03522>>01302000
    | Data              |   STARTADDRESS                       <<03522>>01304000
    |     .             |        .                             <<03522>>01306000
    |     .             |        .                             <<03522>>01308000
    |     .             |        to                            <<03522>>01310000
    |. . . . . . . . . .|        .                             <<03522>>01312000
    |     .             |   EOTSECTR                           <<03522>>01314000
    |. . . . . . . . . .|        .                             <<03522>>01316000
    |     .             |        to                            <<03522>>01318000
    |. . . . . . . . . .|        .                             <<03522>>01320000
    | Last data sector  |   EODSECTR                           <<03522>>01322000
    +-------------------+                                      <<03522>>01324000
                                                               <<03522>>01326000
  Because the length of the Gap Table is fixed for a  specific <<03522>>01328000
device,  it  is  possible  for it to fill up (bump against the <<03522>>01330000
data area) before the data  area  does.  Currently  when  this <<03522>>01332000
happens SDISC generates a FATALERROR and dies.  A current  en- <<03640>>01334000
hancement  warns  the  user when the Gap Table is running low. <<03640>>01336000
An even better enhancement would be to  move  STARTADDRESS  to <<03522>>01338000
sector  4  and run the Gap Table backward from the last sector <<03522>>01340000
on the device.  This way the device may run out of data  space <<03522>>01342000
or  out of Gap Table, but would always be fully utilized.  The <<03522>>01344000
first enhancement was relatively easy, but the second is quite <<03640>>01346000
difficult.                                                     <<03522>>01348000
$PAGE                                                          <<03522>>01350000
  The label sector of a serial disc looks like this:           <<03522>>01352000
                                                               <<03522>>01354000
    +-------------------------------+                          <<03522>>01356000
  0 |                               |   0                      <<03522>>01358000
    |         0 (:STORE)            |                          <<03522>>01360000
  1 |                               |   1                      <<03522>>01362000
    |              or               |                          <<03522>>01364000
  2 |                               |   2                      <<03522>>01366000
    |   Cold-load SIO channel       |                          <<03522>>01368000
  3 |   program (non-HPIB machines  |   3                      <<03522>>01370000
    |   only)                       |                          <<03522>>01372000
  4 |                               |   4                      <<03522>>01374000
    |                    1 1 1 1 1 1|                          <<03522>>01376000
  5 |0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5|   5                      <<03522>>01378000
    +-+-+-+-----+-----------+-------+                          <<03522>>01380000
  6 |0|0|1|/////|   TYPE    |SUBTYPE|   6   Bit 0 = 1 ==>      <<03522>>01382000
    +-+-+-+-----+-----------+-------+         Scratch Volume   <<03522>>01384000
  7 |                               |   7   Bit 1 = 1 ==>      <<03522>>01386000
    |              0                |         Master Volume    <<03522>>01388000
 10 |                               |   8     of PV set.       <<03522>>01390000
    |                               |       Bit 2 = 1 ==>      <<03522>>01392000
 11 |                               |   9     Serial Disc.     <<03522>>01394000
    +---------------+---------------+                          <<03522>>01396000
 12 |      "S"      |      "E"      |  10 \                    <<03522>>01398000
    +---------------+---------------+      \                   <<03522>>01400000
 13 |      "R"      |      "D"      |  11   |  Volume          <<03522>>01402000
    +---------------+---------------+       |   name:          <<03522>>01404000
 14 |      "I"      |      "S"      |  12   |    "SERDISC "    <<03640>>01406000
    +---------------+---------------+      /                   <<03522>>01408000
 15 |      "C"      |      " "      |  13 /                    <<03522>>01410000
    +---------------+---------------+                          <<03522>>01412000
 16 |         WORDSPERSECTR         |  14                      <<03522>>01414000
    +-------------------------------+                          <<03522>>01416000
 17 |         SECTORSPERTRAK        |  15                      <<03522>>01418000
    +-------------------------------+                          <<03522>>01420000
 20 |          STARTADDRESS         |  16                      <<03522>>01422000
    +-------------------------------+                          <<03522>>01424000
 21 |                               |  17                      <<03522>>01426000
    |            EOTSECTR           |                          <<03522>>01428000
 22 |                               |  18                      <<03522>>01430000
    +-------------------------------+                          <<03522>>01432000
 23 |                               |  19                      <<03522>>01434000
    |            EODSECTR           |                          <<03522>>01436000
 24 |                               |  20                      <<03522>>01438000
    +-------------------------------+                          <<03522>>01440000
 25 | Reserved for WCS image        |  21                      <<03522>>01442000
  . |   address pairs.              |   .                      <<03522>>01444000
177 +-------------------------------+ 127                      <<03522>>01446000
$PAGE                                                          <<03522>>01448000
OPERATION -- FINDSDISCGAP:                                     <<03522>>01450000
                                                               <<03522>>01452000
  FINDSDISCGAP is a procedure currently called  only  by  SYS- <<03522>>01454000
DUMP.  It  scans  the  Gap Table and returns the starting disc <<03522>>01456000
address and the length of the contiguous block  whose  ordinal <<03522>>01458000
position  is passed in.  Since it does return information (re- <<03522>>01460000
ference parameters), it must be called with DB at  the  stack, <<03522>>01462000
although  it  operates  in  split-stack.  FINDSDISCGAP has two <<03522>>01464000
reasons for existence:                                         <<03522>>01466000
1.  SYSDUMP must know the starting address of  the  contiguous <<03522>>01468000
    blocks  the  cold-load  channel program is to read.  FIND- <<03522>>01470000
    SDISCGAP removes the need for SYSDUMP  to  keep  track  of <<03522>>01472000
    these addresses while it is writing the blocks.            <<03522>>01474000
2.  Even if SYSDUMP were trying to keep track of its own block <<03522>>01476000
    addresses, SDISC might relocate some blocks in the process <<03522>>01478000
    of generating holes.  SYSDUMP would not know of  this  and <<03522>>01480000
    would, therefore, build an incorrect channel program.      <<03522>>01482000
So SYSDUMP builds its cold-load contiguous block  areas,  then <<03522>>01484000
calls  FINDSDISCGAP  repeatedly until it has determined all of <<03522>>01486000
their locations and lengths.  It then stuffs this  information <<03522>>01488000
in the various parts of the channel program that require it.   <<03522>>01490000
                                                               <<03522>>01492000
AND NOW, ON-A WIT-A DA SHOW ...                                <<03522>>01494000
;                                                              <<03522>>01496000
$PAGE "SDISC - GLOBAL DECLARATIONS"                            <<03640>>01498000
       <<------------------------>>                                     01500000
       <<SYSTEM TABLES AND VALUES>>                                     01502000
       <<------------------------>>                                     01504000
EQUATE                                                                  01506000
       LDTDSTN=14,           <<LOGICAL DEVICE TABLE DST#>>              01508000
       LDTXSIZE=5,           <<SIZE OF LDTX ENTRY>>                     01510000
       LPDTSIR=9,            <<LOG-PHYS DEVICE TAB SIR>>                01514000
       LDTX1=1,              <<WORD OF LDTX WHERE DST# IS>>             01516000
       LPDT1=1,              <<SECOND WORD OF LPDT>>                    01518000
       PXGLOB1=1,            <<SECOND WORD OF PCBX>>                    01520000
       SBUFSIZE=128,         <<SIZE OF SYSTEM BUFFER>>                  01522000
       SYSBUFRDSTX=8;        <<SYSTEM BUFFER DST INDEX>>       <<00189>>01524000
DEFINE                                                                  01526000
       OFFLINE=(9:1)#, <<OFFLINE BIT OF CHECKDISC STATUS>>              01528000
       SDLF=(10:1)#,         <<SERIAL/FOREIGN DISC LOADED>>    <<01115>>01530000
                             <<FIELD OF LPDT>>                 <<01115>>01532000
       FORS=(11:1)#,         << 0=>SERIAL, 1=>FOREIGN >>       <<01115>>01534000
       TAPELOADED = (LOGICAL(LOADED) LAND                      <<03522>>01538000
               NOT LOGICAL(LPDT(LDNUM&LSL(1)+LPDT1).FORS))#,   <<01115>>01540000
       LOADED = LPDT(LDNUM&LSL(1)+LPDT1).SDLF#;                <<01115>>01542000
INTEGER                                                                 01544000
        DVCLTABB=DB+1, <<DEVICE CLASS TABLE BASE>>                      01546000
                       <<IN LDTDST>>                                    01548000
        DVCLTABS=DB+3; <<DEVICE CLASS TABLE SIZE>>                      01550000
                       <<IN LDT DST>>                                   01552000
INTEGER POINTER LPDT=8;  <<CORE RESIDENT LPDT>>                         01554000
                                                                        01556000
       <<--------------------->>                                        01558000
       <<GAP TABLE ENTRY TYPES>>                                        01560000
       <<--------------------->>                                        01562000
EQUATE                                                                  01564000
       EOFTYPE         =0,   <<END OF FILE MARK IN GPT>>                01566000
       EODTYPE         =1,   << Last valid data mark >>        <<03522>>01568000
       BOHTYPE         =2,   <<BEGINNING OF HOLE MARK IN GPT>>          01570000
       EOHTYPE         =3,   <<END OF HOLE MARK IN GPT>>                01572000
       BOBTYPE         =4,   <<START OF CONTIGUOUS BLOCK>>              01574000
       EOBTYPE         =5,   <<END OF CONTIGUOUS BLOCK>>                01576000
       EOTTYPE         =6,   << EOT reflector >>               <<03522>>01578000
       ENDOFTABLETYPE  =7;                                              01580000
       <<*************************************>>                        01582000
       <<**                                 **>>                        01584000
       << "END OF HOLE" and "END OF BLOCK"    >>                        01586000
       << entrytypes must be one larger than  >>                        01588000
       << corresponding "START OF ..." entry- >>                        01590000
       << types for SDISCFINDGAP to operate.  >>                        01592000
       <<**                                 **>>                        01594000
       <<*************************************>>                        01596000
                                                               <<03522>>01598000
       <<----------------------->>                             <<03522>>01600000
       << GPTMOD function codes >>                             <<03522>>01602000
       <<----------------------->>                             <<03522>>01604000
EQUATE                                                         <<03522>>01606000
       WRITE'EOT'MARK       = 0,   << Write EOT in Gap Tbl. >> <<04249>>01608000
       BRAND'NEW'TAPE       = 1,   << Initialize Gap Table. >> <<03522>>01610000
       NEW'VOLUME           = 2,                               <<03733>>01612000
       WRITE'EOD'AND'POST   = 3,   << Copy GPT to device.   >> <<03522>>01614000
       WRITE'EOF'MARK       = 4,                               <<03522>>01616000
       ENTER'HOLE           = 5,   << Defective media found >> <<03522>>01618000
       ENTER'CONTIG'BLOCK   = 6,                               <<04249>>01620000
       UPDT'FOR'RELOC'BLOCK = 8,   << See GPTMOD for descr. >> <<03522>>01624000
       UPDT'FOR'READ'OP     = 9,   << This one too.         >> <<03522>>01626000
       CLEAR'TO'END         =10;   << Erase GPT beyond ad-  >> <<03522>>01628000
                                   <<   dress in parm S1.   >> <<03522>>01630000
                                                               <<03522>>01632000
EQUATE GPTENTSIZE=2;                                           <<00494>>01634000
EQUATE HARDWARE'EOF=1;                                         <<00494>>01636000
EQUATE NO'EOF      =0;                                         <<03522>>01638000
                                                                        01640000
       <<------------------------->>                                    01642000
       <<CONSOLE MESSAGE INTERFACE>>                                    01644000
       <<------------------------->>                                    01646000
EQUATE                                                                  01648000
       SET1      =    1,  <<CATALOG SET NUMBER>>                        01650000
       SET19     =   19,  <<SERIAL DISC SET NUMBER>>                    01652000
       MESS220   =  220,  <<LDEV #! NO WRITE RING>>                     01654000
       MESS273   =  273,  <<LDEV #! NOT READY OR NOT SERIAL>>           01656000
       MESS274   =  274;  <<LDEV #! WRITE RING?>>                       01658000
                                                               <<03522>>01660000
       <<------------------------------------------------>>    <<03522>>01662000
       << ATTACHIO and SDISC function codes for mag tape >>    <<03522>>01664000
       <<------------------------------------------------>>    <<03522>>01666000
EQUATE                                                         <<03522>>01668000
       READ       =  0,                                        <<03522>>01670000
       WRITE'EOT  =  0,   << CTRSLDISC function.            >> <<04249>>01672000
       WRITE      =  1,                                        <<03522>>01674000
       OPEN'FILE  =  2,                                        <<03522>>01676000
       CLOSE'FILE =  3,                                        <<03522>>01678000
       CLOSE'DEVC =  4,                                        <<03522>>01680000
       REWIND     =  5,                                        <<03522>>01682000
       WRITE'EOF  =  6,                                        <<03522>>01684000
       FSF        =  7,   << Forward space file.            >> <<03522>>01686000
       BSF        =  8,   << Backspace file.                >> <<03522>>01688000
       REW'UNLOAD =  9,                                        <<03522>>01690000
       UNLOAD     =  9,   << Cartridge tape unload.         >> <<03522>>01692000
       GAP        = 10,   << Not used in SDISC.             >> <<03522>>01694000
       FSR        = 11,   << Forward space record.          >> <<03522>>01696000
       BSR        = 12,   << Backspace record.              >> <<03522>>01698000
       GET'STATUS = 15;   << Get device hardware status.    >> <<03522>>01700000
                                                                        01702000
       <<--------------------------->>                                  01704000
       <<SPECIAL FWRITE CONTROLCODES>>                                  01706000
       <<--------------------------->>                                  01708000
EQUATE                                                                  01710000
       SETCONTIG       = %1001,   << Function code to start >>          01712000
                                  <<   a contiguous block.  >>          01714000
       ENDCONTIG       = %2001,   << Function code to end   >> <<03733>>01716000
                                  <<   a contiguous block.  >>          01718000
       PRIV'WRITE'EOD  = %3001;   << Flush Gap Table with   >> <<03733>>01720000
                                  <<   EOD at EOT. For user >> <<03733>>01722000
                                  <<   logging recovery.    >> <<03733>>01724000
                                                                        01726000
                                                                        01728000
       <<---->>                                                         01730000
       <<MISC>>                                                         01732000
       <<---->>                                                         01734000
EQUATE                                                                  01736000
   CS80           =   3, << Hardware type of CS80 devices.  >> <<03522>>01738000
   CTAPE          =   0, << LINUS subtype in CS80 type.     >> <<03522>>01740000
   DEFAULT'SECTOR'SIZE = 128,  << Used before we obtain     >> <<03522>>01742000
                               << WORDPERSECTR from label.  >> <<03522>>01744000
   EOF'MARK       =   0, << Fills out sector at EOF.        >> <<03522>>01748000
   EOT'MARK       =  -2, << Fills out sector at EOT mark.   >> <<03522>>01750000
   ERR'LIMIT      =   4, << Max. # of disc write retries.   >> <<01598>>01752000
   FILLCHAR       =  -1, << Sector fill so that contiguous  >> <<04249>>01754000
                         << blocks/holes start and end on   >> <<04249>>01756000
                         << sector boundaries.          >>     <<04249>>01758000
   FLAGS'         =   1, << P'ATTACHIO parameter causes     >> <<04742>>01760000
                         << true disc I/O, unblocked.       >> <<04742>>01762000
   FLOPPY'DISC    =   2, << Hardware type of floppy disc.   >> <<04249>>01764000
   GPT'START      =   4, << GPT-relative index of 1st entry >> <<00189>>01766000
   GPTBASESECTOR  =   4, << Starting disc addr of Gap Table >>          01768000
   PORT'SECT'LEN  =   1, << # sectors in transfer buffer.   >>          01770000
   QMISC'         =   0; << ATTACHIO parameter.             >> <<00079>>01772000
                                                                        01774000
DEFINE                                                                  01776000
       ATIOERR          = ERR1.(8:8) <> 1#,                             01778000
       DEVICE'CLOSE'FLAG= JUSTALLOCATED.(0:1)#,                <<03733>>01780000
       GPT'ADR'FIELD    = (3:13)#,                                      01782000
       GPT'TYPE'FIELD   = (0:3)#,                                       01784000
       LINUS            = TYPE = CS80 AND SUBTYPE = CTAPE#,    <<04249>>01786000
       NO'ATIOERROR     = [16/1, 16/0]D#,                      <<04742>>01788000
       PORTIONLENGTH    = WORDSPERSECTR * PORT'SECT'LEN#,               01790000
       RECBUFFSECTORLEN = (RECBUFFLEN+1) / WORDSPERSECTR#,              01792000
       SDERR            = ((ERRORCODE > 0) LAND                <<04742>>01794000
                             NOT DEVICE'CLOSE'FLAG)#,          <<04742>>01796000
       SUBTYPE          = TYPE'SUBTYPE.(12:4)#,                <<03522>>01798000
       SUBTYPE'FIELD    = (12:4)#,   << in VLAB(6).         >> <<03522>>01800000
       TYPE             = TYPE'SUBTYPE.(0:7)#,                 <<03522>>01802000
       TYPE'FIELD       = (6:6)#;    << in VLAB(6).         >> <<03522>>01804000
                                                                        01806000
       <<---------------------->>                                       01808000
       <<SERIAL DISC ERRORCODES>>                                       01810000
       <<---------------------->>                                       01812000
                                                               <<03640>>01814000
  COMMENT -- Positive error codes < 100 are fatal errors, that <<03640>>01816000
is, they cause SDISCIO to set the FATALERROR flag (disallowing <<03640>>01818000
further serial disc operations on this FOPEN for this device), <<03640>>01820000
generate an error message to $STDLIST and return  an  ATTACHIO <<03640>>01822000
status to the caller.  Negative error codes and positive error <<03640>>01824000
codes >= 100 are not fatal and generate no message.  They  do, <<03640>>01826000
however,  return  the ATTACHIO status corresponding to \error- <<03640>>01828000
code\ or (errorcode - 100), as appropriate. The difference be- <<03640>>01830000
tween the two types of non-fatal codes is that  positive  ones <<03640>>01832000
abort the current request, negative ones allow it to continue. <<03640>>01834000
;                                                              <<03640>>01836000
EQUATE                                                                  01838000
      SDERR0=0,<<ALL OKAY--OR--EOF DETECTED                  >>         01840000
      SDERR1=1, << Unused.                                  >> <<03522>>01842000
      SDERR2=2,<<ATTACHIO ERROR-INITIALIZING DATASEG         >><<00079>>01844000
      SDERR3=3,<<FATAL ERROR DETECTED-SDISC DISABLED         >><<00239>>01846000
      SDERR4=4,<<INVALID LENGTH PASSED TO "WRITE"            >>         01848000
      SDERR5=5,<<END OF TAPE DETECTED                        >>         01850000
      SDERR6=6,<<PACK OVFL-RELOCATING CONTIG BLOCK           >>         01852000
      SDERR7=7,<<PACK OVERFLOW-PROBABLY IGNORED EOT          >>         01854000
      SDERR8=8,<<PACK OVERFLOW-WRITE ERROR ON LAST TRACK     >>         01856000
      SDERR9=9,<<CONTIG & NON-CONTIG DATA MIXED IN RECBUFF   >>         01858000
      SDERR10=10, << File not open, can't call FINDSDISCGAP >> <<03558>>01860000
      SDERR11=11,  << FINDSDISCGAP - Block no. must be > 0. >> <<03522>>01862000
      SDERR12=12,<<ATTACHIO FAILURE-MOVING AROUND DEFECT     >>         01864000
      SDERR13=13,<<ATTACHIO FAILURE-READING GAP TABLE        >>         01866000
      SDERR14=14,<<INVALID CONTROLCODE                       >>         01868000
      SDERR15=15,<<ATTACHIO FAILURE-WRITING GPT              >>         01870000
      SDERR16=16,<<ATTEMPTED TO WRITE ON PROTECTED DISC      >><<00239>>01872000
      SDERR17=17,<<OUT OF SYNC WITH GAPTABLE WHILE READING   >>         01874000
      SDERR18=18,<<GAPTABLE EXPANDED BEYOND CAPACITY         >><<00189>>01876000
      SDERR19=19,<<TOO MANY EOF MARKS FOR THIS DISC TYPE     >><<00467>>01878000
      SDERR20=20, << No spare blocks available.             >> <<03522>>01880000
      SDERR21=21, << Uninitialized media.                   >> <<03522>>01882000
      SDERR22=22,<<ATTEMPTED TO READ PAST END OF DATA        >>         01884000
      SDERR23=23,<<CURRENTBUFINDEX OUTSIDE OF RECBUFF        >>         01886000
      SDERR24=24,<<ATTEMPTED TO BSF BEYOND BOT               >>         01888000
      SDERR25=25,<<ATTEMPTED TO BACKWARD READ PAST LOADPOINT >>         01890000
      SDERR26=26, << Unused.                                >> <<03522>>01892000
      SDERR27=27,<<RUN AWAY SERIAL DISC                      >>         01894000
      SDERR28=28,<<LOCATED BEYOND END OF GAP TABLE           >><<00189>>01896000
      SDERR29=29, << ATTACHIO failure - writing data.       >> <<03522>>01898000
      SDERR30=30,<<LEADING AND TRAILING RECLENS DON'T MATCH  >>         01900000
      SDERR31=31,<<FINDGAP FAILURE-TRIED TO OVERFILL RECBUFF >>         01902000
      SDERR32=32,<<ATTACHIO FAILURE-READING DATA             >>         01904000
      SDERR33=33, << Too many write errors, reformat disc.  >> <<03522>>01906000
      SDERR34=34, << Unused.                                >> <<03522>>01908000
      SDERR35=35,<<DSTN IN LDTX IS ZERO FOR THIS SDISC       >>         01910000
      SDERR36=36, << Insufficient data segment size.        >> <<03522>>01912000
      SDERR37=37,<<ATTEMPTED WRITE PAST EOT W/O P2.(13:1)=1  >>         01914000
      SDERR38=38, << ATTACHIO failure - load or unload.     >> <<03522>>01916000
      SDERR39=39, << Unused.                                >> <<03522>>01918000
      SDERR40=40,<<NO WRITE RING                             >>         01920000
      SDERR41=41, << Unused.                                >> <<03522>>01922000
      SDERR42=42, << Unused.                                >> <<03522>>01924000
      SDERR43=43,<<NECESSARY PARM MISSING IN CALL TO GPTMOD  >><<00189>>01926000
      SDERR122=122; << File system anticipatory read.       >> <<03640>>01928000
$PAGE                                                          <<03640>>01932000
<<********************************************>>                        01934000
<<THESE VARIABLES DEFINE THE SERIAL DISC DATA >>                        01936000
<<SEGMENT AND MUST NOT BE MOVED OR REDEFINED  >>                        01938000
<<WITHOUT MAKING THE CORRESPONDING CHANGES IN >>                        01940000
<<ALL MPE MODULES WHICH REFERENCE A SERIAL    >>                        01942000
<<DISC DATA SEGMENT                           >>                        01944000
<<********************************************>>                        01946000
EQUATE                                                                  01948000
  INITARRAYSIZE = 12;   << Number of elements reserved for  >> <<03522>>01950000
                        <<   ALLOCATE.                      >> <<03522>>01952000
DEFINE IAS=INITARRAYSIZE#;                                              01954000
EQUATE IAS0=IAS+0,                                                      01956000
       IAS1=IAS+1,                                                      01958000
       IAS2=IAS+2,                                                      01960000
       IAS3=IAS+3,                                                      01962000
       IAS4=IAS+4,                                                      01964000
       IAS5=IAS+5,                                                      01966000
       IAS6=IAS+6,                                                      01968000
       IAS7=IAS+7,                                                      01970000
       IAS8=IAS+8,                                             <<00239>>01972000
       IAS9=IAS+9;                                             <<00239>>01974000
INTEGER ARRAY DBARRAY(*)=DB;                                   <<00494>>01976000
                                                               <<03522>>01978000
<< The following array is never referenced  in  SDISC,  but >> <<03522>>01980000
<< must  be included so that DB-relative variables declared >> <<03522>>01982000
<< later do not step on the equivalenced variables below.   >> <<03522>>01984000
                                                               <<03522>>01986000
INTEGER ARRAY DBHOLD(0:IAS9)=DB;                               <<00239>>01988000
INTEGER                                                                 01990000
        WORDSPERSECTR=DB,                                      <<03522>>01992000
        SECTORSPERTRAK=DB+1,  <<#SECTORS/TRACK FOR THIS DISC>>          01996000
        STARTADDRESS=DB+2;   <<SECTOR#OF LOAD POINT>>                   01998000
                                                               <<03522>>02000000
DOUBLE                                                                  02002000
  EOTSECTR = DB+3,   << Device address of simulated EOT re- >> <<03522>>02004000
                     << flector.                            >> <<03522>>02006000
  EODSECTR = DB+5;   << Highest address on device --   >>      <<03522>>02008000
                                                                        02010000
INTEGER                                                                 02012000
  EODSECTR0 = EODSECTR,                                        <<03522>>02014000
  EODSECTR1 = EODSECTR + 1,                                    <<03522>>02016000
  EOTSECTR0 = EOTSECTR,                                        <<03522>>02018000
  EOTSECTR1 = EOTSECTR + 1;                                    <<03522>>02020000
                                                               <<03522>>02022000
LOGICAL                                                                 02024000
        JUSTALLOCATED=DB+7,<<SET TRUE BY ALLOCATE AND REWUNLD>>         02026000
        WRITERING=DB+8,    <<FLAG--SIMULATION OF WRITE RING>>  <<00239>>02028000
        FATALERROR=DB+9,<<FLAG--DISABLES ALL SDISC FUNCTIONS>> <<00494>>02030000
        LPERRORLOG=DB+10,   << When true, any fatal error   >> <<03522>>02032000
                            << causes dump of stack and XDS >> <<03522>>02034000
                            << to printer (class = LP).     >> <<03522>>02036000
                            << Currently only a debug tool. >> <<03522>>02038000
        MAX'DSEG'SIZE = DB+11;   << Set by ALLOCATE, used   >> <<03522>>02040000
                                 << to check for enough GPT >> <<03522>>02042000
$PAGE                                                          <<03640>>02044000
INTEGER ARRAY PARMARRAY(*)=DB+IAS0;                                     02046000
INTEGER                                                                 02048000
       LDNUM=DB+IAS0,      <<PARAMETERS PASSED TO ATTACHIO>>            02050000
       QMISC=DB+IAS1,                                                   02052000
       DSTX=DB+IAS2,                                                    02054000
       ADDR=DB+IAS3,                                                    02056000
       FUNC=DB+IAS4,                                                    02058000
       CNT=DB+IAS5,                                                     02060000
       P1=DB+IAS6,                                                      02062000
       P2=DB+IAS7,                                                      02064000
       FLAGS=DB+IAS8;                                                   02066000
$PAGE                                                          <<03522>>02068000
<<********************************************>>                        02070000
<<THE FOLLOWING DB-RELATIVE VARIABLES ARE NOT >>                        02072000
<<REFERENCED OUTSIDE OF THE SERIAL DISC       >>                        02074000
<<INTERFACE AND MAY BE REARRANGED OR DELETED  >>                        02076000
<<AS NECESSARY FOR SUPPORT OF THE SERIAL      >>                        02078000
<<INTERFACE.  CHECK IMPACT ON SETSDISCERROR   >>               <<00494>>02080000
<<BEFORE ADDING OR REARRANGING VARIABLES.!!!!!>>               <<00494>>02082000
<<********************************************>>                        02084000
DOUBLE                                                                  02086000
   CONTIGSTARTSECT,   << Disc address of start of current   >>          02088000
                      << contiguous write block -OR- -1 if  >>          02090000
                      << not currently writing contig blk.  >>          02092000
   RECBUFFSA,         << Disc address where start of RECBUFF >><<00494>>02094000
                      << came from or will go.              >> <<00494>>02096000
   RECBUFFEA;         << Same for end of RECBUFF.           >> <<00494>>02098000
                                                                        02100000
DEFINE                                                         <<00494>>02102000
   CURRENTADR = RECBUFFSA +                                             02104000
                  DOUBLE (CURRENTBUFINDEX/WORDSPERSECTR)#;     <<03522>>02106000
                                                               <<03522>>02108000
LOGICAL                                                                 02110000
   ALREADYREJECTED,   << If true, operator has already re-  >> <<00189>>02112000
                      << plied "No" to the extra "WRITE     >> <<00189>>02114000
                      << RING" request.                     >> <<00189>>02116000
   NEXTRECINBUF,      << If true, beginning of next record  >>          02118000
                      << is in RECBUFF.                     >>          02120000
   NULLTRANSFER,      << Set TRUE during Forward Space Re-  >>          02122000
                      << cord control code to prevent phys- >>          02124000
                      << ical data transfer by READSDISC.   >>          02126000
   TAPEREWOUND,       << Set TRUE by Rewind or Rewind/Un-   >>          02128000
                      << load.  Remains set until next ac-  >>          02130000
                      << cess.  Forces GPT reset for multi- >>          02132000
                      << ple reel files.                    >>          02134000
   TAPEWRITTEN,       << If true, last access was for writ- >>          02136000
                      << ing data or EOF.  Can't read until >>          02138000
                      << a rewind or backspace occurs.      >>          02140000
   TYPE'SUBTYPE;      << Holds hdwr device type & subtype.  >> <<03522>>02142000
                                                               <<03522>>02144000
LOGICAL POINTER                                                <<03522>>02146000
   WORKTABLE,   << Holds volume label when read, also used  >> <<03522>>02148000
                << as temp area when moving data during DE- >> <<03522>>02150000
                << CLAREHOLE.                               >> <<03522>>02152000
   PORTION = WORKTABLE,                                        <<03522>>02154000
   RECBUFF,     << SDISC's data buffer.                     >> <<03522>>02156000
   GPT;         << The Gap Table.                           >> <<03522>>02158000
$PAGE                                                          <<03522>>02160000
INTEGER                                                                 02162000
   CURRENTBUFINDEX,     << Word displacement in RECBUFF.    >>          02164000
                        << Varies from 0 to RECBUFFLEN.     >>          02166000
   CURRENTGPTENT,       << Word displacement in Gap Table.  >>          02168000
                        << Varies from GPT'START to GPTLEN. >>          02170000
   DBOFFSET,            << Offset to DB (DB-DL) in caller's >>          02172000
                        << stack -OR- 0 if we were called   >>          02174000
                        << in split-stack.                  >>          02176000
   DSTN,                << Serial Disc data segment number. >>          02178000
   EOFCODE,             << 0 = no EOF, 1 = EOF read in      >>          02180000
                        << RECBUFF.                         >>          02182000
   ERR'RETRY,           << No. of unsuccessful disc writes  >> <<03522>>02184000
                        << of one RECBUFF.  Varies from 0   >> <<03522>>02186000
                        << to ERR'LIMIT.                    >> <<03522>>02188000
   ERRORCODE,           << Serial Disc Interface error no.  >>          02190000
                        << 0 = no error or EOF, 1-99 are    >>          02192000
                        << fatal (SDI shuts down).  Nega-   >>          02194000
                        << tive values are non-fatal (in-   >>          02196000
                        << formational) equivalents of the  >>          02198000
                        << corresponding positive values.   >>          02200000
                        << Values > 100 are also non-fatal  >>          02202000
                        << equivalents of (ERRORCODE - 100) >>          02204000
   GPTLEN,              << Maximum length of Gap Table.     >> <<03522>>02206000
   READ0 = RECBUFFEA,   << Single-word equivalents of each  >> <<00494>>02208000
   READ1 = RECBUFFEA+1, << word of RECBUFFEA.               >> <<00494>>02210000
   RECBUFFLEN,          << Length of RECBUFF, less one.     >> <<03522>>02212000
   RITE0 = RECBUFFSA,   << Single-word equivalents of each  >> <<00494>>02214000
   RITE1 = RECBUFFSA+1, << word of RECBUFFSA.               >> <<00494>>02216000
   USERSTACK,           << DST number of user's stack.      >>          02218000
   WORDSINRECBUF,       << Number of words present in REC-  >>          02220000
                        << BUFF after READBLOCK finishes.   >>          02222000
   X = X,                                                               02224000
   S0 = S-0,                                                            02226000
   S1 = S-1,                                                            02228000
   S2 = S-2,                                                            02230000
   S3 = S-3,                                                            02232000
   S4 = S-4,                                                            02234000
   S5 = S-5;                                                            02236000
                                                                        02238000
       <<------------------------->>                                    02240000
       <<END OF TAPE SENSOR STATES>>                                    02242000
       <<------------------------->>                                    02244000
LOGICAL                                                        <<03522>>02246000
  BOT'SENSOR,  << TRUE whenever we're at Load Point.        >> <<03522>>02248000
  EOTSENSOR;   << Set <> 0 when we write on or beyond  EOT- >> <<04249>>02250000
               << SECTR.                                    >> <<03522>>02252000
EQUATE                                                         <<03522>>02254000
  BOT'NOT'FOUND = 0,                                           <<03522>>02256000
  BOT'FOUND     = 1,                                           <<03522>>02258000
  EOTNOTFOUND   = 0,                                           <<03522>>02260000
  EOTFOUND      = 1,                                           <<04249>>02262000
  EOT'WRITTEN   = 2;                                           <<04249>>02264000
$PAGE                                                          <<03640>>02266000
<<TIGHT COUPLING>>                                                      02268000
<< These cells are  used  to  return  values  from  GPTMOD, >>          02270000
<< SDISCFINDGAP, and BACKBLOCKREAD.                         >>          02272000
DOUBLE RTV1,                                                            02274000
       STARTBLOCK=RTV1,                                                 02276000
       STARTGAP=RTV1,                                                   02278000
       RTV2,                                                            02280000
       BLOCKLENGTH=RTV2,                                                02282000
       ENDGAP=RTV2;                                                     02284000
INTEGER RTV3,                                                           02286000
        GAPTYPE=RTV3,                                                   02288000
        BOT'SECTOR'COUNT = RTV3,  << Retnd by BACKBLOCKREAD >> <<03522>>02290000
        RTV4,                                                           02292000
        ENDINDEX=RTV4;                                                  02294000
LOGICAL STATUS1=RTV3,                                                   02296000
        STATUS2=RTV4;                                                   02298000
<<TIGHT COUPLING>>                                                      02300000
$PAGE                                                          <<03522>>02302000
                                                                        02304000
<<   XMITLOG must be the last declaration in the  DB  area. >> <<03522>>02306000
<< GPTMOD,  function 2, uses XMITLOG's address +1 as a base >> <<03522>>02308000
<< of the "secondary DB" area for  WORKTABLE,  RECBUFF  and >> <<03522>>02310000
<< the Gap Table.                                           >> <<03522>>02312000
                                                               <<03522>>02314000
INTEGER                                                                 02318000
  XMITLOG;   << +words or -chars transmitted to/from user.  >>          02320000
                                                               <<00079>>02324000
<<   These offsets into the Volume Label (VLAB)  sector  of >> <<03522>>02326000
<< the serial disc define locations of various disc config- >> <<03522>>02328000
<< uration parameters which SDISC uses to define the limits >> <<03522>>02330000
<< of the disc (EOTSECTR, EODSECTR),  a  sector  (WORDSPER- >> <<03522>>02332000
<< SECTR), RECBUFF and the Gap Table. The entire label sec- >> <<03522>>02334000
<< tor is read into the WORKTABLE when the device is  first >> <<03522>>02336000
<< allocated.                                               >> <<03522>>02338000
                                                               <<03522>>02340000
EQUATE                                                                  02342000
      VLAB'TYPE'SUBTYPE = 6,   << Hardware type and subtype >> <<03522>>02344000
      VLAB'WPS=14, <<WORDSPERSECTOR INDEX>>                             02346000
      VLAB'SPT=15, <<SECTORSPERTRACK>>                                  02348000
      VLAB'SA=16,  <<LOADPOINT-STARTADDRESS>>                           02350000
      VLAB'EOT=17, <<END OF TAPE SECTOR>>                               02352000
      VLAB'EOD=19; <<EON OF DISC SECTOR>>                               02354000
$PAGE "SDISC - EXTERNAL PROCEDURE DECLARATIONS"                         02358000
INTRINSIC                                                      <<00494>>02360000
     ASCII,                                                    <<00494>>02362000
     DEBUG,                                                    <<03640>>02364000
     FOPEN,                                                    <<00494>>02366000
     FWRITE,                                                   <<00494>>02368000
     FCLOSE;                                                   <<00494>>02370000
                                                               <<04742>>02372000
DOUBLE PROCEDURE P'ATTACHIO (LDNUM, QMISC, DSTX, OFFSET,       <<04828>>02374000
                 FUNCTION, COUNT, P1, P2, FLAGS,               <<04828>>02376000
                 EXTENT'BASE, EXTENT'LENGTH);                  <<04828>>02378000
   VALUE   LDNUM, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1,    <<04828>>02380000
           P2, FLAGS, EXTENT'BASE, EXTENT'LENGTH;              <<04828>>02382000
   INTEGER LDNUM, QMISC, DSTX, OFFSET, FUNCTION, COUNT, P1,    <<04828>>02384000
           P2, FLAGS, EXTENT'LENGTH;                           <<04828>>02386000
   DOUBLE EXTENT'BASE;                                         <<04828>>02388000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL, VARIABLE;          <<04828>>02390000
                                                               <<00239>>02392000
DOUBLE PROCEDURE REQSTATUS(LDN);                               <<00239>>02394000
VALUE LDN;                                                     <<00239>>02396000
INTEGER LDN;                                                   <<00239>>02398000
OPTION EXTERNAL;                                               <<00239>>02400000
                                                               <<00189>>02404000
INTEGER PROCEDURE GETSIR(A);                                            02406000
VALUE A;                                                                02408000
INTEGER A;                                                              02410000
OPTION EXTERNAL;                                                        02412000
                                                                        02414000
PROCEDURE RELSIR(A,B);                                                  02416000
VALUE A,B;                                                              02418000
INTEGER A,B;                                                            02420000
OPTION EXTERNAL;                                                        02422000
                                                                        02424000
LOGICAL PROCEDURE EXCHANGEDB(A);                                        02426000
VALUE A;                                                                02428000
LOGICAL A;                                                              02430000
OPTION EXTERNAL;                                                        02432000
                                                                        02434000
LOGICAL PROCEDURE SETSYSDB;                                             02438000
OPTION EXTERNAL;                                                        02440000
                                                                        02442000
PROCEDURE RESETDB(OLDDB);                                               02444000
VALUE OLDDB;                                                            02446000
INTEGER OLDDB;                                                          02448000
OPTION EXTERNAL;                                                        02450000
                                                                        02452000
PROCEDURE DELAY(T);                                                     02454000
VALUE T;                                                                02456000
DOUBLE T;                                                               02458000
OPTION EXTERNAL;                                                        02460000
$PAGE                                                          <<03522>>02464000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,                  02466000
PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,CONTROL);                       02468000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,                   02470000
  DEST, REPLY, OFFSET, DST, CONTROL;                                    02472000
INTEGER SETNO,MSGNO,DEST,DST;                                           02474000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,                02476000
  CONTROL;                                                              02478000
OPTION VARIABLE,EXTERNAL;                                               02480000
                                                                        02482000
PROCEDURE CHECKDISC(LDNUM,STATUS);                                      02484000
VALUE LDNUM;                                                            02486000
INTEGER LDNUM;                                                          02488000
LOGICAL STATUS;                                                         02490000
OPTION EXTERNAL;                                                        02492000
$PAGE "SDISC - FORWARD PROCEDURE DECLARATIONS"                 <<03522>>02494000
PROCEDURE CTRLSDISC;                                           <<00494>>02496000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          <<00494>>02498000
                                                                        02500000
procedure LOGSDISCERROR(SdiscDst);                             <<00494>>02502000
value SdiscDst;                                                <<00494>>02504000
integer SdiscDst;                                              <<00494>>02506000
option privileged,uncallable,forward;                          <<00494>>02508000
                                                                        02510000
DOUBLE PROCEDURE ACTUAL'ADDRESS;                               <<03522>>02512000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<03522>>02514000
                                                               <<03522>>02516000
PROCEDURE SDISCFINDGAP (STARTSECTOR, ENDSECTOR);               <<03522>>02518000
  VALUE STARTSECTOR, ENDSECTOR;                                <<03522>>02520000
  DOUBLE STARTSECTOR, ENDSECTOR;                               <<03522>>02522000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD;                      <<03522>>02524000
                                                               <<03522>>02526000
PROCEDURE LOCK'CS80'DEVICE;                                    <<03522>>02528000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD;                      <<03522>>02530000
                                                               <<03522>>02532000
PROCEDURE UNLOCK'CS80'DEVICE;                                  <<03522>>02534000
  OPTION PRIVILEGED, UNCALLABLE, FORWARD;                      <<03522>>02536000
$PAGE "SDISC - ERROR TRAP/DUMP"                                <<00494>>02538000
integer procedure FETCH'DST(Dstn,Offset);                      <<00494>>02540000
value                                                          <<00494>>02542000
  Dstn,                                                        <<00494>>02544000
  Offset;                                                      <<00494>>02546000
integer                                                        <<00494>>02548000
  Dstn,                                                        <<00494>>02550000
  Offset;                                                      <<00494>>02552000
option privileged,uncallable;                                           02554000
begin                                                                   02556000
if Dstn<>0 then EXCHANGEDB(Dstn);                                       02558000
FETCH'DST:=DBarray(Offset);                                             02560000
EXCHANGEDB(0);                                                          02562000
end;                                                                    02564000
procedure PRINT'DL'Z(DLreg,Zreg,LPfnum,Dstn);                  <<00494>>02566000
value                                                          <<00494>>02568000
  DLreg,                                                       <<00494>>02570000
  Zreg,                                                        <<00494>>02572000
  LPfnum,                                                      <<00494>>02574000
  Dstn;                                                        <<00494>>02576000
integer                                                        <<00494>>02578000
  DLreg,                                                       <<00494>>02580000
  Zreg,                                                        <<00494>>02582000
  LPfnum,                                                      <<00494>>02584000
  Dstn;                                                        <<00494>>02586000
option privileged,uncallable;                                  <<00494>>02588000
comment                                                        <<00494>>02590000
  Purpose: This procedure will dump, in octal and ascii,       <<00494>>02592000
           the contents of the current dataseg from DL         <<00494>>02594000
           to Z.                                               <<00494>>02596000
  Input:   DLreg- The DB-relative address at which to start.   <<00494>>02598000
           Zreg- The DB-relative address at which to stop.     <<00494>>02600000
           LPfnum-The file number of the line printer on       <<00494>>02602000
                  which to dump.  (Must be at least 80 char    <<00494>>02604000
                  in width.)                                   <<00494>>02606000
           NOTE- DB MUST POINT AT STACK ON ENTRY!              <<00494>>02608000
                                                               <<00494>>02610000
  Output:  The dst will be printed in the following format:    <<00494>>02612000
           O6,X,8(O6,X),(A2) <<Sort of a FORTRAN format>>      <<00494>>02614000
           Address,space,eight values,ascii equivalent.        <<00494>>02616000
end of comment;                                                <<00494>>02618000
                                                               <<00494>>02620000
  begin                                                        <<00494>>02622000
  array                                                        <<00494>>02624000
    Outbuf(0:39);                                              <<00494>>02626000
  byte array                                                   <<00494>>02628000
    Outbuf'B(*)=Outbuf;                                        <<00494>>02630000
  byte array                                                   <<00494>>02632000
    LastLine(0:79);                                            <<00494>>02634000
  logical                                                      <<00494>>02636000
    Gap:=false;                                                <<00494>>02638000
  integer                                                      <<00494>>02640000
    RowBaseAddress,                                            <<00494>>02644000
    ColumnIndex;                                               <<00494>>02646000
  equate                                                       <<00494>>02648000
    RowSize=8;                                                 <<00494>>02650000
                                                               <<00494>>02652000
  RowBaseAddress:=(DLreg-(RowSize-1))/RowSize*RowSize;         <<00494>>02654000
  Outbuf'B:=" ";                                               <<00494>>02656000
  move Outbuf'B(1):=Outbuf'B,(79);                             <<00494>>02658000
  Outbuf'B(6):=":";                                            <<00494>>02660000
  do                                                           <<00494>>02662000
    begin                                                      <<00494>>02664000
    ColumnIndex:=0; <<column index>>                           <<00494>>02666000
    ASCII(RowBaseAddress,8,Outbuf'B);                          <<00494>>02668000
    do                                                         <<00494>>02670000
      begin                                                    <<00494>>02672000
      if DLreg<=RowBaseAddress+ColumnIndex<=Zreg then          <<00494>>02674000
        begin                                                  <<00494>>02676000
        ASCII(FETCH'DST(Dstn,RowBaseAddress+ColumnIndex),8,    <<00494>>02678000
        Outbuf'B((ColumnIndex+1)*7));                          <<00494>>02680000
        Outbuf'B(ColumnIndex*2+63):=FETCH'DST(Dstn,            <<00494>>02682000
        RowBaseAddress+ColumnIndex).(0:8);                     <<00494>>02684000
        Outbuf'B(ColumnIndex*2+64):=FETCH'DST(Dstn,            <<00494>>02686000
        RowBaseAddress+ColumnIndex).(8:8);                     <<00494>>02688000
        end                                                    <<00494>>02690000
      else                                                     <<00494>>02692000
        begin                                                  <<00494>>02694000
        move Outbuf'B((ColumnIndex+1)*7):="      ";            <<00494>>02696000
        move Outbuf'B(ColumnIndex*2+63):="  ";                 <<00494>>02698000
        end;                                                   <<00494>>02700000
      end                                                      <<00494>>02702000
    until (ColumnIndex:=ColumnIndex+1)>=RowSize;               <<00494>>02704000
    if LastLine=Outbuf'B(7),(56) then                          <<00494>>02706000
      begin                                                    <<00494>>02708000
      if not Gap then                                          <<00494>>02710000
        begin                                                  <<00494>>02712000
        Gap:=TRUE;                                             <<00494>>02714000
        move Outbuf'B:="*** GAP ***";                          <<00494>>02716000
        FWRITE(LPfnum,Outbuf,-11,0);                           <<00494>>02718000
        if <> then DEBUG;                                      <<00494>>02720000
        Outbuf'B(6):=":";                                      <<00494>>02722000
        end;                                                   <<00494>>02724000
      end                                                      <<00494>>02726000
    else                                                       <<00494>>02728000
      begin                                                    <<00494>>02730000
      move LastLine:=Outbuf'B(7),(56);                         <<00494>>02732000
      Gap:=FALSE;                                              <<00494>>02734000
      end;                                                     <<00494>>02736000
    if not Gap then                                            <<00494>>02738000
      begin                                                    <<00494>>02740000
      FWRITE(LPfnum,Outbuf,-79,0);                             <<00494>>02742000
      if <> then DEBUG;                                        <<00494>>02744000
      end;                                                     <<00494>>02746000
    end                                                        <<00494>>02748000
  until (RowBaseAddress:=RowBaseAddress+RowSize)>Zreg;         <<00494>>02750000
  end;                                                         <<00494>>02752000
procedure SETSDISCERROR(ErrorNum);                             <<00494>>02754000
value                                                          <<00494>>02756000
  ErrorNum;                                                    <<00494>>02758000
integer                                                        <<00494>>02760000
  ErrorNum;                                                    <<00494>>02762000
option privileged,uncallable;                                  <<00494>>02764000
comment:                                                       <<00494>>02766000
  Purpose:To snapshot the stack and serial disc xds at the time<<00494>>02768000
          a fatal error is detected.                           <<00494>>02770000
  Input: Errornum-The sdisc errorcode to be returned.  It      <<00494>>02772000
                  really has no effect on the routine.  It is  <<00494>>02774000
                  passed in as a parameter, and passed back as <<00494>>02776000
                  the function value.                          <<00494>>02778000
  Output:See Errornum of INPUT.                                <<00494>>02780000
end of comment;                                                <<00494>>02782000
                                                               <<00494>>02784000
  begin                                                        <<00494>>02786000
  integer SdiscDst;                                            <<00494>>02788000
                                                               <<00494>>02790000
  ErrorCode:=ErrorNum;                                         <<00494>>02792000
  if not LPErrorLog then RETURN;                               <<00494>>02794000
  SdiscDst:=Dstn;                                              <<00494>>02796000
  EXCHANGEDB(0);                                               <<00494>>02798000
  LOGSDISCERROR(SdiscDst);                                     <<00494>>02800000
  EXCHANGEDB(SdiscDst);                                        <<00494>>02802000
  end;                                                         <<00494>>02804000
procedure LOGSDISCERROR(SdiscDst);                             <<00494>>02806000
value                                                          <<00494>>02808000
  SdiscDst;                                                    <<00494>>02810000
integer                                                        <<00494>>02812000
  SdiscDst;                                                    <<00494>>02814000
option privileged,uncallable;                                  <<00494>>02816000
                                                               <<00494>>02818000
comment:                                                       <<00494>>02820000
  Purpose:To format the register dump for the stack and the    <<00494>>02822000
          variable dump for the serial disc XDS.               <<00494>>02824000
          To determine the upper and lower bounds of the stack <<00494>>02826000
          and XDS and call PRINT'DL'Z to get them output to    <<00494>>02828000
          the lineprinter file "LP".                           <<00494>>02830000
  Input:  SdiscDst- As DB MUST POINT AT STACK ON ENTRY, this   <<00494>>02832000
          is the XDS#.                                         <<00494>>02834000
  Output: None.                                                <<00494>>02836000
end of comment;                                                <<00494>>02838000
                                                               <<00494>>02840000
                                                               <<00494>>02842000
  begin                                                        <<00494>>02844000
DOUBLE                                                         <<03522>>02846000
  START'SECTOR;                                                <<03522>>02848000
                                                               <<03522>>02850000
  array                                                        <<00494>>02852000
    Outbuf(0:39);                                              <<00494>>02854000
  byte array                                                   <<00494>>02856000
    Outbuf'B(*)=Outbuf,                                        <<00494>>02858000
    LPfnam(0:8),                                               <<00494>>02860000
    LPdev(0:2);                                                <<00494>>02862000
  integer                                                      <<00494>>02864000
    DBreg,                                                     <<00494>>02866000
    DBbank,                                                    <<00494>>02868000
    DLreg,                                                     <<00494>>02870000
    Zreg,                                                      <<00494>>02872000
    STATUSreg,                                                 <<00494>>02874000
    Xreg,                                                      <<00494>>02876000
    Qreg,                                                      <<00494>>02878000
    Sreg,                                                      <<00494>>02880000
    Sbank,                                                     <<00494>>02882000
    I,                                                         <<00494>>02884000
    FORMAT'LIMIT,                                              <<03522>>02886000
    SEGMENT'LIMIT,                                             <<03522>>02888000
    LPfnum,                                                    <<00494>>02890000
    LastSTATUS=Q-1,                                            <<00494>>02892000
    LastX=Q-3,                                                 <<00494>>02894000
    DeltaQ=Q,                                                  <<00494>>02896000
    LastS=Q-6;                                                 <<00494>>02898000
                                                               <<00494>>02900000
  move LPfnam:="SDISCERR ";                                    <<00494>>02902000
  move LPdev:="LP ";                                           <<00494>>02904000
  LPfnum:=FOPEN(LPfnam,4,%401,40,LPdev);                       <<00494>>02906000
  if <> then DEBUG;                                            <<00494>>02908000
  PUSH(Q,Z,DL,DB,SBANK);                                       <<00494>>02910000
  Sbank:=tos;                                                  <<00494>>02912000
  DBreg:=tos;                                                  <<00494>>02914000
  DBbank:=tos;                                                 <<00494>>02916000
  DLreg:=tos;                                                  <<00494>>02918000
  Zreg:=tos;                                                   <<00494>>02920000
  Qreg:=tos;                                                   <<00494>>02922000
  STATUSreg:=LastSTATUS;                                       <<00494>>02924000
  Xreg:=LastX;                                                 <<00494>>02926000
  Qreg:=Qreg-DeltaQ;                                           <<00494>>02928000
  Sreg:=@LastS;                                                <<00494>>02930000
  move Outbuf'B:="DB:       DBBANK:  DL:       STATUS:      "; <<00494>>02932000
  ASCII(DBreg,8,Outbuf'B(3));                                  <<00494>>02934000
  ASCII(DBbank,10,Outbuf'B(17));                               <<00494>>02936000
  ASCII(DLreg,8,Outbuf'B(22));                                 <<00494>>02938000
  ASCII(STATUSreg,8,Outbuf'B(36));                             <<00494>>02940000
  FWRITE(LPfnum,Outbuf,-42,0);                                 <<00494>>02942000
  if <> then                                                   <<00494>>02944000
    begin                                                      <<00494>>02946000
    DEBUG;                                                     <<00494>>02948000
    end;                                                       <<00494>>02950000
  move Outbuf'B:="SBANK:  Q:       S:       Z:       X:      ";<<00494>>02952000
  ASCII(Sbank,10,Outbuf'B(6));                                 <<00494>>02954000
  ASCII(Qreg,8,Outbuf'B(10));                                  <<00494>>02956000
  ASCII(Sreg,8,Outbuf'B(19));                                  <<00494>>02958000
  ASCII(Zreg,8,Outbuf'B(28));                                  <<00494>>02960000
  ASCII(Xreg,8,Outbuf'B(37));                                  <<00494>>02962000
  FWRITE(LPfnum,Outbuf,-44,0);                                 <<00494>>02964000
  if <> then                                                   <<00494>>02966000
    begin                                                      <<00494>>02968000
    DEBUG;                                                     <<00494>>02970000
    end;                                                       <<00494>>02972000
  FWRITE(LPfnum,Outbuf,0,0);                                   <<00494>>02974000
  if <> then                                                   <<00494>>02976000
    begin                                                      <<00494>>02978000
    DEBUG;                                                     <<00494>>02980000
    end;                                                       <<00494>>02982000
  move Outbuf'B:="USER'S STACK:    ZERO CORRESPONDS TO DB.";   <<00494>>02984000
  FWRITE(LPfnum,Outbuf,-40,0);                                 <<00494>>02986000
  if <> then                                                   <<00494>>02988000
    begin                                                      <<00494>>02990000
    DEBUG;                                                     <<00494>>02992000
    end;                                                       <<00494>>02994000
  PRINT'DL'Z(DLreg,Zreg,LPfnum,0); <<Stack>>                   <<00494>>02996000
                                                               <<00494>>02998000
  <<**********************************************>>           <<00494>>03000000
                                                               <<00494>>03002000
  FWRITE(LPfnum,Outbuf,0,%300);                                <<00494>>03004000
  if <> then DEBUG;                                            <<00494>>03006000
  EXCHANGEDB (SDISCDST);                                       <<03522>>03008000
  FORMAT'LIMIT := (@XMITLOG+1)/3;   << Last formatted entry >> <<03522>>03010000
  START'SECTOR := DOUBLE (STARTADDRESS);                       <<03522>>03012000
                                                               <<03522>>03014000
<< Determine how much of the XDS  to  print.  Usually  this >> <<03522>>03016000
<< means up to and including the EODTYPE entry. If for some >> <<03522>>03018000
<< reason we don't have one or can't find it (as might hap- >> <<03522>>03020000
<< pen if we die from an unallowed write  beyond  EOT,  for >> <<03522>>03022000
<< example),  we'll settle for the Gap Table up to CURRENT- >> <<03522>>03024000
<< GPTENT.                                                  >> <<03522>>03026000
                                                               <<03522>>03028000
  DO BEGIN                                                     <<03522>>03030000
     SDISCFINDGAP (START'SECTOR, EODSECTR);                    <<03522>>03032000
     START'SECTOR := START'SECTOR + 1D;                        <<03522>>03034000
     END                                                       <<03522>>03036000
    UNTIL GAPTYPE = EODTYPE OR GAPTYPE = ENDOFTABLETYPE;       <<03522>>03038000
  IF GAPTYPE = EODTYPE                                         <<03522>>03040000
     THEN SEGMENT'LIMIT := @GPT + ENDINDEX + 1                 <<03522>>03042000
     ELSE SEGMENT'LIMIT := @GPT + CURRENTGPTENT + 1;           <<03522>>03044000
  EXCHANGEDB (0);                                              <<03522>>03046000
  I:=0;                                                        <<00494>>03048000
  do                                                           <<00494>>03050000
    begin                                                      <<00494>>03052000
    case I of                                                  <<00494>>03054000
      begin                                                    <<00494>>03056000
  move Outbuf'B:=                                              <<00494>>03058000
  "WORDSPERSECTR         SECTORSPERTRAK        STARTADDRESS   ";        03060000
  move Outbuf'B:=                                              <<03522>>03062000
  "EOTSECTR (MS)         EOTSECTR (LS)         EODSECTR (MS)  ";        03064000
  MOVE OUTBUF'B:=                                              <<03522>>03066000
  "EODSECTR (LS)         JUSTALLOCATED         WRITERING      ";        03068000
  MOVE OUTBUF'B:=                                              <<03522>>03070000
  "FATALERROR            LPERRORLOG            MAX'DSEG'SIZE  ";        03072000
  move Outbuf'B:=                                              <<03522>>03074000
  "LDNUM                 QMISC                 DSTX           ";        03076000
  move Outbuf'B:=                                              <<03522>>03078000
  "ADDR                  FUNC                  CNT            ";        03080000
  move Outbuf'B:=                                              <<03522>>03082000
  "P1                    P2                    FLAGS          ";        03084000
  move Outbuf'B:=                                              <<03522>>03086000
  "                      CONTIGSTARTSECT       CONTIGSTARTSECT";        03088000
  move Outbuf'B:=                                              <<03522>>03090000
  "RECBUFFSA (MS)        RECBUFFSA (LS)        RECBUFFEA (MS) ";        03092000
  move Outbuf'B:=                                              <<03522>>03094000
  "RECBUFFEA (LS)        ALREADYREJECTED       NEXTRECINBUF   ";        03096000
  move Outbuf'B:=                                              <<03522>>03098000
  "NULLTRANSFER          TAPEREWOUND           TAPEWRITTEN    ";        03100000
  move Outbuf'B:=                                              <<03522>>03102000
  "TYPE'SUBTYPE          WORKTABLE             RECBUFF        ";        03104000
  move Outbuf'B:=                                              <<03522>>03106000
  "GPT                   CURRENTBUFINDEX       CURRENTGPTENT  ";        03108000
  move Outbuf'B:=                                              <<03522>>03110000
  "DBOFFSET              DSTN                  EOFCODE        ";        03112000
  move Outbuf'B:=                                              <<03522>>03114000
  "ERR'RETRY             ERRORCODE             GPTLEN         ";        03116000
  move Outbuf'B:=                                              <<03522>>03118000
  "RECBUFFLEN            USERSTACK             WORDSINRECBUF  ";        03120000
  move Outbuf'B:=                                              <<03522>>03122000
  "BOT'SENSOR            EOTSENSOR             RTV1 (MS)      ";        03124000
  move Outbuf'B:=                                              <<03522>>03126000
  "RTV1 (LS)             RTV2 (MS)             RTV2 (LS)      ";        03128000
  move Outbuf'B:=                                              <<03522>>03130000
  "RTV3                  RTV4                  XMITLOG        ";        03132000
  move Outbuf'B:=                                              <<00494>>03134000
  "RECBUFF               WORKTABLE             GPT            ";        03136000
      end; <<case statement>>                                  <<00494>>03138000
    ASCII(FETCH'DST(SdiscDst,I*3),8,Outbuf'B(15));             <<00494>>03140000
    ASCII(FETCH'DST(SdiscDst,I*3+1),8,Outbuf'B(37));           <<00494>>03142000
    ASCII(FETCH'DST(SdiscDst,I*3+2),8,Outbuf'B(59));           <<00494>>03144000
    FWRITE(LPfnum,Outbuf,-65,0);                               <<00494>>03146000
    if <> then DEBUG;                                          <<00494>>03148000
    end                                                        <<00494>>03150000
   UNTIL (I := I + 1) > FORMAT'LIMIT;                          <<03522>>03152000
  FWRITE(LPfnum,Outbuf,0,0);                                   <<00494>>03154000
  if <> then DEBUG;                                            <<00494>>03156000
  I := @GPT + CURRENTGPTENT;                                   <<03522>>03160000
  PRINT'DL'Z (0, SEGMENT'LIMIT, LPFNUM, SDISCDST);             <<03522>>03162000
  FCLOSE(LPfnum,0,0);                                          <<00494>>03164000
  end;                                                         <<00494>>03166000
$PAGE "SDISC - INTERRUPT HELPER"                                        03168000
PROCEDURE WAITFORDISC;                                                  03170000
OPTION PRIVILEGED, UNCALLABLE;                                          03172000
BEGIN                                                                   03174000
LOGICAL MESSAGEOUT;                                                     03176000
LOGICAL OFF'LINE;                                                       03178000
LOGICAL QDSTN;                                                          03180000
INTEGER QLDNUM;                                                         03182000
DEFINE JUSTONLINE=OFF'LINE#;                                            03184000
                                                               <<03522>>03186000
  COMMENT -- This procedure and all others  beyond  it  except <<03522>>03188000
SDISCIO  and  FINDSDISCGAP  MUST  be called with DB set to the <<03522>>03190000
Serial Disc's extra data segment.                              <<03522>>03192000
;                                                              <<03522>>03194000
                                                                        03196000
QDSTN:=DSTN;                                                            03198000
OFF'LINE:=FALSE;                                                        03200000
QLDNUM:=LDNUM;                                                          03202000
MESSAGEOUT:=FALSE;                                                      03204000
CHECKDISC(LDNUM,STATUS1);                                               03206000
WHILE TAPELOADED=0 DO                                                   03210000
   BEGIN <<WAIT FOR AUTO RECOGNITION>>                                  03212000
   IF NOT MESSAGEOUT THEN                                               03214000
      BEGIN <<REMIND OPERATOR>>                                         03216000
      EXCHANGEDB(0);                                                    03218000
      GENMSG(SET1,MESS273,%10000,QLDNUM,,,,,0);                         03220000
      EXCHANGEDB(QDSTN);                                                03222000
      MESSAGEOUT:=TRUE;                                                 03224000
      END;                                                              03226000
   DELAY(5000D);                                                        03228000
   CHECKDISC(LDNUM,STATUS2);                                            03230000
   IF STATUS1<>STATUS2 THEN                                             03232000
      BEGIN                                                             03234000
      IF STATUS2.OFFLINE=1 THEN                                         03236000
         BEGIN <<DON'T REPEAT AFTER OFFLINE INTERRUPT>>                 03238000
         MESSAGEOUT:=TRUE;                                              03240000
         OFF'LINE:=TRUE;                                                03242000
         END                                                            03244000
      ELSE                                                              03246000
         BEGIN <<ONLINE INTERRUPT>>                                     03248000
         IF JUSTONLINE THEN                                             03250000
            BEGIN <<FORCE WAIT FOR ONE MORE PERIOD>>                    03252000
              <<TO ALLOW CONTROLLER TIME-OUT WHICH >>                   03254000
              <<WILL START PVPROC>>                                     03256000
            MESSAGEOUT:=TRUE;                                           03258000
            OFF'LINE:=FALSE;                                            03260000
            END                                                         03262000
         ELSE                                                           03264000
            BEGIN <<ALL SHOULD BE STABILIZED BY NOW>>                   03266000
            STATUS1:=STATUS2;                                           03268000
            END;                                                        03270000
         END;                                                           03272000
      END;                                                              03274000
   END;                                                                 03276000
END;  <<WAITFORDISC>>                                                   03280000
$PAGE "SDISC - TABLE MANIPULATION ROUTINES"                             03282000
LOGICAL PROCEDURE ADD'GPT'ENTRY (GPT'TYPE, ADDR1, ADDR2);      <<03522>>03284000
  VALUE GPT'TYPE, ADDR1, ADDR2;                                <<03522>>03286000
  INTEGER GPT'TYPE, ADDR1, ADDR2;                              <<03522>>03288000
  OPTION PRIVILEGED, UNCALLABLE;                               <<03522>>03290000
                                                               <<03522>>03292000
BEGIN                                                          <<03522>>03294000
  COMMENT -- ADD'GPT'ENTRY adds the entry  information  passed <<03522>>03296000
in  the parameters to the Gap Table at CURRENTGPTENT, then up- <<03522>>03298000
dates CURRENTGPTENT.  If the entry fits in the Gap Table, ADD' <<03522>>03300000
GPT'ENTRY returns TRUE, if not it returns  FALSE  to  let  the <<03522>>03302000
caller choose the appropriate SDERR status.                    <<03522>>03304000
  This routine does not check how  close  a  valid  GPT  entry <<03522>>03306000
comes  to the end of the Gap Table.  Functional processors are <<03522>>03308000
responsible for calling CHECK'FOR'EOT at the end of their pro- <<03522>>03310000
cessing.                                                       <<03522>>03312000
;                                                              <<03522>>03314000
ADD'GPT'ENTRY := TRUE;   << I'm an incurable optimist.      >> <<03522>>03316000
IF CURRENTGPTENT < GPTLEN                                      <<03522>>03318000
   THEN                                                        <<03522>>03320000
      BEGIN   << Entry fits in Gap Table.                   >> <<03522>>03322000
      GPT (CURRENTGPTENT).GPT'TYPE'FIELD := GPT'TYPE;          <<03522>>03324000
      GPT (X).GPT'ADR'FIELD := ADDR1;                          <<03522>>03326000
      GPT (X := X+1) := ADDR2;                                 <<03522>>03328000
      CURRENTGPTENT := X + 1;                                  <<03522>>03330000
      END     << Entry fits in Gap Table.                   >> <<03522>>03332000
   ELSE ADD'GPT'ENTRY := FALSE;   << Entry doesn't fit.     >> <<03522>>03334000
END;   << of ADD'GPT'ENTRY.                                 >> <<03522>>03336000
$PAGE                                                          <<03522>>03338000
DOUBLE PROCEDURE ATACHIO(LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);   03340000
VALUE LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;              <<00189>>03342000
INTEGER LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;            <<00189>>03344000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00189>>03346000
                                                               <<00189>>03348000
BEGIN                                                          <<00189>>03350000
  COMMENT -- A common shell for the real P'ATTACHIO call.      <<04742>>03352000
;                                                              <<03680>>03354000
ATACHIO := P'ATTACHIO (LDNUM, QMISC, DSTX, ADDR, FUNC, CNT,    <<04742>>03358000
                       P1, P2, FLAGS);                         <<04742>>03360000
END;                                                           <<00189>>03362000
$PAGE                                                          <<03522>>03364000
  PROCEDURE GPTMOD(CONTROLCODE,S1,S2);                                  03366000
    VALUE CONTROLCODE,S1,S2;                                            03368000
    INTEGER CONTROLCODE;                                                03370000
    DOUBLE S1,S2;                                                       03372000
    OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                              03374000
                                                                        03376000
COMMENT:                                                                03378000
  PURPOSE-TO MANAGE THE GAP TABLE.                                      03380000
  CONTROLCODES-                                                         03382000
 -N.RETURN STARTSECTOR AND SECTORLENGTH OF CONTIG BLOCK #N     <<00189>>03384000
    RETURN -1D FOR BOTH IF CONTIG BLOCK #N DOESN'T EXIST       <<00189>>03386000
  0.Write EOT mark.  Used only with floppy discs.              <<04249>>03388000
  1.INITIALIZE GPT TO "VIRGIN TAPE" STATE                               03390000
  2.Read label sector and Gap Table of new volume,             <<03733>>03392000
      configure SDISC from label sector parameters.            <<03733>>03394000
  3.WRITE EODMARK AND CLOSE GPT TO DISC                                 03396000
  4.WRITE EOFMARK                                                       03398000
  5.MAKE HOLE ENTRY                                                     03400000
  6.Make a contiguous block entry.                             <<04249>>03402000
  7.Obsolete (was End Contiguous Block).                       <<04249>>03404000
  8.UPDATE GPT TO REFLECT A RELOCATED BLOCK                             03406000
  9.UPDATE CURRENTGPT POINTERS FOR READ OPERATIONS                      03408000
 10.CLEAR GAP TABLE OF ENTRIES WHOSE ADDRESSES ARE                      03410000
      GREATER THAN ACTUAL'ADDRESS.                                      03412000
END OF COMMENT;                                                         03414000
<<**************************************>>                              03416000
<<                                      >>                              03418000
<<CONTROLCODE= -N                       >>                              03420000
<<RETURN VALUES:                        >>                              03422000
<<                                      >>                              03424000
<<VALUES ARE PASSED THROUGH GLOBAL CELLS>>                              03426000
<<BECAUSE SDISC OPERATES IN SPLIT STACK >>                              03428000
<<AT ALL TIMES, MAKING REFERENCE PARMS  >>                              03430000
<<AN IMPOSSIBILITY.                     >>                              03432000
<<                                      >>                              03434000
<<RTV1- (DOUBLE) -DISC ADDRESS OF START >>                              03436000
<<               -OF CONTIGUOUS BLOCK   >>                              03438000
<<               -REQUESTED             >>                              03440000
<<RTV2- (DOUBLE) -LENGTH OF CONTIGUOUS  >>                              03442000
<<               -BLOCK REQUESTED       >>                              03444000
<<                                      >>                              03446000
<<**************************************>>                              03448000
                                                                        03450000
  BEGIN <<GPTMOD>>                                                      03452000
  INTEGER PARMS=Q-4;                                                    03454000
  EQUATE                                                       <<03522>>03456000
    FIND'CONTIG'BLOCK'N = 8;                                   <<03522>>03458000
  DOUBLE DERR,S3;                                                       03460000
  INTEGER ERR1=DERR,BLOCKNUMBER,BLOCK,I;                       <<03522>>03462000
  INTEGER ADR1=S1,                                                      03464000
          ADR2=S1+1,                                                    03466000
          ADR3=S2,                                                      03468000
          ADR4=S2+1,                                                    03470000
          ADR5=S3,                                                      03472000
          ADR6=S3+1;                                                    03474000
  LOGICAL FOUNDBLOCK:=FALSE;                                            03476000
                                                                        03478000
IF PARMS.(13:1) = 0 THEN GO TO MISSING'PARM;   << No CCODE. >> <<03522>>03480000
  BLOCKNUMBER:=0;                                                       03482000
  IF CONTROLCODE < 0 THEN                                               03484000
    BEGIN <<SET UP TO FIND CONTIG BLOCK# -CONTROLCODE>>                 03486000
    BLOCKNUMBER:=-CONTROLCODE;                                          03488000
    BLOCK:=0;                                                           03490000
    STARTBLOCK:=-1D;                                           <<00189>>03492000
    BLOCKLENGTH:=-1D;                                          <<00189>>03494000
    CONTROLCODE := FIND'CONTIG'BLOCK'N;                        <<03522>>03496000
    END;  <<SET UP TO FIND CONTIG BLOCK# -CONTROLCODE>>                 03498000
  CASE CONTROLCODE OF                                                   03500000
    BEGIN <<CASE STATEMENT>>                                            03502000
                                                                        03504000
      BEGIN   << 0 -- Write EOT mark, floppy disc only.     >> <<04249>>03506000
      IF PARMS.(14:1) = 0 THEN GO TO MISSING'PARM;             <<04249>>03508000
      IF NOT ADD'GPT'ENTRY (EOTTYPE, ADR1, ADR2) THEN          <<04249>>03510000
         GO TO GPT'OVERFLOW;                                   <<04249>>03512000
      END;    << 0 -- Write EOT mark, floppy disc only.     >> <<04249>>03514000
                                                                        03516000
      BEGIN   << 1 -- Initialize GPT to "virgin tape" state. >>         03518000
      GPT:=-1;                                                          03520000
      MOVE GPT(1) := GPT, (GPTLEN);                            <<03522>>03522000
      GPT := STARTADDRESS;                                     <<03522>>03524000
      CURRENTGPTENT:=GPT'START;                                <<00189>>03526000
                                                               <<03535>>03528000
<< Lay down an end-of-data entry at load point  to  prevent >> <<03535>>03530000
<< trying to read a brand new disc or cartridge.            >> <<03535>>03532000
                                                               <<03535>>03534000
      GPTMOD (WRITE'EOD'AND'POST, DOUBLE (STARTADDRESS));      <<03535>>03536000
      CURRENTGPTENT := GPT'START;                              <<03558>>03538000
      TAPEREWOUND:=FALSE; <<GPT IS RESET-READY TO WRITE>>               03542000
      END;    << 1 -- Initialize GPT to "virgin tape" state. >>         03544000
                                                                        03546000
      BEGIN   << 2 -- Read first block of GPT from device.  >>          03548000
                                                               <<03522>>03550000
      @WORKTABLE := @XMITLOG + 1;                              <<03522>>03554000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @WORKTABLE,        <<03680>>03556000
              READ, DEFAULT'SECTOR'SIZE, 0, 0, FLAGS');        <<03640>>03558000
      IF ATIOERR THEN                                          <<03522>>03560000
         BEGIN   << Couldn't read label sector.             >> <<03522>>03562000
         SETSDISCERROR (SDERR2);                               <<03522>>03564000
         RETURN;                                               <<03522>>03566000
         END;                                                  <<03522>>03568000
      WORDSPERSECTR:=WORKTABLE(VLAB'WPS);                               03570000
      SECTORSPERTRAK:=WORKTABLE(VLAB'SPT);                              03572000
      STARTADDRESS:=WORKTABLE(VLAB'SA);                                 03574000
      SUBTYPE := WORKTABLE (VLAB'TYPE'SUBTYPE).SUBTYPE'FIELD;  <<03522>>03576000
      TYPE    := WORKTABLE (VLAB'TYPE'SUBTYPE).TYPE'FIELD;     <<03522>>03578000
      EOTSECTR0:=WORKTABLE(VLAB'EOT);                                   03580000
      EOTSECTR1:=WORKTABLE(X:=X+1);                                     03582000
      EODSECTR0:=WORKTABLE(VLAB'EOD);                                   03584000
      EODSECTR1:=WORKTABLE(X:=X+1);                                     03586000
                                                               <<03522>>03588000
<< Set up "secondary DB" area of  WORKTABLE,  RECBUFF,  Gap >> <<03522>>03590000
<< Table.  RECBUFF  is 4096 words for disc, 16384 words for >> <<03522>>03592000
<< LINUS, or 32 sectors (blocks) for either.                >> <<03522>>03594000
                                                               <<03522>>03596000
      @RECBUFF := @WORKTABLE + WORDSPERSECTR * PORT'SECT'LEN;  <<03522>>03598000
      RECBUFFLEN := 32 * WORDSPERSECTR - 1;                    <<03522>>03600000
      @GPT := @RECBUFF + RECBUFFLEN + 1;                       <<03522>>03602000
      GPTLEN := (STARTADDRESS - GPTBASESECTOR) * WORDSPERSECTR;<<03522>>03604000
                                                               <<03522>>03606000
<< See if we have room for the Gap Table.                   >> <<03522>>03608000
                                                               <<03522>>03610000
      IF INTEGER (MAX'DSEG'SIZE) - @GPT < GPTLEN THEN          <<03522>>03612000
         BEGIN   << Gap Table doesn't fit, can't continue.  >> <<03522>>03614000
         SETSDISCERROR (SDERR36);                              <<03522>>03616000
         RETURN;                                               <<03522>>03618000
         END;                                                  <<03522>>03620000
                                                               <<03522>>03622000
<< Now read in the Gap Table.                               >> <<03522>>03624000
                                                               <<03522>>03626000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @GPT, READ,        <<03522>>03628000
              GPTLEN, 0, GPTBASESECTOR, FLAGS');               <<03522>>03630000
      IF ATIOERR THEN                                          <<00189>>03632000
         BEGIN                                                 <<00189>>03634000
         SETSDISCERROR(SDERR13);                               <<00494>>03638000
         RETURN;                                               <<00189>>03640000
         END;                                                  <<00189>>03642000
      CURRENTGPTENT:=GPT'START;                                <<00189>>03646000
      IF INTEGER(GPT.GPT'ADR'FIELD)<>STARTADDRESS THEN                  03648000
        BEGIN <<VIRGIN TAPE>>                                           03650000
        GPTMOD (BRAND'NEW'TAPE);                               <<03522>>03652000
        IF SDERR THEN RETURN;                                           03654000
        END;  <<VIRGIN TAPE>>                                           03656000
      RECBUFFSA:=DOUBLE(STARTADDRESS);                         <<00494>>03660000
      RECBUFFEA:=-1D;                                                   03662000
      NEXTRECINBUF:=FALSE;                                     <<00494>>03664000
      TAPEREWOUND:=FALSE;                                               03666000
      END;    << 2 -- Read first block of GPT from device.  >>          03668000
                                                                        03670000
      BEGIN   << 3 -- Write End-of-Data and flush GPT.      >>          03672000
      IF PARMS.(14:1)=0 THEN                                            03674000
         BEGIN                                                          03676000
MISSING'PARM:                                                  <<03522>>03678000
         SETSDISCERROR(SDERR43);                               <<00494>>03680000
         RETURN;                                                        03682000
         END;                                                           03684000
      IF NOT ADD'GPT'ENTRY (EODTYPE, ADR1, ADR2) THEN          <<03522>>03686000
         BEGIN   << Overflowed Gap Table, gotta stop.       >> <<03522>>03688000
GPT'OVERFLOW:                                                  <<03522>>03690000
         SETSDISCERROR (SDERR18);                              <<03522>>03692000
         RETURN;                                               <<03522>>03694000
         END;                                                  <<03522>>03696000
                                                               <<04742>>03698000
<< We need a "write ring" check here  because  we  can  get >> <<04742>>03700000
<< here  trying  to write an EOD entry at load point of the >> <<04742>>03702000
<< disc copy of the Gap Table if this is the first  use  of >> <<04742>>03704000
<< the  disc  since  being  >SERIALized with VINIT.  If the >> <<04742>>03706000
<< operator did not allow writing in the  :REPLY,  we  omit >> <<04742>>03708000
<< updating  the disc.  The copy of the Gap Table in memory >> <<04742>>03710000
<< (in the XDS) is enough for read-only accesses. All other >> <<04742>>03712000
<< procedures using this code have already checked for  the >> <<04742>>03714000
<< existence of a "write ring".                             >> <<04742>>03716000
                                                               <<04742>>03718000
      IF WRITERING                                             <<04742>>03720000
         THEN DERR := ATACHIO (LDNUM, QMISC', DSTN, @GPT,      <<04742>>03722000
                      WRITE, GPTLEN, 0, GPTBASESECTOR, FLAGS') <<04742>>03724000
         ELSE DERR := NO'ATIOERROR;                            <<04742>>03726000
      IF ATIOERR THEN                                                   03728000
        BEGIN <<ATTACHIO WRITE ERROR>>                                  03730000
        SETSDISCERROR(SDERR15);                                <<00494>>03734000
        RETURN;                                                         03736000
        END;  <<ATTACHIO WRITE ERROR>>                                  03738000
      END;    << 3 -- Write End-of-Data and flush GPT.      >>          03742000
                                                                        03744000
      BEGIN   << 4 -- Write EOF. >>                                     03746000
      IF PARMS.(14:1) = 0 THEN GO TO MISSING'PARM;             <<03522>>03748000
      IF NOT ADD'GPT'ENTRY (EOFTYPE, ADR1, ADR2) THEN          <<03522>>03750000
         BEGIN   << This EOF overflows Gap Table.           >> <<03522>>03752000
         SETSDISCERROR (SDERR19);                              <<03522>>03754000
         RETURN;                                               <<03522>>03756000
         END;                                                  <<03522>>03758000
      END;    << 4 -- Write EOF. >>                                     03762000
                                                                        03764000
      BEGIN   << 5 -- Make a hole entry. >>                             03766000
      IF PARMS.(14:2) <> 3 THEN GO TO MISSING'PARM;            <<03522>>03768000
      IF NOT ADD'GPT'ENTRY (BOHTYPE, ADR1, ADR2) THEN          <<03522>>03770000
         GO TO GPT'OVERFLOW;                                            03772000
      IF NOT ADD'GPT'ENTRY (EOHTYPE, ADR3, ADR4) THEN          <<03522>>03774000
         GO TO GPT'OVERFLOW;                                   <<03522>>03776000
      END;    << 5 -- Make a hole entry. >>                             03780000
                                                                        03782000
      BEGIN   << 6 -- Make a contiguous block entry.        >> <<04249>>03784000
      IF PARMS.(14:2) <> 3 THEN GO TO MISSING'PARM;            <<04249>>03786000
      IF NOT ADD'GPT'ENTRY (BOBTYPE, ADR1, ADR2) THEN          <<03522>>03788000
         GO TO GPT'OVERFLOW;                                   <<03522>>03790000
      IF NOT ADD'GPT'ENTRY (EOBTYPE, ADR3, ADR4) THEN          <<04249>>03794000
         GO TO GPT'OVERFLOW;                                   <<03522>>03796000
      END;    << 6 -- Make a contiguous block entry.        >> <<04249>>03800000
                                                               <<04249>>03802000
      ;       << 7 -- Obsolete.  Was End Contiguous Block.  >> <<04249>>03804000
                                                                        03806000
      BEGIN   << 8 -- Update GPT to reflect reloc. block... >>          03808000
              <<      or find contiguous block BLOCKNUMBER. >>          03810000
      IF BLOCKNUMBER = 0 AND PARMS.(14:2) <> 3 OR                       03812000
        BLOCKNUMBER <> 0 AND PARMS.(14:1) = 0 THEN                      03814000
        GO TO MISSING'PARM;                                    <<03522>>03816000
      I := GPT'START;                                          <<00189>>03820000
      DO                                                                03822000
        BEGIN   << Scan every entry.                        >> <<00189>>03824000
        ADR5 := GPT(I).GPT'ADR'FIELD;                                   03826000
        ADR6 := GPT(I+1);                                               03828000
        IF BLOCKNUMBER <> 0 THEN                                        03830000
          BEGIN   << Find addr of contig block BLOCKNUMBER. >>          03832000
          IF GPT(I).GPT'TYPE'FIELD = BOBTYPE THEN                       03834000
            BEGIN   << Found a contig block -- right one?   >>          03836000
            BLOCK := BLOCK+1;                                           03838000
            IF BLOCK = BLOCKNUMBER THEN                                 03840000
              BEGIN   << Yep, that's ours.                  >>          03842000
              STARTBLOCK := S3;                                         03844000
              FOUNDBLOCK := TRUE;                                       03846000
              END;                                                      03848000
            END;    << Found a contig block -- right one?   >>          03850000
          IF GPT(I).GPT'TYPE'FIELD = EOBTYPE THEN                       03852000
            IF FOUNDBLOCK THEN                                          03854000
              BEGIN   << Found end of block.                >>          03856000
              FOUNDBLOCK := FALSE;                                      03858000
              BLOCKLENGTH := S3 - STARTBLOCK + 1D;                      03860000
              END;                                                      03862000
          END     << Find addr of contig block BLOCKNUMBER. >>          03864000
        ELSE   << Really a relocated-block update.          >>          03866000
          IF S3 >= S1 THEN   << Candidate to be moved.      >>          03868000
            IF GPT(I).GPT'TYPE'FIELD <> ENDOFTABLETYPE THEN    <<00189>>03870000
              IF GPT(I).GPT'TYPE'FIELD <> BOHTYPE THEN                  03872000
                IF GPT(I).GPT'TYPE'FIELD <> EOHTYPE THEN                03874000
                  BEGIN   << Relocate this entry.           >>          03876000
                  GPT(I).GPT'ADR'FIELD :=                               03878000
                    INTEGER(GPT(I).GPT'ADR'FIELD)-ADR1+ADR3;            03880000
                  GPT(I+1) := INTEGER(GPT(I+1)) - ADR2 + ADR4;          03882000
                  END;    << Relocate this entry.           >>          03884000
        END     << Scan every entry.                        >> <<00189>>03886000
       UNTIL (I:=I+GPTENTSIZE) >= GPTLEN                       <<03522>>03888000
        OR GPT(I).GPT'TYPE'FIELD = ENDOFTABLETYPE;             <<00189>>03890000
      END;    << 8 -- Update GPT to reflect reloc. block... >>          03892000
                                                                        03894000
      BEGIN   << 9 -- Update CURRENTGPT pointers for read op>>          03896000
      CURRENTGPTENT:=ENDINDEX;                                 <<00189>>03898000
      IF CURRENTGPTENT >= GPTLEN THEN                          <<03522>>03900000
         BEGIN                                                          03902000
         SETSDISCERROR(SDERR28);                               <<00494>>03904000
         RETURN;                                               <<00189>>03906000
         END;                                                           03908000
      END;    << 9 -- Update CURRENTGPT pointers for read op>>          03910000
                                                                        03912000
      BEGIN   << 10 -- Clear GPT from ACTUAL'ADDRESS to end >> <<03522>>03914000
                                                               <<03522>>03916000
COMMENT:  When you write on a mag tape, any information beyond <<03522>>03918000
your current location is lost.  This section,  called  by  the <<03522>>03920000
write  (RITESDISC) and write end-of-file (CTRLSDISC, FUNC = 6) <<03522>>03922000
routines if the previous operation was not one of  the  above, <<03522>>03924000
"erases"  any Gap Table information pertaining to areas beyond <<03522>>03926000
the current sector. Since CURRENTADR does not reflect any con- <<03522>>03928000
tiguous blocks or holes ("gaps") within the scope  of  RECBUFF <<03522>>03930000
when  we  are not writing, ACTUAL'ADDRESS is called to give us <<03522>>03932000
the real starting address to clear from.                       <<03522>>03934000
  When writing we assume that CURRENTADR always  represents  a <<03522>>03936000
valid  address, since any contiguous blocks ARE in RECBUFF and <<03522>>03938000
holes are posted to disc as they are generated. To assure that <<03522>>03940000
CURRENTADR is valid as we start to write, we move the contents <<03522>>03942000
of the current sector to the beginning of RECBUFF  and  update <<03522>>03944000
CURRENTBUFINDEX appropriately.                                 <<03522>>03946000
;                                                              <<03522>>03948000
      S1 := ACTUAL'ADDRESS;                                    <<03522>>03950000
      CURRENTGPTENT:=GPT'START-GPTENTSIZE;                              03952000
      DO                                                                03954000
        BEGIN                                                           03956000
        CURRENTGPTENT:=CURRENTGPTENT+GPTENTSIZE;                        03958000
        ADR5:=GPT(CURRENTGPTENT).GPT'ADR'FIELD;                         03960000
        ADR6:=GPT(X:=X+1);                                              03962000
        END                                                             03964000
       UNTIL S3 >= S1 OR CURRENTGPTENT >= GPTLEN;              <<03522>>03966000
      IF CURRENTGPTENT < GPTLEN THEN                           <<03522>>03968000
        BEGIN   << There is some Gap Table to clear.        >> <<03522>>03970000
        GPT(CURRENTGPTENT) := -1;                                       03972000
        MOVE GPT(CURRENTGPTENT+1) := GPT(CURRENTGPTENT),                03974000
          (GPTLEN - CURRENTGPTENT);                                     03976000
        END;    << There is some Gap Table to clear.        >> <<03522>>03978000
      MOVE RECBUFF := RECBUFF (CURRENTBUFINDEX / WORDSPERSECTR <<03522>>03980000
                      * WORDSPERSECTR),                        <<03522>>03982000
                      (CURRENTBUFINDEX MOD WORDSPERSECTR);     <<03522>>03984000
      CURRENTBUFINDEX := CURRENTBUFINDEX MOD WORDSPERSECTR;    <<03522>>03986000
      RECBUFFSA := S1;                                         <<03522>>03988000
      RECBUFFEA := -1D;                                        <<03522>>03990000
      END;    << 10 -- Clear GPT from ACTUAL'ADDRESS to end >>          03992000
                                                                        03994000
    END;  <<CASE STATEMENT>>                                            03996000
  END;  <<GPTMOD>>                                                      04000000
$PAGE                                                          <<03522>>04002000
PROCEDURE CHECK'FOR'EOT;                                       <<03522>>04004000
  OPTION PRIVILEGED, UNCALLABLE;                               <<03522>>04006000
                                                               <<03522>>04008000
BEGIN                                                          <<03522>>04010000
  COMMENT -- CHECK'FOR'EOT is  responsible  for  managing  the <<03522>>04012000
EOTSENSOR flag. It should be called at the end of all routines <<03522>>04014000
which result in relative logical tape motion. It sets the flag <<03522>>04016000
if we are beyond EOTSECTR or within END'OF'GPT entries of  the <<03522>>04018000
end of the Gap Table, otherwise it clears the flag.  If we are <<03522>>04020000
writing (TAPEWRITTEN = TRUE), the non-fatal end-of-tape  error <<03522>>04022000
status is also set.                                            <<03522>>04024000
;                                                              <<03522>>04026000
EQUATE                                                         <<03522>>04028000
   END'OF'GPT = 10;  << Set EOT if within 10 entries of end >> <<03522>>04030000
                                                               <<03522>>04032000
DOUBLE                                                         <<03522>>04034000
   TEST'ADDRESS;   << Prevents ACTUAL'ADDRESS call if wrt.  >> <<03522>>04036000
                                                               <<03522>>04038000
IF TAPEWRITTEN                                                 <<03522>>04040000
   THEN TEST'ADDRESS := CURRENTADR                             <<03522>>04042000
   ELSE TEST'ADDRESS := ACTUAL'ADDRESS;                        <<03522>>04044000
IF TEST'ADDRESS > EOTSECTR                                     <<03535>>04046000
   OR GPTLEN - CURRENTGPTENT < END'OF'GPT * GPTENTSIZE         <<03522>>04048000
      THEN                                                     <<03522>>04050000
         BEGIN                                                 <<03522>>04052000
                                                               <<04249>>04054000
<< The following strange-looking statement  preserves  EOT- >> <<04249>>04056000
<< SENSOR  =  EOT'WRITTEN  if we write after detecting EOT. >> <<04249>>04058000
<< EOTFOUND is set here only as we cross EOTSECTR.          >> <<04249>>04060000
                                                               <<04249>>04062000
         IF EOTSENSOR = EOTNOTFOUND THEN                       <<04249>>04064000
            EOTSENSOR := EOTFOUND;                             <<04249>>04066000
         IF TAPEWRITTEN THEN ERRORCODE := -SDERR5;             <<03522>>04068000
         END                                                   <<03522>>04070000
      ELSE EOTSENSOR := EOTNOTFOUND;                           <<03522>>04072000
END;   << of CHECK'FOR'EOT.                                 >> <<03522>>04074000
$PAGE                                                          <<03522>>04076000
PROCEDURE SDISCFINDGAP(STARTSECTOR,ENDSECTOR);                          04078000
VALUE STARTSECTOR,ENDSECTOR;                                            04080000
DOUBLE STARTSECTOR,ENDSECTOR;                                           04082000
OPTION PRIVILEGED,UNCALLABLE;                                           04084000
                                                                        04086000
  COMMENT -- Procedure SDISCFINDGAP scans the Gap Table  of  a <<03522>>04088000
serial  disc  and locates the first "gap" (an end-of-file, the <<03522>>04090000
"end-of-tape" reflector, the end of valid data  on  the  disc, <<03522>>04092000
the  end of the Gap Table itself, a contiguous block or a hole <<03522>>04094000
which denotes a defective area) for which any part  falls  be- <<03522>>04096000
tween  the disc addresses passed in STARTSECTOR and ENDSECTOR. <<03522>>04098000
The disc address(es) and attributes of the gap are returned in <<03522>>04100000
four global cells, RTV1-RTV4 (see below).  If no such  gap  is <<03522>>04102000
found, RTV1-RTV4 are set to -1.                                <<03522>>04104000
  The Gap Table is a linear list of sector entries,  that  is, <<03522>>04106000
any  additions  to  the Gap Table are made at its end although <<03522>>04108000
existing entries may be modified.  Disc addresses contained in <<03522>>04110000
the entries may not always be in ascending order when  scanned <<03522>>04112000
linearly.  This  only  occurs  if SDISC encounters a defective <<03522>>04114000
area while writing and must create a hole entry (Beginning  of <<03522>>04116000
Hole  -  End of Hole [BOH-EOH] pair).  The reason is that hole <<03522>>04118000
entries consume at least the entire track on which the  defec- <<03522>>04120000
tive  area  was found.  If valid data was written on the track <<03522>>04122000
before the defective area, it is moved beyond  the  hole  area <<03522>>04124000
and  any  Gap  Table entries pointing to this area (such as an <<03522>>04126000
end-of-file) are modified to point to the  new  address,  thus <<03522>>04128000
causing a local descent in addresses.                          <<03522>>04130000
  In addition, if a contiguous block straddles  the  start  of <<03522>>04132000
the  track in which the defect is found, the entire contiguous <<03522>>04134000
block is relocated to start beyond the hole, the BOH entry  is <<03522>>04136000
extended  back to the former Beginning of Block (BOB) location <<03522>>04138000
(that is, before the start of the defective  track),  and  the <<03522>>04140000
BOB  entry  is  updated  to  point to an area beyond the hole. <<03522>>04142000
In this situation, a linear scan of the Gap  Table  reveals  a <<03522>>04144000
BOH-EOH  pair nested inside a BOB-EOB pair, again with a local <<03522>>04146000
descent in addresses.                                          <<03522>>04148000
  To save time during Forward Space File, the search starts at <<03535>>04150000
the  Gap Table entry currently being pointed to by CURRENTGPT- <<03522>>04152000
ENT.  If no gap is found between  STARTSECTOR  and  ENDSECTOR, <<03522>>04154000
the  search is repeated starting at the first entry in the Gap <<03522>>04156000
Table.                                                         <<03522>>04158000
  Because it operates in split-stack  mode,  SDISCFINDGAP  re- <<03522>>04160000
turns  four  values  in global cells RTV1 through RTV4.  These <<03522>>04162000
values are shown below for each of 13  valid  combinations  of <<03522>>04164000
STARTSECTOR,  ENDSECTOR, a BOB-EOB or BOH-EOH gap, and another <<03522>>04166000
terminator which may be EOFTYPE, EODTYPE, EOTTYPE or  ENDOFTA- <<03522>>04168000
BLETYPE from the table below.  STARTGAP and ENDGAP are double- <<03522>>04170000
word disc addresses, GAPTYPE is an integer with a value from 0 <<03522>>04172000
to 7 from the table below and ENDINDEX  is  an  integer  which <<03522>>04174000
points  to the Gap Table entry which ended the search.  Due to <<03522>>04176000
space considerations in the diagram, the  following  abbrevia- <<03522>>04178000
tions were used:                                               <<03522>>04180000
$PAGE                                                          <<03522>>04182000
  STRTGAP = STARTGAP = RTV1                                    <<03522>>04184000
  ENDGAP             = RTV2                                    <<03522>>04186000
  GAPTYPE            = RTV3                                    <<03522>>04188000
  ENDINDX = ENDINDEX = RTV4                                    <<03522>>04190000
  n/a     = not applicable, situation does not occur.          <<03522>>04192000
  STRTSCT = STARTSECTOR                                        <<03522>>04194000
  ENDSECT = ENDSECTOR                                          <<03522>>04196000
  EOF/EOT = a GAPTYPE of  EOFTYPE  or  EOTTYPE,  depending  on <<03522>>04198000
            which was encountered.                             <<03522>>04200000
  EOB/EOH = a GAPTYPE of  EOBTYPE  or  EOHTYPE,  depending  on <<03522>>04202000
            which was encountered.                             <<03522>>04204000
  pointer = points to the Gap Table entry of type GAPTYPE  for <<03522>>04206000
            which  ENDGAP contains sctradr.  If GAPTYPE = EOF, <<03522>>04208000
            EOT or EOD, STARTGAP also contains sctradr.        <<03522>>04210000
  sctradr = the sector address of a STARTGAP or an ENDGAP.     <<03522>>04212000
                                                               <<03522>>04214000
   GAPTYPE     GAPTYPE                                         <<03522>>04216000
    VALUE     IDENTIFIER      Description -- disc address of:  <<03522>>04218000
 +---------+--------------+----------------------------------+ <<03522>>04220000
 |    0    |  EOFTYPE     |  End-of-file mark                | <<03522>>04222000
 |    1    |  EODTYPE     |  Last valid data on disc         | <<03522>>04224000
 |    2    |  BOHTYPE     |  Start of hole (defective area)  | <<03522>>04226000
 |    3    |  EOHTYPE     |  End of hole (defective area)    | <<03522>>04228000
 |    4    |  BOBTYPE     |  Start of contiguous block       | <<03522>>04230000
 |    5    |  EOBTYPE     |  End of contiguous block         | <<03522>>04232000
 |    6    |  EOTTYPE     |  "End of tape" reflector         | <<03522>>04234000
 |    7    |  ENDOFTABLE- |  Last entry in Gap Table (not a  | <<03522>>04236000
 |         |    TYPE      |    disc address)                 | <<03522>>04238000
 +---------+--------------+----------------------------------+ <<03522>>04240000
                                                               <<03522>>04242000
                                       x=_                     <<03522>>04244000
                                      /   \                    <<03522>>04246000
                                     /     \                   <<03522>>04248000
          START     END           EOD,      EOF,        RTV1-  <<03522>>04250000
          SCTR      SCTR         ENDTBL     EOT         RTV4   <<03522>>04252000
            |         |                                        <<03522>>04254000
          x |         |          sctradr    n/a        STRTGAP <<03522>>04256000
    +---+ | |         |          sctradr    n/a        ENDGAP  <<03522>>04258000
 1. |   | | |         |          EOD only   n/a        GAPTYPE <<03522>>04260000
    +---+ | |         |          pointer    n/a        ENDINDX <<03522>>04262000
            |         |                                        <<03522>>04264000
            |    x    |          sctradr   sctradr     STRTGAP <<03522>>04266000
    +---+   |    |    |          sctradr   sctradr     ENDGAP  <<03522>>04268000
 2. |   |   |    |    |          EOD only  EOF/EOT     GAPTYPE <<03522>>04270000
    +---+   |    |    |          pointer   pointer     ENDINDX <<03522>>04272000
            |         |                                        <<03522>>04274000
            |         |       x    -1        -1        STRTGAP <<03522>>04276000
    +---+   |         |       |    -1        -1        ENDGAP  <<03522>>04278000
 3. |   |   |         |       |    -1        -1        GAPTYPE <<03522>>04280000
    +---+   |         |       |    -1        -1        ENDINDX <<03522>>04282000
            |         |                                        <<03522>>04284000
            |    x    |          STRTSCT   STRTSCT     STRTGAP <<03522>>04286000
          +-|-+  |    |          sctradr   sctradr     ENDGAP  <<03522>>04288000
 4.       | | |  |    |          EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04290000
          +-|-+  |    |          pointer   pointer     ENDINDX <<03522>>04292000
$PAGE                                                          <<03522>>04294000
            |         |       x  STRTSCT   STRTSCT     STRTGAP <<03522>>04296000
          +-|-+       |       |  sctradr   sctradr     ENDGAP  <<03522>>04298000
 5.       | | |       |       |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04300000
          +-|-+       |       |  pointer   pointer     ENDINDX <<03522>>04302000
            |         |                                        <<03522>>04304000
            |       x |          sctradr   sctradr     STRTGAP <<03522>>04306000
            | +---+ | |          sctradr   sctradr     ENDGAP  <<03522>>04308000
 6.         | |   | | |          EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04310000
            | +---+ | |          pointer   pointer     ENDINDX <<03522>>04312000
            |         |                                        <<03522>>04314000
            |         |       x  sctradr   sctradr     STRTGAP          04316000
            | +---+   |       |  sctradr   sctradr     ENDGAP  <<03522>>04318000
 7.         | |   |   |       |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04320000
            | +---+   |       |  pointer   pointer     ENDINDX <<03522>>04322000
            |         |                                        <<03522>>04324000
            |         |       x  sctradr   sctradr     STRTGAP <<03522>>04326000
            |       +-|-+     |  ENDSECT   ENDSECT     ENDGAP  <<03522>>04328000
 8.         |       | | |     |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04330000
            |       +-|-+     |  endtbl    endtbl      ENDINDX <<03522>>04332000
            |         |                                        <<03522>>04334000
            |         |       x    -1        -1        STRTGAP <<03522>>04336000
            |         | +---+ |    -1        -1        ENDGAP  <<03522>>04338000
 9.         |         | |   | |    -1        -1        GAPTYPE <<03522>>04340000
            |         | +---+ |    -1        -1        ENDINDX <<03522>>04342000
            |         |                                        <<03522>>04344000
            |         |       x  STRTSCT   STRTSCT     STRTGAP <<03522>>04346000
          +-|---------|-+     |  ENDSECT   ENDSECT     ENDGAP  <<03522>>04348000
10.       | |         | |     |  EOB/EOH   EOB/EOH     GAPTYPE <<03522>>04350000
          +-|---------|-+     |  endtbl    endtbl      ENDINDX <<03522>>04352000
            |         |                                        <<03522>>04354000
          x |         |          sctradr     -1        STRTGAP <<03522>>04356000
          | |         |          sctradr     -1        ENDGAP  <<03522>>04358000
11.       | |         |          EOD only    -1        GAPTYPE <<03522>>04360000
          | |         |          pointer     -1        ENDINDX <<03522>>04362000
            |         |                                        <<03522>>04364000
            |    x    |          sctradr   sctradr     STRTGAP <<03522>>04366000
            |    |    |          sctradr   sctradr     ENDGAP  <<03522>>04368000
12.         |    |    |          EOD only  EOF/EOT     GAPTYPE <<03522>>04370000
            |    |    |          pointer   pointer     ENDINDX <<03522>>04372000
            |         |                                        <<03522>>04374000
            |         |       x    -1        -1        STRTGAP <<03522>>04376000
            |         |       |    -1        -1        ENDGAP  <<03522>>04378000
13.         |         |       |    -1        -1        GAPTYPE <<03522>>04380000
            |         |       |    -1        -1        ENDINDX <<03522>>04382000
;                                                              <<03522>>04384000
                                                                        04386000
BEGIN <<SDISCFINDGAP>>                                                  04388000
DOUBLE SECTORADDRESS;                                          <<03522>>04390000
INTEGER ENTRYTYPE, ENTRYINDEX, ADR1=SECTORADDRESS,             <<03522>>04392000
   ADR2=SECTORADDRESS+1;                                       <<03522>>04394000
LOGICAL                                                        <<03522>>04396000
  FIRST'TIME;  << Speed up FSF, scan 1st from CURRENTGPTENT >> <<03522>>04398000
                                                                        04400000
STARTGAP:=ENDGAP:=-1D;                                                  04402000
GAPTYPE:=-1;                                                            04404000
ENDINDEX:=-1;                                                           04406000
IF STARTSECTOR > ENDSECTOR THEN RETURN;   << Null range.    >> <<03522>>04408000
FIRST'TIME := TRUE;                                            <<03522>>04410000
DO BEGIN   << Gap Table scan.                               >> <<03522>>04412000
   IF FIRST'TIME                                               <<03522>>04414000
      THEN ENTRYINDEX := CURRENTGPTENT                         <<03522>>04416000
      ELSE ENTRYINDEX := GPT'START;                            <<03522>>04418000
   DO                                                                   04420000
      BEGIN <<REPEAT FOR EVERY ENTRY>>                         <<00189>>04422000
      ADR1:=GPT(ENTRYINDEX).GPT'ADR'FIELD;                     <<00189>>04424000
      ADR2:=GPT(ENTRYINDEX+1);                                 <<00189>>04426000
      ENTRYTYPE:=GPT(ENTRYINDEX).GPT'TYPE'FIELD;               <<00189>>04428000
      IF SECTORADDRESS<=ENDSECTOR THEN                                  04430000
         BEGIN <<ENTRY MAY BE OF INTEREST>>                             04432000
         IF ENTRYTYPE=BOBTYPE OR ENTRYTYPE=BOHTYPE THEN                 04434000
            IF STARTGAP=-1D THEN                                        04436000
               BEGIN <<BEGINNING OF GAP>>                               04438000
               GAPTYPE:=ENTRYTYPE+1;                                    04440000
               STARTGAP:=SECTORADDRESS;                                 04442000
               END;  <<BEGINNING OF GAP>>                               04444000
         IF SECTORADDRESS<STARTSECTOR THEN                              04446000
            IF ENTRYTYPE=GAPTYPE THEN                                   04448000
               BEGIN <<ENTIRE GAP BEFORE RANGE>>                        04450000
               GAPTYPE:=-1;                                             04452000
               STARTGAP:=-1D;                                           04454000
               END;  <<ENTIRE GAP BEFORE RANGE>>                        04456000
         IF SECTORADDRESS>=STARTSECTOR OR                               04458000
           ENTRYTYPE = EODTYPE THEN                            <<03522>>04460000
            BEGIN <<ENTRY IN RANGE>>                                    04462000
            IF ENTRYTYPE=GAPTYPE THEN                                   04464000
               BEGIN <<FOUND END OF FIRST GAP>>                         04466000
               ENDGAP:=SECTORADDRESS;                                   04468000
               ENDINDEX:=ENTRYINDEX;                           <<00189>>04470000
               IF STARTGAP<STARTSECTOR THEN                             04472000
                 STARTGAP := STARTSECTOR;                               04474000
               RETURN;                                                  04478000
               END;  <<FOUND END OF FIRST GAP>>                         04480000
            IF ENTRYTYPE = EOFTYPE OR ENTRYTYPE = EOTTYPE      <<03522>>04484000
              OR ENTRYTYPE = EODTYPE THEN                      <<03522>>04486000
               BEGIN                                                    04490000
               STARTGAP:=ENDGAP:=SECTORADDRESS;                         04492000
               ENDINDEX:=ENTRYINDEX;                           <<00189>>04494000
               GAPTYPE:=ENTRYTYPE;                                      04496000
               RETURN;                                                  04498000
               END;                                                     04500000
            END;  <<ENTRY IN RANGE>>                                    04502000
         END;   <<ENTRY MAY BE OF INTEREST>>                            04504000
      END   <<REPEAT FOR EVERY ENTRY>>                         <<00189>>04506000
     UNTIL (ENTRYINDEX := ENTRYINDEX + GPTENTSIZE) >= GPTLEN   <<03522>>04508000
       OR ENTRYTYPE = ENDOFTABLETYPE;                                   04510000
   IF ENDGAP = -1D AND STARTGAP <> -1D THEN                             04512000
     ENDGAP := ENDSECTOR;   << End of gap > end of search.  >>          04514000
                                                                        04516000
<< Go through loop a second time only if gap not yet found. >>          04518000
                                                                        04520000
   IF STARTGAP <> -1D THEN                                     <<03522>>04522000
      BEGIN                                                    <<03522>>04524000
      IF STARTGAP < STARTSECTOR THEN STARTGAP := STARTSECTOR;  <<03522>>04526000
      RETURN;                                                  <<03522>>04528000
      END;                                                     <<03522>>04530000
   END   << Gap Table scan.                                 >> <<03522>>04532000
  UNTIL (FIRST'TIME := NOT FIRST'TIME);                        <<03522>>04534000
END;  <<SDISCFINDGAP>>                                                  04536000
$PAGE                                                          <<03522>>04538000
DOUBLE PROCEDURE ACTUAL'ADDRESS;                               <<03522>>04540000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03522>>04542000
                                                               <<03522>>04544000
BEGIN COMMENT --                                               <<03522>>04546000
  From time to time, SDISC must know the actual  disc  address <<03522>>04548000
of  the  current sector of the data image residing in RECBUFF. <<03522>>04550000
Since contiguous block gaps and holes ("gaps") are not put  in <<03522>>04552000
RECBUFF,  we  have a slight problem defining "current sector". <<03522>>04554000
If one or more such gaps were skipped while  we  were  filling <<03522>>04556000
RECBUFF  to read, then CURRENTADR (calculated relative to REC- <<03522>>04558000
BUFFSA) points to a different sector than that  actually  con- <<03522>>04560000
taining  the  data.  For  example,  assume RECBUFFSA = 100 and <<03522>>04562000
that a gap exists between sectors 110-115, inclusive  (6  sec- <<03522>>04564000
tors.  Also  assume  that we are in the 14th sector of RECBUFF <<03522>>04566000
(CURRENTADR = 113). If we access the disc  based  on  CURRENT- <<03522>>04568000
ADR,  we  will get (or overwrite!) a part of a gap.  Worse, if <<03522>>04570000
we blindly erase the Gap Table from CURRENTADR to the end  (as <<03522>>04572000
in  GPTMOD  (CLEAR'TO'END)), we will kill the EOB entry at 115 <<03522>>04574000
but not the BOB entry at 110.  The result  is  a  corrupt  Gap <<03522>>04576000
Table.  Note  that  EOF  and EOT marks pose no problem because <<03522>>04578000
they ARE in RECBUFF and are therefore properly  accounted  for <<03522>>04580000
by  CURRENTADR.  Since  the  sector image in RECBUFF currently <<03522>>04582000
pointed to by CURRENTADR actually exists in disc  sector  119, <<03522>>04584000
this is the actual disc address required by SDISC.             <<03522>>04586000
  Putting it another way, while reading,  CURRENTADR  is  fine <<03522>>04588000
for  managing RECBUFF but not for use with the Gap Table.  The <<03522>>04590000
problem doesn't arise while writing because gaps  are  written <<03522>>04592000
and flushed to disc immediately. Thus CURRENTADR always equals <<03522>>04594000
ACTUAL'ADDRESS and is valid at all times.                      <<03522>>04596000
  ACTUAL'ADDRESS returns the proper address  of  the  disc  by <<03522>>04598000
developing  an  offset to CURRENTADR (in GAPCOUNT) for each of <<03522>>04600000
the following situations:                                      <<03522>>04602000
1.  No gaps in the current block or CURRENTBUFINDEX is at  the <<03522>>04604000
    start of RECBUFF.  The trivial cases.                      <<03522>>04606000
2.  One or more gaps in the block, but not the end of data  on <<03522>>04608000
    the disc. We scan the Gap Table from RECBUFFSA to CURRENT- <<03522>>04610000
    ADR.  The length of any gaps are accumulated  in  GAPCOUNT <<03522>>04612000
    and  the  scan is repeated from beyond the previous gap to <<03522>>04614000
    CURRENTADR + GAPCOUNT.  When all  gaps  have  been  found, <<03522>>04616000
    CURRENTADR + GAPCOUNT will reflect the actual disc address <<03522>>04618000
    of our RECBUFF image, the elusive number we need.          <<03522>>04620000
3.  Zero or more gaps plus an end of data. This situation only <<03522>>04622000
    arises when we have read the end of file which ALWAYS pre- <<03522>>04624000
    cedes the end of data, and have returned EOF status to the <<03522>>04626000
    SDI caller.  Another read here would produce SDERR  (1)22, <<03522>>04628000
    an  attempt to read beyond EOD.  For callers who must know <<03522>>04630000
    about this situation, the contents of RTV1-RTV4 reflect  a <<03522>>04632000
    detected EOD on exit, whenever it occurs.                  <<03522>>04634000
;                                                                       04636000
INTEGER                                                        <<03522>>04638000
  GAPCOUNT;   << Totals sector length of blocks and holes.  >> <<03522>>04640000
                                                               <<03522>>04642000
DOUBLE                                                         <<03522>>04644000
  STARTSECTOR;   << Moving starting addr for gap checks.    >> <<03522>>04646000
                                                               <<03522>>04648000
GAPCOUNT := 0;                                                 <<03522>>04650000
STARTSECTOR := RECBUFFSA;                                      <<03522>>04652000
IF CURRENTBUFINDEX <> 0 THEN                                   <<03522>>04654000
   DO BEGIN   << Find EOD or all contiguous blocks or holes >> <<03522>>04656000
      SDISCFINDGAP (STARTSECTOR, CURRENTADR +                  <<03522>>04658000
                    DOUBLE (GAPCOUNT));                        <<03522>>04660000
      STARTSECTOR := ENDGAP + 1D;   << To continue if req'd >> <<03522>>04662000
      IF GAPTYPE = EOBTYPE OR GAPTYPE = EOHTYPE THEN           <<03522>>04664000
        GAPCOUNT := GAPCOUNT + INTEGER (ENDGAP - STARTGAP) + 1;<<03522>>04666000
      END     << Find EOD or all contiguous blocks or holes >> <<03522>>04668000
     UNTIL STARTGAP = -1D   << No (more) gaps in area.      >> <<03522>>04670000
       OR GAPTYPE = EODTYPE;                                   <<03522>>04672000
ACTUAL'ADDRESS := CURRENTADR + DOUBLE(GAPCOUNT);               <<03522>>04674000
END;   << of ACTUAL'ADDRESS.                                >> <<03522>>04676000
$PAGE "SDISC - READ ROUTINES"                                           04678000
PROCEDURE READBLOCK;                                                    04680000
OPTION PRIVILEGED,UNCALLABLE;                                           04682000
                                                                        04684000
COMMENT -- READBLOCK fills RECBUFF by reading physical  blocks <<03522>>04686000
from  the  serial  disc,  bypassing contiguous blocks and gaps <<03522>>04688000
(holes) as it reads.  Sector fill characters for EOT  and  EOF <<03522>>04690000
marks  and for the contiguous block interface are retained and <<03522>>04692000
are detected by READBLOCK callers.  At exit:                   <<03522>>04694000
  CURRENTBUFINDEX = 0,                                         <<03522>>04696000
  NEXTRECINBUF    = TRUE,                                      <<03522>>04698000
  WORDSINRECBUF   = RECBUFFLEN + 1 (or less, if  we  find  the <<03522>>04700000
                      end of valid data (EODTYPE) first).      <<03522>>04702000
READBLOCK begins at RECBUFFSA  for  backward  tape  operations <<03522>>04704000
(BSF or BSR (the latter via a BACKBLOCKREAD call)) and at REC- <<03522>>04706000
BUFFEA + 1D for forward tape operations (READ, FSF, FSR).      <<03522>>04708000
;                                                                       04710000
                                                                        04712000
BEGIN <<READBLOCK>>                                                     04714000
DOUBLE STARTSECTOR,                                                     04716000
       ENDSECTOR,                                                       04718000
       DERR;                                                            04720000
INTEGER OFFSET,                                                         04722000
        AVAILWORDC,                                                     04724000
        ERR1=DERR;                                                      04726000
DEFINE OFFSETSECTORLEN=OFFSET/WORDSPERSECTR#,                           04728000
       TRANSFERDONE   = GAPTYPE = EODTYPE#;                    <<03522>>04730000
                                                                        04732000
OFFSET:=0;                                                              04734000
IF RECBUFFEA=-1D THEN                                                   04738000
   RECBUFFEA := RECBUFFSA - 1D  << Called by BACKBLKRD, BSF >>          04740000
ELSE                                                                    04742000
   RECBUFFSA := RECBUFFEA + 1D; << Called by READSDISC, FSF >> <<00494>>04744000
DO                                                                      04746000
   BEGIN <<TRY TO READ BLOCK FROM DISC>>                                04748000
   ENDGAP := RECBUFFEA;   << Prime ENDGAP for DO stmt below >> <<03522>>04750000
   STARTSECTOR:=RECBUFFEA:=RECBUFFEA+1D;                       <<00494>>04752000
   ENDSECTOR:=STARTSECTOR+DOUBLE(RECBUFFSECTORLEN)-            <<00494>>04754000
     DOUBLE(OFFSETSECTORLEN) - 1D;                                      04756000
   DO                                                                   04758000
      BEGIN                                                             04760000
                                                                        04762000
<< This section skips any contiguous blocks  or  holes  be- >>          04764000
<< tween the current STARTSECTOR and ENDSECTOR.  Fill char- >>          04766000
<< acters for an EOF or EOT  mark  or  for  the  contiguous >>          04768000
<< block interface are retained, since they are part of the >>          04770000
<< buffer in any calculations dealing with start of block.  >>          04772000
                                                                        04774000
      STARTSECTOR := ENDGAP + 1D;                              <<03522>>04776000
      SDISCFINDGAP(STARTSECTOR,ENDSECTOR);                              04778000
      END   << This section skips...                        >>          04782000
     UNTIL GAPTYPE <> EOFTYPE AND GAPTYPE <> EOTTYPE;          <<03522>>04784000
   IF STARTGAP=-1D THEN                                                 04786000
      BEGIN   << Transfer all or remainder of block.        >> <<03522>>04788000
COMMENT                                                        <<03522>>04790000
  On exit from READBLOCK, RECBUFFSA should point to the  first <<03522>>04792000
sector  actually  put in RECBUFF.  The statement below assures <<03522>>04794000
this in the case where a contiguous block or hole  existed  at <<03522>>04796000
the original RECBUFFSA.                                        <<03522>>04798000
;                                                              <<03522>>04800000
      IF OFFSET = 0 THEN RECBUFFSA := RECBUFFEA;               <<03522>>04802000
      DERR:=ATACHIO(LDNUM,QMISC',DSTN,@RECBUFF+OFFSET,READ,    <<00189>>04804000
        RECBUFFLEN + 1 - OFFSET, READ0, READ1, FLAGS');        <<00189>>04806000
      IF ATIOERR THEN                                                   04808000
         BEGIN <<READ ERROR FROM DISC>>                                 04810000
         SETSDISCERROR(SDERR32);                               <<00494>>04812000
         RETURN;                                                        04814000
         END;  <<READ ERROR FROM DISC>>                                 04816000
      RECBUFFEA:=ENDSECTOR;                                    <<00494>>04818000
      CURRENTBUFINDEX:=0;                                               04820000
      NEXTRECINBUF:=TRUE;                                               04822000
      WORDSINRECBUF:=RECBUFFLEN+1;                                      04824000
      RETURN;   << This is normal exit.                     >>          04826000
      END   << Transfer all or remainder of block.          >> <<03522>>04828000
   ELSE                                                        <<03522>>04830000
      BEGIN <<GAP IN AREA>>                                             04832000
                                                               <<03522>>04834000
<< AVAILWORDC is the word count of the partial  block  read >> <<03522>>04836000
<< we  will  perform this time, namely the area from START- >> <<03522>>04838000
<< SECTOR to STARTGAP-1 (that is, to the sector before  the >> <<03522>>04840000
<< hole, contiguous block or end-of-data we just detected.  >> <<03522>>04842000
                                                               <<03522>>04844000
      AVAILWORDC:=INTEGER(STARTGAP-RECBUFFEA)*WORDSPERSECTR;   <<02025>>04846000
      IF AVAILWORDC+OFFSET>RECBUFFLEN+1 THEN                            04850000
         BEGIN   << 10 pounds for a five pound bag.         >>          04852000
         SETSDISCERROR(SDERR31);                               <<00494>>04854000
         RETURN;                                                        04856000
         END;                                                           04858000
      IF AVAILWORDC>0 THEN                                              04860000
         BEGIN   << Transfer partial block from disc.       >> <<03522>>04862000
         IF OFFSET = 0 THEN RECBUFFSA := RECBUFFEA;            <<03522>>04864000
         DERR:=ATACHIO(LDNUM,QMISC',DSTN,@RECBUFF+OFFSET,READ, <<00189>>04866000
           AVAILWORDC, READ0, READ1, FLAGS');                  <<00189>>04868000
         IF ATIOERR THEN                                                04870000
            BEGIN <<READ ERROR FROM DISC>>                              04872000
            SETSDISCERROR(SDERR32);                            <<00494>>04874000
            RETURN;                                                     04876000
            END;  <<READ ERROR FROM DISC>>                              04878000
         OFFSET:=OFFSET+AVAILWORDC;                                     04880000
         END;   << Transfer partial block from disc.        >> <<03522>>04882000
      RECBUFFEA:=ENDGAP;                                       <<00494>>04884000
      END;  <<GAP IN AREA>>                                             04888000
   END   <<TRY TO READ BLOCK FROM DISC>>                                04890000
                                                               <<03522>>04892000
<< The only time the loop terminating  condition  below  is >> <<03522>>04894000
<< satisfied is when the end of valid data (EODTYPE) is de- >> <<03522>>04896000
<< tected.  Only for this condition will  RECBUFF  be  less >> <<03522>>04898000
<< than  full on exit.  For all other non-error conditions, >> <<03522>>04900000
<< READBLOCK exits above with RECBUFF  full  (WORDSINRECBUF >> <<03522>>04902000
<< := RECBUFFLEN + 1). In the special case where we read no >> <<03522>>04904000
<< data at all (OFFSET = 0), we were already at the end  of >> <<03522>>04906000
<< data  when  we entered READBLOCK.  Thus we are trying to >> <<03522>>04908000
<< read beyond the end of data, ordinarily  an  error.  But >> <<03522>>04910000
<< the File System does this regularly as part of its anti- >> <<03522>>04912000
<< cipatory read algorithm. So we assume all such reads are >> <<03522>>04914000
<< due to this and return a non-fatal error code.           >> <<03522>>04916000
                                                               <<03522>>04918000
  UNTIL TRANSFERDONE;                                                   04920000
WORDSINRECBUF:=OFFSET;                                                  04922000
CURRENTBUFINDEX:=0;                                                     04924000
IF OFFSET=0 THEN                                               <<02025>>04926000
   SETSDISCERROR(SDERR122)  <<SIGNAL FILESYSTEM THAT THIS>>    <<02025>>04928000
     <<ANTICIPATORY READ WAS BEYOND THE PHYSICAL END OF DATA>> <<02025>>04930000
ELSE                                                           <<02025>>04932000
   NEXTRECINBUF:=TRUE;  <<THERE IS ACTUALLY VALID DATA IN THE>><<02025>>04934000
                        <<BUFFER>>                             <<02025>>04936000
END;  <<READBLOCK>>                                                     04938000
$PAGE                                                          <<03522>>04940000
PROCEDURE BACKBLOCKREAD;                                                04942000
OPTION PRIVILEGED,UNCALLABLE;                                           04944000
                                                               <<03522>>04946000
  COMMENT -- BACKBLOCKREAD reads the previous  physical  block <<03522>>04948000
of the serial disc into RECBUFF. Knowing RECBUFFSA, the start- <<03522>>04950000
ing address of the current RECBUFF contents, it calculates the <<03522>>04952000
starting address required by READBLOCK to  make  the  previous <<03522>>04954000
block present, then calls READBLOCK. Since READBLOCK skips any <<03522>>04956000
contiguous block or hole gaps, BACKBLOCKREAD must also account <<03522>>04958000
for these when determining where READBLOCK is to start.        <<03522>>04960000
  BACKBLOCKREAD starts by checking for block or hole  gaps  in <<03522>>04962000
the  previous  physical  block.  If it finds none, the task is <<03522>>04964000
easy.  If it finds one or more,  it  accumulates  their  total <<03522>>04966000
length  in  GAPCOUNT, then repeats the search in GAPCOUNT sec- <<03522>>04968000
tors before the one it just tried.  The process repeats  until <<03522>>04970000
no  gaps are found, then READBLOCK is called.  Since READBLOCK <<03522>>04972000
performs the inverse process of deleting gaps, the  result  is <<03522>>04974000
usually a full RECBUFF.                                        <<03522>>04976000
  Boundary conditions may cause trouble.  If  the  load  point <<03522>>04978000
(BOT) is detected while scanning backward, the scan is aborted <<03522>>04980000
and READBLOCK will read a full RECBUFF (or until  end-of-data) <<03522>>04982000
from  there.  The  previous  block boundary is lost unless the <<03522>>04984000
load point happens to coincide with a block boundary.  To help <<03522>>04986000
callers adjust for this condition, the sector  difference  be- <<03522>>04988000
tween  the  load  point and the would-be start of the previous <<03522>>04990000
block is returned in the global value  RTV3  (because  of  our <<03522>>04992000
split-stack mode of operation), disguised as BOT'SECTOR'COUNT. <<03522>>04994000
;                                                              <<03522>>04996000
BEGIN <<BACKBLOCKREAD>>                                                 04998000
INTEGER                                                                 05002000
  DATA'SECTORS,   << No. of data sctrs read by READBLOCK.   >> <<03522>>05004000
  GAPCOUNT;   << No. sectors in search area that have gaps. >> <<03522>>05006000
DOUBLE  ENDSECTOR,                                             <<03522>>05012000
        STARTSECTOR,                                                    05014000
        LASTSTARTSECTOR;                                       <<03522>>05016000
                                                               <<03522>>05018000
DATA'SECTORS := 0;                                             <<03522>>05020000
ENDSECTOR:=RECBUFFSA-1D;                                       <<00494>>05022000
LASTSTARTSECTOR := STARTSECTOR := RECBUFFSA -                  <<03522>>05024000
                   DOUBLE (RECBUFFSECTORLEN);                  <<03522>>05026000
DO BEGIN   << This loop never falls through.                >> <<03522>>05030000
   GAPCOUNT := 0;                                              <<03522>>05032000
                                                               <<03522>>05034000
<< Don't extend backward search beyond load point (BOT).    >> <<03522>>05036000
                                                               <<03522>>05038000
   IF STARTSECTOR < DOUBLE (STARTADDRESS) THEN                 <<03522>>05040000
      LASTSTARTSECTOR := STARTSECTOR := DOUBLE (STARTADDRESS); <<03522>>05042000
   ENDGAP := STARTSECTOR - 1D;   << Prime for DO stmt below >> <<03522>>05044000
   DO BEGIN   << Find all gaps in current search area.      >> <<03522>>05046000
      DO BEGIN   << Find one gap.                           >> <<03522>>05048000
                                                               <<03522>>05050000
<< This section skips any contiguous blocks  or  holes  be- >> <<03522>>05052000
<< tween the current STARTSECTOR and ENDSECTOR.  Fill char- >> <<03522>>05054000
<< acters for an EOF or EOT  mark  or  for  the  contiguous >> <<03522>>05056000
<< block interface are retained, since they are part of the >> <<03522>>05058000
<< buffer in any calculations dealing with start of block.  >> <<03522>>05060000
                                                               <<03522>>05062000
         STARTSECTOR := ENDGAP + 1D;                           <<03522>>05064000
         SDISCFINDGAP (STARTSECTOR, ENDSECTOR);                <<03522>>05066000
         END   << Find one gap.                             >> <<03522>>05068000
        UNTIL GAPTYPE <> EOFTYPE AND GAPTYPE <> EOTTYPE;       <<03522>>05070000
      IF STARTGAP <> -1D THEN   << Found a gap.             >> <<03522>>05072000
        GAPCOUNT := GAPCOUNT + INTEGER(ENDGAP - STARTGAP) + 1; <<03522>>05074000
      END   << Find all gaps in current search area.        >> <<03522>>05076000
     UNTIL STARTGAP = -1D;                                     <<03522>>05078000
                                                               <<03522>>05080000
<< The following code accounts for any gaps in the  current >> <<03522>>05082000
<< search  area,  and also updates the total number of data >> <<03522>>05084000
<< sectors to be read by READBLOCK.  This is needed for our >> <<03522>>05086000
<< load point checking.  In a few lines, when it is time to >> <<03522>>05088000
<< call READBLOCK, if there is no data to be read it  indi- >> <<03522>>05090000
<< cates  that  the  caller  is trying to backspace from in >> <<03522>>05092000
<< front of the first accessible  (that  is,  non-block  or >> <<03522>>05094000
<< -hole)  record.  Doing this on a tape places the user at >> <<03522>>05096000
<< load point, but does not otherwise change the  situation >> <<03522>>05098000
<< (that  is,  the next read, write or (forward) space will >> <<03522>>05100000
<< still access the first record).  We also set BOT status. >> <<03522>>05102000
<< A backspace attempt while at BOT is an  error  (detected >> <<03522>>05104000
<< by CTRLSDISC).                                           >> <<03522>>05106000
                                                               <<03522>>05108000
   DATA'SECTORS := DATA'SECTORS + INTEGER (ENDSECTOR -         <<03522>>05110000
                   LASTSTARTSECTOR) + 1 - GAPCOUNT;            <<03522>>05112000
   ENDSECTOR := LASTSTARTSECTOR - 1D;                          <<03522>>05114000
   STARTSECTOR := LASTSTARTSECTOR := LASTSTARTSECTOR -         <<03522>>05116000
     DOUBLE (GAPCOUNT);                                        <<03522>>05118000
   IF GAPCOUNT = 0 THEN                                        <<03522>>05120000
      BEGIN   << Found starting point or load point.        >> <<03522>>05122000
                                                               <<03522>>05124000
<< If DATA'SECTORS is less than READBUFFSECTORLEN, it means >> <<03522>>05126000
<< we hit the load point and that READBLOCK will cause data >> <<03522>>05128000
<< in RECBUFF to be offset by the  difference  between  the >> <<03522>>05130000
<< two.  If DATA'SECTORS is 0, there is no data between our >> <<03522>>05132000
<< current position  and  the  load  point,  and  READBLOCK >> <<03522>>05134000
<< shouldn't even be called.                                >> <<03522>>05136000
                                                               <<03522>>05138000
      IF DATA'SECTORS = 0 THEN                                 <<03522>>05140000
         BEGIN   << No data found, must be load point.      >> <<03522>>05142000
         BOT'SENSOR := BOT'FOUND;                              <<03522>>05144000
         RETURN;   << Don't change any pointers.            >> <<03522>>05146000
         END;                                                  <<03522>>05148000
      RECBUFFEA:=-1D;                                                   05152000
      RECBUFFSA:=STARTSECTOR;                                  <<00494>>05154000
      NEXTRECINBUF:=FALSE;                                     <<00494>>05156000
      READBLOCK;                                                        05158000
      BOT'SECTOR'COUNT := RECBUFFSECTORLEN - DATA'SECTORS;     <<03522>>05160000
      RETURN;   << This is normal exit.                     >>          05162000
      END;                                                              05164000
   END   << This loop never falls through.                  >> <<03522>>05166000
  UNTIL FALSE;                                                 <<03522>>05168000
END;  <<BACKBLOCKREAD>>                                                 05170000
$PAGE                                                          <<03522>>05172000
PROCEDURE READSDISC;                                           <<03522>>05174000
OPTION PRIVILEGED,UNCALLABLE;                                           05176000
                                                                        05178000
COMMENT:                                                                05180000
   THIS PROCEDURE IS TO TRANSFER THE NEXT LOGICAL RECORD                05182000
   FROM THE SERIAL DISC TO THE USER'S BUFFER.  IF ALL OR                05184000
   PART OF THE LOGICAL RECORD IS DISC RESIDENT, IT WILL                 05186000
   INITIATE A PHYSICAL TRANSFER OF THE NEXT BLOCK.;                     05188000
                                                                        05190000
BEGIN <<READSDISC>>                                                     05192000
INTEGER NEXTBUFINDEX,                                                   05194000
        NEXTWORD,                                                       05196000
        ENTRYINDEX,                                            <<03522>>05198000
        RECLEN,                                                         05200000
        SBUFXFERLEN,                                                    05202000
        TEMP,                                                  <<03522>>05204000
        BYTEC,                                                          05206000
        TRANSFERC,                                                      05208000
        TRANSFERLENGTH;                                                 05210000
DOUBLE STARTSECTOR,                                                     05212000
       ENDSECTOR;                                                       05214000
LOGICAL                                                        <<00494>>05216000
        TRANSFERMODE,                                                   05218000
        TRANSFERCOMPLETE;                                               05220000
DEFINE  BYTES =TRUE#;                                          <<03522>>05226000
IF TAPEWRITTEN THEN                                                     05230000
   BEGIN <<ATTEMPTED TO READ BEYOND VALID DATA>>                        05232000
   SETSDISCERROR(SDERR22);                                     <<00494>>05234000
   RETURN;                                                              05236000
   END;  <<ATTEMPTED TO READ PAST VALID DATA>>                          05238000
                                                               <<03522>>05240000
REREAD:                                                        <<00189>>05242000
                                                               <<03522>>05244000
IF NOT NEXTRECINBUF THEN                                                05246000
   BEGIN <<PERFORM PHYSICAL TRANSFER>>                                  05248000
   READBLOCK;                                                           05250000
   IF SDERR THEN RETURN;                                                05252000
   END;  <<PERFORM PHYSICAL TRANSFER>>                                  05254000
IF CURRENTBUFINDEX>=WORDSINRECBUF THEN                                  05256000
   BEGIN                                                                05258000
   SETSDISCERROR(SDERR23);                                     <<00494>>05260000
   RETURN;                                                              05262000
   END;                                                                 05264000
STARTSECTOR := ACTUAL'ADDRESS;   << To verify EOF/T later.  >> <<03522>>05266000
RECLEN:=RECBUFF(CURRENTBUFINDEX);                                       05268000
IF EOT'MARK <= RECLEN <= EOF'MARK THEN                         <<03522>>05270000
   BEGIN COMMENT -- Handle special cases here:                 <<03522>>05272000
                                                               <<03522>>05274000
1.  RECLEN = -2 (EOT'MARK).  Verify that the  Gap  Table  also <<03522>>05276000
    shows  an  EOT here, then read next record since EOT's are <<03522>>05278000
    invisible during reads.  This section is left in for  com- <<03522>>05280000
    patibility  with  older serial discs.  The EOT'MARK is now <<04742>>05282000
    written only to floppy discs, and only for use by INITIALs <<04742>>05284000
    version of serial disc code. The EOT'MARK is ignored here. <<04742>>05286000
2.  RECLEN = -1 (FILLCHAR).  Since  contiguous  blocks  always <<03522>>05288000
    start on a sector boundary, FILLCHARs are used as required <<03522>>05290000
    to fill out the previous sector. This section merely skips <<03522>>05292000
    them, then reads the next  record  (since  the  contiguous <<03522>>05294000
    blocks themselves are only in RECBUFF while being written. <<03522>>05296000
3.  RECLEN = 0 (EOF'MARK).  Verify that  the  Gap  Table  also <<03522>>05298000
    shows an EOF here and return EOF status to the caller.     <<03522>>05300000
;                                                              <<03522>>05302000
   ERRORCODE:=SDERR0;                                                   05304000
   CURRENTBUFINDEX:=(CURRENTBUFINDEX/WORDSPERSECTR+1)*                  05308000
     WORDSPERSECTR;   << Make sure we skip rest of sector.  >>          05310000
   IF CURRENTBUFINDEX>=WORDSINRECBUF THEN                               05312000
      NEXTRECINBUF:=FALSE;                                              05314000
   IF RECLEN <> FILLCHAR THEN                                  <<03522>>05316000
      BEGIN   << Verify that we really have EOF/EOT here.   >> <<03522>>05318000
      SDISCFINDGAP (STARTSECTOR, STARTSECTOR);                 <<03522>>05320000
      IF RECLEN = EOF'MARK AND GAPTYPE = EOFTYPE               <<03522>>05322000
        OR RECLEN = EOT'MARK AND GAPTYPE = EOTTYPE             <<03522>>05324000
        THEN                                                   <<03522>>05326000
           BEGIN  << Found EOF/T that got us here.          >>          05328000
           ENDINDEX := ENDINDEX + GPTENTSIZE;                  <<03522>>05330000
           GPTMOD (UPDT'FOR'READ'OP);                          <<03522>>05332000
           IF SDERR THEN RETURN;                               <<03522>>05334000
           END                                                          05338000
        ELSE                                                            05340000
           BEGIN   << Belt but no suspenders -- lose pants. >>          05342000
           SETSDISCERROR (SDERR17);                            <<00494>>05344000
           RETURN;                                                      05346000
           END;                                                         05348000
      END;    << Verify that we really have EOF/EOT here.   >> <<03522>>05350000
                                                                        05352000
<< The EOT reflector and contiguous block  fill  characters >> <<00189>>05354000
<< are invisible during a read.                             >> <<00189>>05356000
                                                                        05358000
   IF RECLEN <> EOF'MARK THEN GO REREAD;                       <<03522>>05360000
   EOFCODE := HARDWARE'EOF;                                    <<03522>>05362000
   GO EXIT;                                                    <<03733>>05366000
   END;   << Handle special cases here.                     >> <<03522>>05368000
NEXTWORD:=CURRENTBUFINDEX+1;                                            05372000
                                                               <<03522>>05374000
  COMMENT -- As with mag tape, distinguish between the  actual <<03522>>05376000
size  of  the record in the buffer (RECLEN) and the user's re- <<03522>>05378000
quest length (CNT).  Limit the transfer to MIN (RECLEN,  CNT), <<03522>>05380000
but be sure to position CURRENTBUFINDEX to the actual start of <<03522>>05382000
the next record in RECBUFF.                                    <<03522>>05384000
  If the disc has been trashed, the RECLEN we read here has  a <<04742>>05386000
random value.  Since it is treated as integer here, it may ap- <<04742>>05388000
pear to be < 0 when TRANSFERC is initialized a few lines  from <<04742>>05390000
here,  and would win when compared with BYTEC.  When TRANSFERC <<04742>>05392000
is later used as a positive byte count to  move  data  to  the <<04742>>05394000
caller's buffer, half a memory bank would be clobbered result- <<04742>>05396000
ing in any number of system failures.  The next line  of  code <<04742>>05398000
prevents  this.  Note  that  a RECLEN of -1 or -2 is O.K., but <<04742>>05400000
that has already been dealt with before now.  Also,  a  random <<04742>>05402000
RECLEN  >  0  will  lose when compared with BYTEC, so will not <<04742>>05404000
cause massive system amnesia.                                  <<04742>>05406000
;                                                              <<03522>>05408000
IF RECLEN < 0 THEN                                             <<04742>>05410000
   BEGIN                                                       <<04742>>05412000
   SETSDISCERROR (SDERR22);                                    <<04742>>05414000
   RETURN;                                                     <<04742>>05416000
   END;                                                        <<04742>>05418000
NEXTBUFINDEX:=CURRENTBUFINDEX+(RECLEN+1)&LSR(1)+2;                      05420000
IF CNT<0 THEN TRANSFERMODE:=BYTES; <<TRUE>>                             05422000
BYTEC:=IF CNT<0 THEN -CNT ELSE CNT&LSL(1);                              05424000
TRANSFERC:=IF BYTEC>RECLEN THEN RECLEN ELSE BYTEC;                      05426000
XMITLOG:=IF CNT<0 THEN -TRANSFERC ELSE                                  05428000
  (TRANSFERC+1) & LSR(1);                                               05430000
TRANSFERCOMPLETE:=FALSE;                                                05432000
IF DSTX=USERSTACK THEN                                                  05434000
   BEGIN <<CALCULATE DB-OFFSET INTO SEGMENT>>                           05436000
   TOS:=@DBOFFSET;                                                      05438000
   TOS:=DSTX;                                                           05440000
   TOS:=PXGLOB1;                                                        05442000
   TOS:=1;                                                              05444000
   ASSEMBLE(MFDS 4); <<FETCH OFFSET TO DB FROM USER'S PCBX>>            05446000
   END   <<CALCULATE DB-OFFSET INTO SEGMENT>>                           05448000
ELSE                                                                    05450000
   DBOFFSET:=0;                                                         05452000
TOS:=DSTX; <<SEGMENT# FOR MOVE>>                                        05454000
TOS:=ADDR+DBOFFSET; <<OFFSET FOR MOVE>>                                 05456000
DO                                                                      05458000
   BEGIN <<MOVE REC TO USER BUFFER>>                                    05460000
   IF (TRANSFERC+1) & LSR(1) + CURRENTBUFINDEX <                        05462000
     WORDSINRECBUF THEN                                        <<03522>>05464000
      BEGIN   << Transfer can be completed.                 >>          05466000
      IF NOT NULLTRANSFER THEN                                          05468000
         BEGIN   << Physical data transfer.                 >>          05470000
         TOS := @RECBUFF(NEXTWORD);   << Source address.    >>          05472000
         TOS := TRANSFERC & LSR(1);   << Word count.        >>          05474000
         IF DSTX = SYSBUFRDSTX THEN                                     05476000
            BEGIN                                                       05478000
            SBUFXFERLEN := S0;                                          05480000
            IF S0 > SBUFSIZE THEN DO                                    05482000
               BEGIN                                                    05484000
               SBUFXFERLEN := TOS;                                      05486000
               TOS := SBUFSIZE;                                         05488000
               ASSEMBLE (MTDS 1);                                       05490000
               TOS := SYSBUFRDSTX;                                      05492000
               TOS := ADDR - 1;                                         05494000
               TOS := @ADDR;                                            05496000
               TOS := 1;                                                05498000
               ASSEMBLE (MFDS 4);   << Fetch next index.    >>          05500000
               S1 := ADDR;                                              05502000
               TOS := SBUFXFERLEN - SBUFSIZE;                           05504000
               END                                                      05506000
              UNTIL S0 <= SBUFSIZE;                                     05508000
            END;                                                        05510000
         ASSEMBLE (MTDS 1);   << Move data to user buffer.  >>          05512000
         IF TRANSFERMODE AND LOGICAL(TRANSFERC) THEN                    05514000
            BEGIN   << Move last (odd) byte.                >>          05516000
            TOS := @TEMP;  << Holder to build final word in >>          05518000
            TOS := S3;   << DST# of user buffer.            >>          05520000
            TOS := S3;  << Addr of next word in user buffer >>          05522000
            TOS := 1;   << Length of move.                  >>          05524000
            IF DSTX = SYSBUFRDSTX                                       05526000
              AND SBUFXFERLEN = SBUFSIZE THEN                           05528000
               BEGIN                                                    05530000
               TOS := SYSBUFRDSTX;                                      05532000
               TOS := ADDR - 1;                                         05534000
               TOS := @ADDR;                                            05536000
               TOS := 1;                                                05538000
               ASSEMBLE (MFDS 4);                                       05540000
               S5 := S1 :=ADDR;                                         05542000
               END;                                                     05544000
            ASSEMBLE (MFDS 4);  << Fetch word from user buf >>          05546000
                                << ... to be 1/2 rewritten. >>          05548000
            TEMP.(0:8) := RECBUFF(NEXTWORD + TRANSFERC & LSR(1)         05550000
              +1).(0:8);   << Last byte of transfer.        >>          05552000
            TOS := 1;   << Length of move.                  >>          05554000
            ASSEMBLE (MTDS 1);   << Finish transfer.        >>          05556000
            END;   << Move last (odd) byte.                 >>          05558000
         DEL;   << Delete RECBUFF address.                  >>          05560000
         END;   << Physical data transfer.                  >>          05562000
      DDEL;   << Delete user buffer address.                >>          05564000
      TRANSFERCOMPLETE := TRUE;                                         05566000
      IF NEXTBUFINDEX > WORDSINRECBUF THEN                              05568000
         BEGIN   << Next record not in buffer, do pre-read. >>          05572000
         NEXTBUFINDEX := NEXTBUFINDEX - WORDSINRECBUF;                  05574000
         READBLOCK;                                                     05576000
         IF SDERR THEN RETURN;                                 <<00189>>05578000
         END;                                                  <<03522>>05580000
      END   << Transfer can be completed.                   >>          05584000
   ELSE                                                                 05586000
      BEGIN   << Transfer remainder of RECBUFF.             >>          05588000
      TOS := @RECBUFF(NEXTWORD);   << Source addr for move. >>          05594000
      TOS := WORDSINRECBUF - NEXTWORD;   << Length for move >> <<03522>>05596000
      TRANSFERLENGTH := S0;   << For later recalculation of >>          05600000
                        << number of words yet to be moved. >>          05602000
      IF NOT NULLTRANSFER THEN                                          05604000
         BEGIN   << Physical transfer.                      >>          05606000
         IF DSTX = SYSBUFRDSTX THEN                                     05608000
            BEGIN                                                       05610000
            SBUFXFERLEN := S0;                                          05612000
            IF S0 > SBUFSIZE THEN DO                                    05614000
               BEGIN                                                    05616000
               SBUFXFERLEN := TOS;                                      05618000
               TOS := SBUFSIZE;                                         05620000
               ASSEMBLE (MTDS 1);                                       05622000
               TOS := SYSBUFRDSTX;                                      05624000
               TOS := ADDR - 1;                                         05626000
               TOS := @ADDR;                                            05628000
               TOS := 1;                                                05630000
               ASSEMBLE (MFDS 4);   << Fetch next index.    >>          05632000
               S1 := ADDR;                                              05634000
               TOS := SBUFXFERLEN - SBUFSIZE;                           05636000
               END                                                      05638000
              UNTIL S0 <= SBUFSIZE;                                     05640000
            END;                                                        05642000
         ASSEMBLE (MTDS 2);   << Move to user buffer...     >>          05644000
                 << ...deleting length and RECBUFF address. >>          05646000
         END   << Physical transfer.                        >>          05648000
      ELSE                                                              05650000
         DDEL;  << Null xfer, delete length & recbuff addr. >>          05652000
      NEXTBUFINDEX := NEXTBUFINDEX - WORDSINRECBUF;                     05654000
      READBLOCK;                                                        05656000
      IF SDERR THEN RETURN;                                    <<00189>>05658000
      NEXTWORD := 0;                                                    05660000
      TRANSFERC := TRANSFERC - TRANSFERLENGTH & LSL(1);                 05662000
      END;  << Transfer remainder of RECBUFF.               >>          05664000
   END   << Transfer record to user buffer.                 >>          05666000
  UNTIL TRANSFERCOMPLETE;                                               05668000
IF NEXTBUFINDEX >= WORDSINRECBUF THEN                          <<03640>>05672000
  NEXTRECINBUF := FALSE;                                                05674000
IF NEXTBUFINDEX > 0 THEN                                       <<03640>>05676000
   IF NEXTBUFINDEX < WORDSINRECBUF THEN                        <<03640>>05678000
      IF INTEGER (RECBUFF (NEXTBUFINDEX-1)) <> RECLEN THEN     <<03640>>05680000
         BEGIN   << Leading & trailing RECLEN's don't match >>          05682000
         SETSDISCERROR (-SDERR30);                             <<03640>>05684000
         RETURN;                                                        05686000
         END;                                                           05688000
CURRENTBUFINDEX := NEXTBUFINDEX;                               <<03640>>05690000
                                                               <<03522>>05692000
<< Since holes and contiguous blocks are not placed in REC- >> <<03522>>05694000
<< BUFF, the just-completed read may have taken us over one >> <<03522>>05696000
<< or more of them. This code makes sure that CURRENTGPTENT >> <<03522>>05698000
<< is updated appropriately.                                >> <<03522>>05700000
                                                               <<03522>>05702000
ENTRYINDEX := -1;   << In case we don't find any gaps.      >> <<03522>>05704000
STARTSECTOR := RECBUFFSA;                                      <<03522>>05706000
ENDSECTOR := ACTUAL'ADDRESS - 1D;                              <<03522>>05708000
DO BEGIN   << This loop skips one hole or block.            >> <<03522>>05710000
   SDISCFINDGAP (STARTSECTOR, ENDSECTOR);                      <<03522>>05712000
   STARTSECTOR := ENDGAP + 1D;                                 <<03522>>05714000
   IF STARTGAP <> -1D THEN ENTRYINDEX := ENDINDEX;             <<03522>>05716000
   END                                                         <<03522>>05718000
  UNTIL STARTGAP = -1D;   << Scanned all pertinent entries. >> <<03522>>05720000
IF ENTRYINDEX <> -1 THEN                                       <<03522>>05722000
   BEGIN   << Found some kind of entry.                     >> <<03522>>05724000
   ENDINDEX := ENTRYINDEX + GPTENTSIZE;                        <<03522>>05726000
   GPTMOD (UPDT'FOR'READ'OP);                                  <<03522>>05728000
   IF SDERR THEN RETURN;                                       <<03522>>05730000
   END;                                                        <<03522>>05732000
                                                               <<03522>>05734000
EXIT:                                                          <<03733>>05736000
                                                               <<03733>>05738000
TAPEREWOUND := FALSE;   << Make sure we get off Load Point. >> <<03733>>05740000
CHECK'FOR'EOT;   << Set EOTSENSOR if we passed over EOT.    >> <<03522>>05742000
BOT'SENSOR := BOT'NOT'FOUND;                                   <<03522>>05744000
END;  <<READSDISC>>                                                     05746000
$PAGE "SDISC - WRITE ROUTINES"                                          05748000
  PROCEDURE SDISCTRANSFER(OLDSTARTSECTOR,OLDENDSECTOR,                  05750000
    NEWSTARTSECTOR);                                                    05752000
  VALUE OLDSTARTSECTOR,OLDENDSECTOR,NEWSTARTSECTOR;                     05754000
  DOUBLE OLDSTARTSECTOR,OLDENDSECTOR,NEWSTARTSECTOR;                    05756000
OPTION PRIVILEGED,UNCALLABLE;                                           05758000
COMMENT:                                                                05760000
   PHYSICALLY MOVE DATA FROM ONE AREA OF THE DISC                       05762000
   TO A NEW AREA OF THE DISC.  USED TO RELOCATE THE                     05764000
   ALREADY WRITTEN PORTION OF A CONTIGUOUS BLOCK AROUND                 05766000
   A DEFECTIVE TRACK IN AN EFFORT TO KEEP IT AS A                       05768000
   SINGLE UNIT;                                                         05770000
                                                                        05772000
                                                                        05774000
  BEGIN <<TRANSFER>>                                                    05776000
  DOUBLE DERR, DI, DJ, NEWENDSECTOR;                           <<04249>>05778000
  INTEGER ERR1 = DERR, SECTORLENGTH;                           <<03522>>05780000
  INTEGER DI1=DI,                                                       05784000
          DI2=DI+1,                                                     05786000
          DJ1=DJ,                                                       05788000
          DJ2=DJ+1;                                                     05790000
                                                                        05792000
  SECTORLENGTH:=INTEGER(OLDENDSECTOR-OLDSTARTSECTOR+1D);                05794000
RETRY:                                                                  05798000
  NEWENDSECTOR := NEWSTARTSECTOR + DOUBLE (SECTORLENGTH - 1);           05800000
  IF NEWENDSECTOR <= EODSECTR THEN                                      05802000
    BEGIN   << It fits on the disc.                         >>          05804000
    DI := OLDSTARTSECTOR;                                               05808000
    DJ := NEWSTARTSECTOR;                                               05810000
    DO                                                                  05812000
      BEGIN   << Transfer portion from old area to new.     >>          05814000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @PORTION, READ,             05816000
        PORTIONLENGTH, DI1, DI2, FLAGS');   << Read portion >> <<00189>>05818000
      IF ATIOERR THEN                                                   05820000
        BEGIN   << ATTACHIO error.                          >>          05822000
        SETSDISCERROR (SDERR12);                               <<00494>>05824000
        RETURN;                                                         05826000
        END;    << ATTACHIO error.                          >>          05828000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @PORTION, WRITE,   <<00189>>05830000
        PORTIONLENGTH,DJ1,DJ2,FLAGS'); <<Write portion to new area>>    05832000
      IF ATIOERR THEN                                                   05834000
        BEGIN   << ATTACHIO error.                          >>          05836000
        NEWSTARTSECTOR := (DJ/DOUBLE (SECTORSPERTRAK) + 1D) *           05838000
          DOUBLE (SECTORSPERTRAK);                                      05840000
        GO TO RETRY;                                                    05842000
        END;    << ATTACHIO error.                          >>          05844000
      DJ := DJ + DOUBLE (PORT'SECT'LEN);                                05846000
      END   << Transfer portion from old area to new.       >>          05848000
     UNTIL (DI := DI + DOUBLE (PORT'SECT'LEN)) > OLDENDSECTOR;          05850000
    END   << It fits on the disc.                           >>          05852000
  ELSE                                                                  05854000
    BEGIN   << Will not fit on disc.                        >>          05856000
    SETSDISCERROR (SDERR6);                                    <<00494>>05858000
    RETURN;                                                    <<00494>>05860000
    END;    << Will not fit on disc.                        >>          05862000
  RECBUFFSA := NEWENDSECTOR + 1D;                              <<03522>>05866000
  GPTMOD (ENTER'HOLE, OLDSTARTSECTOR, NEWSTARTSECTOR - 1D);    <<04249>>05870000
  IF SDERR THEN RETURN;                                                 05872000
  IF CONTIGSTARTSECTOR <> -1D THEN                                      05874000
    CONTIGSTARTSECTOR:=NEWSTARTSECTOR;                                  05876000
  GPTMOD (UPDT'FOR'RELOC'BLOCK, OLDSTARTSECTOR,                <<03522>>05878000
    NEWSTARTSECTOR);                                           <<03522>>05880000
  END;  <<TRANSFER>>                                                    05884000
$PAGE                                                          <<03522>>05886000
PROCEDURE DECLAREHOLE;                                                  05888000
  OPTION PRIVILEGED, UNCALLABLE;                                        05890000
                                                               <<04249>>05892000
BEGIN COMMENT --                                               <<04249>>05894000
  Make a hole entry in the Gap Table for the rest of the  cur- <<04249>>05896000
rent  track.  If we are writing a contiguous block and part of <<04249>>05898000
the block has already been written to the disc, move that part <<04249>>05900000
of the block to the area beyond the hold and update RECBUFFSA. <<04249>>05902000
;                                                              <<04249>>05904000
  DOUBLE CURRENTTRACK;                                         <<03522>>05908000
  DOUBLE DESTSECTOR, STARTSECTOR;                              <<03522>>05910000
                                                                        05912000
  CURRENTTRACK := RECBUFFSA / DOUBLE (SECTORSPERTRAK);         <<03522>>05914000
  DESTSECTOR := (CURRENTTRACK + 1D) * DOUBLE (SECTORSPERTRAK); <<03522>>05916000
  IF CONTIGSTARTSECT = -1D                                     <<04249>>05918000
     THEN STARTSECTOR := RECBUFFSA                             <<04249>>05920000
     ELSE STARTSECTOR := CONTIGSTARTSECT;                      <<04249>>05922000
  IF STARTSECTOR < RECBUFFSA THEN                              <<03522>>05924000
    BEGIN <<THERE IS DATA ALREADY ON DISC TO BE TRANSFERED>>   <<00494>>05926000
    SDISCTRANSFER(STARTSECTOR,RECBUFFSA-1D,DESTSECTOR);        <<00494>>05928000
    RETURN;                                                             05930000
    END                                                                 05932000
  ELSE                                                                  05934000
    BEGIN <<NO DATA WRITTEN IN THIS TRACK OR BLOCK YET>>                05936000
    RECBUFFSA:=DESTSECTOR;                                     <<00494>>05940000
    GPTMOD (ENTER'HOLE, STARTSECTOR, DESTSECTOR-1D);           <<03522>>05942000
    IF SDERR THEN RETURN;                                               05944000
    IF CONTIGSTARTSECTOR <> -1D THEN                                    05946000
       CONTIGSTARTSECTOR:=DESTSECTOR;                                   05948000
    END;  <<NO DATA WRITTEN IN THIS TRACK OR BLOCK YET>>                05950000
  END;  <<DECLAREHOLE>>                                                 05952000
$PAGE                                                          <<03522>>05954000
PROCEDURE CHECK'WRITE'RING;                                    <<03522>>05956000
  OPTION PRIVILEGED, UNCALLABLE;                               <<03522>>05958000
                                                               <<03522>>05960000
BEGIN COMMENT --                                               <<03522>>05962000
  Checks for a "write ring" (meaning, the operator has allowed <<03522>>05964000
writing in the :REPLY), notifies the operator if the "ring" is <<03522>>05966000
missing and asks him/her to O.K. writing. The two messages are <<03522>>05968000
only displayed once per serial disc open.  This code was moved <<03522>>05970000
unaltered from both the RITESDISC and CTRLSDISC procedures.    <<03522>>05972000
;                                                              <<03522>>05974000
INTEGER                                                                 05976000
  QDSTN,    << Q-relative SDI data segment number.          >>          05978000
  QLDNUM;   << Q-relative LDEV number of serial disc.       >>          05980000
                                                                        05982000
IF NOT WRITERING THEN                                                   05984000
   BEGIN                                                                05986000
   QDSTN := DSTN;                                                       05988000
   QLDNUM := LDNUM;                                                     05990000
   IF NOT ALREADYREJECTED THEN                                 <<00189>>05992000
      BEGIN   << Haven't been here before, ask op for ring. >> <<00189>>05994000
      EXCHANGEDB (0);                                          <<00189>>05996000
      GENMSG (SET1,MESS220,%10000,QLDNUM,,,,,0); << No ring >> <<00189>>05998000
      GENMSG (SET1, MESS274, %10000, QLDNUM,,,,,0, 1,          <<00189>>06000000
        @WRITERING, QDSTN);   << Do you want one? (Y/N)     >> <<00189>>06002000
      EXCHANGEDB (QDSTN);                                      <<00189>>06004000
      END;                                                     <<00189>>06006000
   IF NOT WRITERING THEN                                                06008000
      BEGIN   << Operator said NO.                          >>          06010000
      SETSDISCERROR (SDERR40);                                 <<00494>>06012000
      ALREADYREJECTED := TRUE;   << Don't come back.        >> <<00189>>06014000
      END;                                                              06016000
   END;                                                                 06018000
END;   << of CHECK'WRITE'RING.                              >> <<03522>>06020000
$PAGE                                                          <<03522>>06022000
  PROCEDURE SDISCWRITE(BUFFER,LENGTH);                                  06024000
    VALUE LENGTH;                                                       06026000
    INTEGER LENGTH;                                                     06028000
    ARRAY BUFFER;                                                       06030000
OPTION PRIVILEGED,UNCALLABLE;                                           06032000
                                                                        06034000
COMMENT:                                                                06036000
  PHYSICALLY TRANSFER A BUFFER TO THE SERIAL DISC                       06038000
  ROUTING AROUND BAD SPOTS.                                             06040000
  ;                                                                     06042000
  BEGIN   << SDISCWRITE >>                                              06044000
                                                               <<03522>>06046000
  EQUATE                                                       <<03522>>06048000
    BLANK'TAPE = %154,   << LINUS ATTACHIO...               >> <<03522>>06050000
    NO'SPARES  = %164;   << ...failure codes.               >> <<03522>>06052000
                                                               <<03522>>06054000
  DOUBLE DERR;                                                 <<03522>>06056000
  DOUBLE DISCSTATUS;                                           <<00239>>06058000
  INTEGER DISCSTATUS0=DISCSTATUS,                              <<00239>>06060000
          DISCSTATUS1=DISCSTATUS+1;                            <<00239>>06062000
  INTEGER ERR1=DERR,SECTORLENGTH;                                       06064000
LOGICAL                                                                 06066000
  LINUS'P1'BIT0;   << Sets auto skip spr on LINUS wrt err.  >> <<03522>>06068000
                                                                        06070000
  IF LENGTH MOD WORDSPERSECTR <> 0 THEN                                 06072000
    BEGIN <<INVALID CALL TO WRITE>>                                     06074000
    SETSDISCERROR(SDERR4);                                     <<00494>>06076000
    RETURN;                                                             06078000
    END;  <<INVALID CALL TO WRITE>>                                     06080000
  IF LENGTH=0 THEN RETURN;                                              06082000
                                                               <<03522>>06084000
COMMENT                                                        <<03522>>06086000
  The cartridge tape drive (LINUS) in the 7908, 7911  or  7912 <<03522>>06088000
disc  automatically  generates spare blocks if an error is de- <<03522>>06090000
tected while writing.  Two sparing algorithms  are  available, <<03522>>06092000
selected  by the state of P1.(0:1) in the ATTACHIO write call. <<03522>>06094000
P1.(0:1) = 0 selects jump sparing, corresponding to track  re- <<03522>>06096000
assignment  in the 7920/7925, in which downstream data is pre- <<03522>>06098000
served at the cost of a non-sequential access  of  the  spared <<03522>>06100000
block.  P1.(0:1)  = 1 selects skip sparing, in which the erro- <<03522>>06102000
neous block is deleted from the address space (made invisible) <<03522>>06104000
and downstream addresses are adjusted accordingly.  This  pre- <<03522>>06106000
serves  sequential access (important on LINUS) but trashes all <<03522>>06108000
downstream data.                                               <<03522>>06110000
  Since we treat LINUS like a conventional mag tape, for which <<03522>>06112000
writing makes any existing downstream data inaccessible,  skip <<03522>>06114000
sparing  is  the  ideal  choice in this routine.  The routines <<03522>>06116000
which update the Gap Table, on the other  hand,  require  jump <<03522>>06118000
sparing,  inefficient as it is, to preserve user data if a Gap <<03522>>06120000
Table block should require sparing.                            <<03522>>06122000
  Note that P1.(0:1) is only interpreted as a jump/skip choice <<03522>>06124000
when the cartridge tape is used.  For all disc devices, all of <<03522>>06126000
P1 is used as the upper word of the double disc address, as in <<03522>>06128000
the past.                                                      <<03522>>06130000
;                                                              <<03522>>06132000
  IF LINUS                                                     <<03522>>06134000
     THEN LINUS'P1'BIT0 := %100000                             <<03522>>06136000
     ELSE LINUS'P1'BIT0 := 0;                                  <<03522>>06138000
  SECTORLENGTH:=LENGTH/WORDSPERSECTR;                                   06140000
    IF RECBUFFSA+DOUBLE(SECTORLENGTH)>EOTSECTR                 <<00494>>06142000
    THEN   << Write extends beyond EOT.                     >>          06144000
      IF RECBUFFSA+DOUBLE(SECTORLENGTH)<EODSECTR               <<00494>>06148000
      THEN                                                              06150000
        BEGIN   << It fits on the disc.                     >> <<03522>>06152000
        DERR := ATACHIO (LDNUM, QMISC', DSTN, @BUFFER, WRITE,  <<03522>>06154000
                LENGTH, LOGICAL (RITE0) LOR LINUS'P1'BIT0,     <<03522>>06156000
                RITE1, FLAGS');                                <<03522>>06158000
        IF ATIOERR THEN                                                 06160000
          BEGIN <<ATTACHIO ERROR>>                                      06162000
          SETSDISCERROR(SDERR8);                               <<00494>>06164000
          RETURN;                                                       06166000
          END;  <<ATTACHIO ERROR>>                                      06168000
        END     << It fits on the disc.                     >> <<03522>>06172000
      ELSE                                                              06176000
        BEGIN <<DISC OVERFLOW>>                                         06178000
        SETSDISCERROR(SDERR7);                                 <<00494>>06180000
        RETURN;                                                         06182000
        END   <<DISC OVERFLOW>>                                         06184000
    ELSE                                                                06188000
      BEGIN   << Doesn't extend beyond EOT.                 >>          06190000
      DERR := ATACHIO (LDNUM, QMISC', DSTN, @BUFFER, WRITE,    <<03522>>06192000
              LENGTH, LOGICAL (RITE0) LOR LINUS'P1'BIT0,       <<03522>>06194000
              RITE1, FLAGS');                                  <<03522>>06196000
      IF ATIOERR THEN                                                   06198000
        BEGIN <<ATTACHIO ERROR>>                                        06200000
        IF TYPE = CS80 THEN                                    <<03522>>06202000
           BEGIN   << No recovery, what do we report?       >> <<03522>>06204000
           IF ERR1 = NO'SPARES THEN                            <<03522>>06206000
              SETSDISCERROR (SDERR20)                          <<03522>>06208000
           ELSE IF ERR1 = BLANK'TAPE THEN                      <<03522>>06210000
              SETSDISCERROR (SDERR21)                          <<03522>>06212000
           ELSE SETSDISCERROR (SDERR29);   << Catch-all.    >> <<03522>>06214000
           RETURN;                                             <<03522>>06216000
           END;                                                <<03522>>06218000
        DISCSTATUS:=REQSTATUS(LDNUM);                          <<00239>>06220000
        IF DISCSTATUS1.(9:1)=1 THEN                            <<00239>>06222000
           BEGIN <<DISC IS READ ONLY>>                         <<00239>>06224000
           SETSDISCERROR(SDERR16);                             <<00494>>06226000
           RETURN;                                             <<00239>>06228000
           END;                                                <<00239>>06230000
        DECLAREHOLE;                                                    06232000
        IF SDERR THEN RETURN;                                           06234000
        IF (ERR'RETRY:=ERR'RETRY+1)>ERR'LIMIT THEN             <<01598>>06236000
          BEGIN  << LIMIT NO. OF DISK WRITE ERRORS >>          <<01598>>06238000
          SETSDISCERROR(SDERR33);                              <<01598>>06240000
          RETURN;                                              <<01598>>06242000
          END;                                                 <<01598>>06244000
        SDISCWRITE(BUFFER,LENGTH);                                      06246000
        RETURN;                                                         06250000
        END;  <<ATTACHIO ERROR>>                                        06252000
      END;    << Doesn't extend beyond EOT.                 >>          06254000
    RECBUFFSA:=RECBUFFSA+DOUBLE(SECTORLENGTH);                 <<00494>>06256000
    RECBUFFEA:=-1D;                                            <<00494>>06258000
    NEXTRECINBUF:=FALSE;                                                06260000
    CURRENTBUFINDEX:=0;                                                 06262000
    WORDSINRECBUF:=0;                                          <<00494>>06264000
  END;    << SDISCWRITE >>                                              06266000
$PAGE                                                          <<03522>>06268000
PROCEDURE RITESDISC;                                                    06270000
OPTION PRIVILEGED,UNCALLABLE;                                           06272000
                                                                        06274000
COMMENT:                                                                06276000
   EXECUTE A LOGICAL TRANSFER OF ONE RECORD TO THE                      06278000
   SERIAL DISC.  IF THE SERIAL DISC BUFFER IS FILLED,                   06280000
   INITIATE A PHYSICAL TRANSFER.  HANDLE ENABLE/DISABLE                 06282000
   OF THE CONTIGUOUS BLOCK FEATURE.                                     06284000
SPECIAL CONTROL CODES:                                                  06286000
   %1001-START CONTIGUOUS BLOCK                                <<00079>>06288000
   %2001-END CONTIGUOUS BLOCK                                  <<00079>>06290000
;                                                                       06292000
  BEGIN <<RITESDISC>>                                                   06294000
    INTEGER TEMP, TEMP'ADDR, RECLENGTH, COUNT, WCOUNT;         <<03522>>06296000
    LOGICAL TEMP'FUNC;                                         <<04249>>06298000
                                                               <<04249>>06300000
                                                               <<04249>>06302000
SUBROUTINE TIME'TO'WRITE'EOT;                                  <<04249>>06304000
                                                               <<04249>>06306000
BEGIN COMMENT --                                               <<04249>>06308000
  TIME'TO'WRITE'EOT calls CTRLSDISC to write the simulated EOT <<04249>>06310000
mark.  CTRLSDISC will do this only if we are  using  a  floppy <<04249>>06312000
disc.  TIME'TO'WRITE'EOT  is  separated out because it must be <<04249>>06314000
called from two locations in RITESDISC.                        <<04249>>06316000
;                                                              <<04249>>06318000
TEMP'FUNC := FUNC;                                             <<04249>>06320000
FUNC := WRITE'EOT;                                             <<04249>>06322000
CTRLSDISC;            << Sets EOT'WRITTEN.                  >> <<04249>>06324000
IF SDERR THEN RETURN;                                          <<04249>>06326000
FUNC := TEMP'FUNC;                                             <<04249>>06328000
END;                  << of TIME'TO'WRITE'EOT               >> <<04249>>06330000
                                                               <<04249>>06332000
                                                               <<03522>>06334000
  XMITLOG:=CNT;                                                <<DL003>>06336000
                                                               <<03606>>06338000
<< By convention, a write with CNT = 0  is  a  NOP,  except >> <<03606>>06340000
<< that  a  write ring check is performed for those devices >> <<03606>>06342000
<< which support it.  This causes problems for SYSDUMP  and >> <<03606>>06344000
<< its  cousins (SOFTDUMP, TPSTOMP, etc.), because they use >> <<03606>>06346000
<< zero-length writes to  close  their  contiguous  blocks. >> <<03606>>06348000
<< Ideally  these  modules would each be modified to follow >> <<03606>>06350000
<< the convention.  The actual code  makes  such  a  change >> <<03606>>06352000
<< quite difficult as well as requiring it in many modules. >> <<03606>>06354000
<< So we bend here instead, allowing only those zero-length >> <<03606>>06356000
<< writes which are to close an open contiguous block.      >> <<03606>>06358000
                                                               <<03606>>06360000
  CHECK'WRITE'RING;   << Make sure we can write.            >> <<03522>>06362000
  IF SDERR THEN RETURN;                                        <<03522>>06364000
  IF CNT = 0 AND FUNC <> ENDCONTIG AND FUNC <> PRIV'WRITE'EOD  <<03733>>06366000
     THEN RETURN;                                              <<03733>>06368000
  IF FUNC = PRIV'WRITE'EOD THEN                                <<03733>>06370000
     BEGIN                                                     <<03733>>06372000
  COMMENT -- This function makes it possible to easily recover <<03733>>06374000
a user logging file during  a  warmstart  following  a  system <<03733>>06376000
crash.  It  is  invoked  by the user logging facility when the <<03733>>06378000
file is opened, and causes an EOD mark  with  an  artificially <<03733>>06380000
large address (EOTSECTR) to be entered at the current location <<03733>>06382000
in the Gap Table, then flushed to the media.  CURRENTGPTENT is <<03733>>06384000
then backed up to point to the EOD mark so that  if  the  user <<03733>>06386000
logging  file  is closed normally, a valid EOF and EOD will be <<03733>>06388000
written and flushed.                                           <<03733>>06390000
  The strange EOD allows SDISC to read all the data which  has <<03733>>06392000
been written to the media (within 4K of all data for a disc or <<03733>>06394000
16K if LINUS.  The user logging facility can recover  the  re- <<03733>>06396000
maining data from its own buffers).  Without this function and <<03733>>06398000
its resulting EOD, EOD on the media would point to  the  start <<03733>>06400000
of the media and SDISC would not be able to read beyond it.    <<03733>>06402000
  This scam depends on the following two conditions:           <<03733>>06404000
1.  The user logging file is always one long file.  Any  EOF's <<03733>>06406000
    written  to the Gap Table before closing the file will not <<03733>>06408000
    be flushed to the media and will not survive a crash.      <<03733>>06410000
2.  SDERR 30 (non-matching  leading/trailing  record  lengths) <<03733>>06412000
    must  not  be a fatal error.  This is how user logging de- <<03733>>06414000
    tects the end of valid data during recovery.  It  must  be <<03733>>06416000
    allowed to continue using SDISC after detecting the error. <<03733>>06418000
  All of this is being arranged for  LINUS'  benefit.  A  more <<03733>>06420000
straightforward way would be to backspace/forward space record <<03733>>06422000
after each write, thus flushing both data buffer and Gap Table <<03733>>06424000
to the media.  This is fine for a true  random  access  device <<03733>>06426000
such as a disc, but would cause unacceptable performance prob- <<03733>>06428000
lems for LINUS.                                                <<03733>>06430000
;                                                              <<03733>>06432000
     GPTMOD (WRITE'EOD'AND'POST, EOTSECTR);                    <<03733>>06434000
     CURRENTGPTENT := CURRENTGPTENT - GPTENTSIZE;              <<03733>>06436000
     RETURN;                                                   <<03733>>06438000
     END;   << of writing artificial EOD.                  >>  <<03733>>06440000
  TEMP'ADDR:=ADDR;                                                      06444000
  IF TAPEREWOUND THEN                                                   06446000
     BEGIN <<SET TO START OF REEL>>                                     06448000
     GPTMOD (BRAND'NEW'TAPE);                                  <<03522>>06450000
     IF SDERR THEN RETURN;                                              06452000
     END   << Set to start of reel.                         >> <<03733>>06454000
  ELSE IF NOT TAPEWRITTEN THEN GPTMOD (CLEAR'TO'END);          <<03733>>06456000
  IF (P2.(13:1) = 0) AND (EOTSENSOR = EOTFOUND) THEN           <<03522>>06460000
     BEGIN   << Not allowed to write beyond EOT.            >> <<03522>>06462000
                                                               <<03522>>06464000
<< Flush buffer before generating error. The next statement >> <<03522>>06466000
<< gets us to a sector boundary, as required by SDISCWRITE. >> <<03522>>06468000
                                                               <<03522>>06470000
     CURRENTBUFINDEX := CURRENTBUFINDEX + (WORDSPERSECTR -     <<03522>>06472000
                        CURRENTBUFINDEX MOD WORDSPERSECTR);    <<03522>>06474000
     SDISCWRITE (RECBUFF, CURRENTBUFINDEX);                    <<03522>>06476000
     SETSDISCERROR (SDERR37);                                  <<00494>>06478000
     RETURN;                                                   <<00494>>06480000
     END;                                                      <<00494>>06482000
                                                               <<04249>>06484000
<< Write EOT mark (if required) only if user is  not  in  a >> <<04249>>06486000
<< contiguous block.  If s/he is in a contiguous block, any >> <<04249>>06488000
<< required EOT mark will be  written  when  the  block  is >> <<04249>>06490000
<< closed.                                                  >> <<04249>>06492000
                                                               <<04249>>06494000
  IF EOTSENSOR = EOTFOUND AND CONTIGSTARTSECT = -1D THEN       <<04249>>06496000
     TIME'TO'WRITE'EOT;                                        <<04249>>06498000
  IF FUNC=SETCONTIG THEN                                                06500000
    BEGIN <<OPEN CONTIGUOUS BLOCK>>                                     06502000
    IF CONTIGSTARTSECT <> -1D THEN                             <<04249>>06504000
       BEGIN   << Close this block before starting next one >> <<04249>>06506000
       FUNC := ENDCONTIG;                                      <<04249>>06508000
       COUNT := CNT;                                           <<04249>>06510000
       CNT := 0;                                               <<04249>>06512000
       RITESDISC;                                              <<04249>>06514000
       IF SDERR THEN RETURN;                                   <<04249>>06516000
       FUNC := SETCONTIG;                                      <<04249>>06518000
       CNT := COUNT;                                           <<04249>>06520000
       END;    << Close this block before starting next one >> <<04249>>06522000
    TEMP := (CURRENTBUFINDEX/WORDSPERSECTR + 1) * WORDSPERSECTR         06524000
      -CURRENTBUFINDEX;                                                 06526000
    IF 1<=TEMP<=WORDSPERSECTR-1 THEN                                    06528000
      BEGIN <<SECTOR NEEDS FILL CHARACTERS>>                            06530000
      RECBUFF(CURRENTBUFINDEX):=FILLCHAR;                               06532000
      MOVE RECBUFF(CURRENTBUFINDEX+1) :=                                06534000
        RECBUFF(CURRENTBUFINDEX), (TEMP);                               06536000
      CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP;                            06538000
      END;  <<SECTOR NEEDS FILL CHARACTERS>>                            06540000
    IF CURRENTBUFINDEX>0 THEN                                           06544000
      BEGIN <<FLUSH BUFFER BEFORE STARTING CONTIG BLOCK>>               06546000
      ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>               <<01598>>06548000
      SDISCWRITE(RECBUFF,CURRENTBUFINDEX);                              06550000
      IF SDERR THEN RETURN;                                             06552000
      END;  <<FLUSH BUFFER BEFORE STARTING CONTIG BLOCK>>               06554000
                                                               <<04249>>06556000
<< Don't enter the start of the contiguous block in the Gap >> <<04249>>06558000
<< Table here.  Save it until the  block  is  closed.  This >> <<04249>>06560000
<< prevents  having to make a hole entry in the middle of a >> <<04249>>06562000
<< contiguous block entry if a write error occurs while the >> <<04249>>06564000
<< contiguous block is open.  This type of hole entry  (one >> <<04249>>06566000
<< that  splits  the  contiguous block entry) can (and did) >> <<04249>>06568000
<< cause an error while trying to skip these entries during >> <<04249>>06570000
<< a read.  CONTIGSTARTSECT always holds the actual  start- >> <<04249>>06572000
<< ing  address of the current contiguous block, even if it >> <<04249>>06574000
<< must be relocated by SDISCTRANSFER, so we  can  use  its >> <<04249>>06576000
<< contents  to  make the beginning-of-block entry just be- >> <<04249>>06578000
<< fore the end-of-block entry, when we close the block.    >> <<04249>>06580000
                                                               <<04249>>06582000
    CONTIGSTARTSECT := CURRENTADR;                             <<00494>>06584000
    END;  <<OPEN CONTIGUOUS BLOCK>>                                     06586000
  TAPEWRITTEN:=TRUE;                                                    06588000
  RECLENGTH:=IF CNT<0 THEN -CNT ELSE  <<BYTE LENGTH>>                   06590000
    CNT & LSL(1);                                                       06592000
  COUNT:=(RECLENGTH+1)&LSR(1); <<WORD LENGTH>>                          06594000
  IF CONTIGSTARTSECT=-1D THEN                                           06596000
    RECBUFF(CURRENTBUFINDEX):=RECLENGTH <<SET REC LENGTH HEADER>>       06598000
  ELSE                                                                  06600000
    <<COMPENSATE FOR NO REC LENGTH HEADER WHEN CONTIGUOUS>>             06602000
      <<WRITE OPTION IS ON>>                                            06604000
    CURRENTBUFINDEX:=CURRENTBUFINDEX-1;                                 06606000
  IF DSTX=USERSTACK THEN                                                06608000
     BEGIN                                                              06610000
     TOS:=@DBOFFSET;                                                    06612000
     TOS:=DSTX;                                                         06614000
     TOS:=PXGLOB1;                                                      06616000
     TOS:=1; <<LENGTH>>                                                 06618000
     ASSEMBLE(MFDS 4); <<FETCH DBOFFSET IN USER'S STACK>>               06620000
     END                                                                06622000
  ELSE                                                                  06624000
     DBOFFSET:=0;                                                       06626000
FILLBUFFER:                                                             06628000
  IF RECBUFFLEN-CURRENTBUFINDEX-1>=COUNT THEN                           06630000
    BEGIN <<WHOLE RECORD WILL FIT INTO RECBUFF>>                        06632000
    TOS:=@RECBUFF(CURRENTBUFINDEX+1); <<DEST ADDR FOR MOVE>>            06634000
    TOS:=DSTX; <<SOURCE DST# FOR MOVE>>                                 06636000
    TOS:=TEMP'ADDR+DBOFFSET; <<SOURCE OFFSET FOR MOVE>>                 06638000
    TOS:=COUNT; <<LENGTH FOR MOVE>>                                     06640000
    IF DSTX=SYSBUFRDSTX THEN                                            06642000
       BEGIN                                                            06644000
       IF S0>SBUFSIZE THEN DO                                           06646000
          BEGIN                                                         06648000
          TEMP:=TOS;                                                    06650000
          TOS:=SBUFSIZE;                                                06652000
          ASSEMBLE(MFDS 2);                                             06654000
          TOS:=@TEMP'ADDR;                                              06656000
          TOS:=DSTX;                                                    06658000
          TOS:=TEMP'ADDR-1;                                             06660000
          TOS:=1;                                                       06662000
          ASSEMBLE(MFDS 4);                                             06664000
          TOS:=TEMP-SBUFSIZE;                                           06666000
          END                                                           06668000
         UNTIL S0 <= SBUFSIZE;                                          06670000
       END;                                                             06672000
    ASSEMBLE(MFDS 4); <<MOVE USER BUFFER TO RECBUFF>>                   06674000
    IF CONTIGSTARTSECT=-1D THEN                                         06676000
      RECBUFF(CURRENTBUFINDEX+COUNT+1):=RECLENGTH  <<SET>>              06678000
      <<RECORD LENGTH TRAILER>>                                         06680000
    ELSE                                                                06682000
      <<COMPENSATE FOR NO REC LENGTH TRAILER WHEN>>                     06684000
      <<CONTIGUOUS WRITE OPTION IS ON>>                                 06686000
      X:=CURRENTBUFINDEX+COUNT;                                         06688000
    CURRENTBUFINDEX:=X+1;                                               06690000
    WORDSINRECBUF:=CURRENTBUFINDEX;                            <<00494>>06692000
    IF CURRENTBUFINDEX>RECBUFFLEN THEN                                  06694000
      BEGIN <<BUFFER IS EXACTLY FULL>>                                  06696000
      ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>               <<01598>>06698000
      SDISCWRITE(RECBUFF,CURRENTBUFINDEX);                              06700000
      IF SDERR THEN RETURN;                                             06702000
      END;  <<BUFFER IS EXACTLY FULL>>                                  06704000
    IF FUNC=ENDCONTIG THEN                                              06706000
      BEGIN <<FLUSH BUFFER AT END OF CONTIG BLOCK>>                     06708000
      IF CONTIGSTARTSECT = -1D THEN                            <<03522>>06710000
         BEGIN   << Can't finish what you haven't started.  >> <<03522>>06712000
         SETSDISCERROR (SDERR9);                               <<03522>>06714000
         RETURN;                                               <<03522>>06716000
         END;                                                  <<03522>>06718000
      TEMP := (CURRENTBUFINDEX/WORDSPERSECTR+1)*WORDSPERSECTR           06720000
        - CURRENTBUFINDEX;                                              06722000
      IF 1<=TEMP<=WORDSPERSECTR-1 THEN                                  06724000
        BEGIN <<SECTOR NEEDS FILL CHARACTERS>>                          06726000
        RECBUFF(CURRENTBUFINDEX):=FILLCHAR;                             06728000
        MOVE RECBUFF(CURRENTBUFINDEX+1):=                               06730000
          RECBUFF(CURRENTBUFINDEX), (TEMP-1);                           06732000
        CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP;                          06734000
        END;  <<SECTOR NEEDS FILL CHARACTERS>>                          06736000
      ERR'RETRY := 0;   << Set error count to zero.         >> <<01598>>06738000
      SDISCWRITE(RECBUFF,CURRENTBUFINDEX);                              06740000
      IF SDERR THEN RETURN;                                             06742000
      GPTMOD (ENTER'CONTIG'BLOCK, CONTIGSTARTSECT,             <<04249>>06744000
              CURRENTADR - 1D);                                <<04249>>06746000
      IF SDERR THEN RETURN;                                             06748000
      CONTIGSTARTSECT:=-1D;                                             06750000
      IF EOTSENSOR = EOTFOUND THEN TIME'TO'WRITE'EOT;          <<04249>>06752000
      END;  <<FLUSH BUFFER AT END OF CONTIG BLOCK>>                     06754000
    CHECK'FOR'EOT;   << Set EOTSENSOR and status if req'd.  >> <<03522>>06756000
    BOT'SENSOR := BOT'NOT'FOUND;                               <<03522>>06758000
    RETURN;   << Normal exit here.                          >>          06760000
    END   <<WHOLE RECORD WILL FIT INTO RECBUFF>>                        06762000
  ELSE                                                                  06764000
    BEGIN <<ALL OF RECORD WON'T FIT IN RECBUFF>>                        06766000
    TOS:=@RECBUFF(CURRENTBUFINDEX+1); <<DEST ADDR FOR MOVE>>            06768000
    TOS:=DSTX; <<SOURCE DST# FOR MOVE>>                                 06770000
    TOS:=TEMP'ADDR+DBOFFSET; <<SOURCE OFFSET FOR MOVE>>                 06772000
    TOS:=RECBUFFLEN-CURRENTBUFINDEX; <<LENGTH OF MOVE>>                 06774000
    WCOUNT := S0;  << Save to calculate continuation length >>          06776000
    IF DSTX=SYSBUFRDSTX THEN                                            06780000
       BEGIN                                                            06782000
       IF S0>SBUFSIZE THEN DO                                           06784000
          BEGIN                                                         06786000
          TEMP:=TOS;                                                    06788000
          TOS:=SBUFSIZE;                                                06790000
          ASSEMBLE(MFDS 2);                                             06792000
          TOS:=@TEMP'ADDR;                                              06794000
          TOS:=DSTX;                                                    06796000
          TOS:=TEMP'ADDR-1;                                             06798000
          TOS:=1;                                                       06800000
          ASSEMBLE(MFDS 4);                                             06802000
          TOS:=TEMP-SBUFSIZE;                                           06804000
          END                                                           06806000
         UNTIL S0 <= SBUFSIZE;                                          06808000
       END;                                                             06810000
    ASSEMBLE(MFDS 4); <<MOVE USER BUFFER TO RECBUFF>>                   06812000
    CURRENTBUFINDEX:=RECBUFFLEN+1;                                      06814000
    END;  <<ALL OF RECORD WON'T FIT IN RECBUFF>>                        06816000
  ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>                   <<01598>>06818000
  SDISCWRITE(RECBUFF,RECBUFFLEN+1); <<WRITE FILLED BUFFER>>             06820000
  IF SDERR THEN RETURN;                                                 06822000
  COUNT:=COUNT-WCOUNT; <<SHORTEN LENGTH FOR NEXT PASS>>                 06824000
  TEMP'ADDR:=TEMP'ADDR+WCOUNT; <<ADVANCE TARGET POINTER>>               06826000
                                                                        06828000
<< Compensate for missing record length header on next part >>          06830000
                                                                        06832000
  CURRENTBUFINDEX := CURRENTBUFINDEX - 1;                               06834000
  GOTO FILLBUFFER; <<PUT NEXT PART IN RECBUFF>>                         06836000
  END;  <<RITESDISC>>                                                   06838000
$PAGE "SDISC - CONTROL CODE ROUTINES"                          <<03522>>06840000
PROCEDURE LOCK'CS80'DEVICE;                                    <<03522>>06842000
  OPTION PRIVILEGED, UNCALLABLE;                               <<03522>>06844000
                                                               <<03522>>06846000
BEGIN                                                          <<03522>>06848000
  COMMENT -- LOCK'CS80'DEVICE (alternate entry  point  UNLOCK' <<03522>>06850000
CS80'DEVICE)  is  responsible  for sending the LOCK and UNLOCK <<03522>>06852000
ATTACHIO functions to the driver. These instruct the driver to <<03522>>06854000
disallow or allow the operator to unload the device. In theory <<03522>>06856000
this mechanism can prevent devices from being  unloaded  while <<03522>>06858000
users are accessing them.                                      <<03522>>06860000
;                                                              <<03522>>06862000
ENTRY UNLOCK'CS80'DEVICE;                                      <<03522>>06864000
                                                               <<03522>>06866000
EQUATE                                                         <<03522>>06868000
  LOCK   = 16,   << ATTACHIO function codes for LOCK...     >> <<03522>>06870000
  UNLOCK = 17;   << ...and UNLOCK.                          >> <<03522>>06872000
                                                               <<03522>>06874000
DOUBLE                                                         <<03522>>06876000
  DERR;          << Receives ATTACHIO result.               >> <<03522>>06878000
                                                               <<03522>>06880000
INTEGER                                                        <<03522>>06882000
  ERR1 = DERR,                                                 <<03522>>06884000
  CS80'FUNC,     << Holds LOCK or UNLOCK function code.     >> <<03522>>06886000
  LENGTH := 0;   << Dummy, for ATACHIO call.  Must be 0.    >> <<04742>>06888000
                                                               <<03522>>06890000
LOGICAL ARRAY                                                  <<03522>>06892000
  BUFFER(*) = LENGTH;   << Dummy, for ATACHIO call.         >> <<03522>>06894000
                                                               <<03522>>06896000
CS80'FUNC := LOCK;                                             <<03522>>06898000
WHILE FALSE DO                                                 <<03522>>06900000
                                                               <<03522>>06902000
UNLOCK'CS80'DEVICE:                                            <<03522>>06904000
                                                               <<03522>>06906000
CS80'FUNC := UNLOCK;                                           <<03522>>06908000
                                                               <<03522>>06910000
IF TYPE <> CS80 THEN RETURN;                                   <<03522>>06912000
DERR := ATACHIO (LDNUM, QMISC', DSTN, @BUFFER,                 <<03680>>06914000
                 CS80'FUNC, LENGTH, READ0, READ1, FLAGS');     <<03522>>06916000
IF ATIOERR THEN SETSDISCERROR (SDERR38);                       <<03522>>06918000
END;                                                           <<03522>>06920000
$PAGE                                                          <<03522>>06922000
PROCEDURE CTRLSDISC;                                                    06924000
OPTION PRIVILEGED,UNCALLABLE;                                           06926000
                                                                        06928000
COMMENT:                                                                06930000
   PROCEDURE TO IMPLEMENT TAPE CONTROL FOR THE SERIAL DISC.             06932000
   CONTROL CODES ACCEPTED:                                              06934000
      0-Write EOT mark (internal to SDISC).                    <<04249>>06936000
      5-REWIND                                                 <<00189>>06938000
      6-WRITE EOF                                                       06940000
      7-FORWARD SPACE FILE                                              06942000
      8-BACKSPACE FILE                                                  06944000
      9-REWIND AND UNLOAD                                               06946000
      11-FORWARD SPACE RECORD                                           06948000
      12-BACKSPACE RECORD                                               06950000
      15-FETCH HARDWARE STATUS                                 <<03522>>06952000
;                                                                       06954000
BEGIN <<CTRLSDISC>>                                                     06956000
INTEGER RECLEN,                                                         06960000
        ENTRYINDEX=RECLEN,                                              06964000
        SIR,                                                            06966000
        LENGTH,                                                         06970000
        TEMP,                                                           06972000
        ENTRYTYPE,                                             <<03522>>06978000
        LASTCBI, <<LAST CURRENTBUFINDEX>>                      <<00494>>06980000
        LASTWIRB;                                              <<03522>>06982000
                                                               <<03522>>06984000
DOUBLE                                                         <<03522>>06986000
  DERR;   << Receives result of ATTACHIO.                   >> <<03522>>06988000
                                                               <<03522>>06990000
INTEGER                                                        <<03522>>06992000
  ERR1 = DERR;   << Holds ATTACHIO completion status.       >> <<03522>>06994000
                                                               <<03522>>06996000
LOGICAL                                                                 06998000
       LASTNRIB; <<LAST NEXTRECINBUF>>                                  07000000
                                                               <<03522>>07002000
DOUBLE LASTRBSA,   << Last RECBUFF starting address.        >> <<03522>>07006000
       BOFSECTOR;                                                       07008000
INTEGER BOFSECTOR0=BOFSECTOR,                                           07010000
        BOFSECTOR1=BOFSECTOR+1;                                <<03522>>07012000
                                                               <<03522>>07014000
CASE FUNC OF                                                            07018000
   BEGIN <<CASE STATEMENT>>                                             07020000
                                                               <<04249>>07022000
      BEGIN   << 0 - Write EOT mark (internal to SDISC).    >> <<04249>>07024000
                                                               <<04249>>07026000
  COMMENT -- This is an internal SDISC function, that  is,  it <<04249>>07028000
is  impossible (it says here) for a user to call this function <<04249>>07030000
directly.  It fills the current sector with -2's [the  end-of- <<04249>>07032000
tape  (EOT)  fill  character].  If  we are exactly at a sector <<04249>>07034000
boundary when called, we must fill an entire sector  with  EOT <<04249>>07036000
fill  characters.  SDISC ignores this field when reading.  The <<04249>>07038000
only known user of this feature is INITIAL, whose serial  disc <<04249>>07040000
code  calls  for a volume switch when the EOT mark is found in <<04249>>07042000
the system area (before user files).  This  currently  happens <<04249>>07044000
only when the cold-load medium is a floppy disc set. Therefore <<04249>>07046000
the EOT mark will be written only if the serial disc device is <<04249>>07048000
a floppy disc.                                                 <<04249>>07050000
;                                                              <<04249>>07052000
      IF TYPE = FLOPPY'DISC THEN                               <<04249>>07054000
         BEGIN   << We have to work.                        >> <<04249>>07056000
                                                               <<04249>>07058000
<< Fill remainder of current  sector  (TEMP+1  words)  with >> <<04249>>07060000
<< EOT'MARK and set CURRENTBUFINDEX to next sector.         >> <<04249>>07062000
                                                               <<04249>>07064000
         TEMP := (CURRENTBUFINDEX/WORDSPERSECTR + 1)           <<04249>>07066000
                 * WORDSPERSECTR - CURRENTBUFINDEX - 1;        <<04249>>07068000
         RECBUFF(CURRENTBUFINDEX) := EOT'MARK;                 <<04249>>07070000
         MOVE RECBUFF(CURRENTBUFINDEX+1) :=                    <<04249>>07072000
              RECBUFF(CURRENTBUFINDEX), (TEMP);                <<04249>>07074000
         CURRENTBUFINDEX := CURRENTBUFINDEX + TEMP + 1;        <<04249>>07076000
         WORDSINRECBUF := CURRENTBUFINDEX;                     <<04249>>07078000
         IF CURRENTBUFINDEX >= RECBUFFLEN THEN                 <<04249>>07080000
            BEGIN   << Dump full buffer to disc.            >> <<04249>>07082000
            ERR'RETRY := 0;   << For SDISCWRITE.            >> <<04249>>07084000
            SDISCWRITE (RECBUFF, RECBUFFLEN + 1);              <<04249>>07086000
            IF SDERR THEN RETURN;                              <<04249>>07088000
            END;                                               <<04249>>07090000
         GPTMOD (WRITE'EOT'MARK, CURRENTADR - 1D);             <<04249>>07092000
         IF SDERR THEN RETURN;                                 <<04249>>07094000
         CHECK'FOR'EOT;                                        <<04249>>07096000
         BOT'SENSOR := BOT'NOT'FOUND;                          <<04249>>07098000
         END;   << We have to work.                         >> <<04249>>07100000
      EOTSENSOR := EOT'WRITTEN;   << Don't come here again. >> <<04249>>07102000
      END;    << 0 - Write EOT mark (internal to SDISC).    >> <<04249>>07104000
                                                               <<04249>>07106000
      SETSDISCERROR(SDERR14); <<1>>                            <<00494>>07108000
      SETSDISCERROR(SDERR14); <<2>>                            <<00494>>07110000
      SETSDISCERROR(SDERR14); <<3>>                            <<00494>>07112000
      SETSDISCERROR(SDERR14); <<4>>                            <<00494>>07114000
                                                                        07116000
      BEGIN   << 5 - Rewind.                                >>          07118000
      GOTO NINE; <<USE REWIND CODE OF REWIND-UNLOAD>>                   07120000
      END;    << 5 - Rewind.                                >>          07122000
                                                                        07124000
      BEGIN   << 6 - Write EOF.                             >>          07126000
      CHECK'WRITE'RING;   << Make sure we can write.        >> <<03522>>07128000
      IF SDERR THEN RETURN;                                    <<03522>>07130000
      IF P2.(13:1) = 0 AND EOTSENSOR = EOTFOUND THEN           <<03522>>07132000
         BEGIN   << Can't write past EOT -- even an EOF.    >> <<03522>>07134000
         CURRENTBUFINDEX := CURRENTBUFINDEX + WORDSPERSECTR -  <<03522>>07136000
                            CURRENTBUFINDEX MOD WORDSPERSECTR; <<03522>>07138000
         SDISCWRITE (RECBUFF, CURRENTBUFINDEX);  << Flush.. >> <<03522>>07140000
         SETSDISCERROR (SDERR37);   << ..then report error. >> <<03522>>07142000
         RETURN;                                               <<03522>>07144000
         END;                                                  <<03522>>07146000
      IF TAPEREWOUND THEN                                               07152000
         BEGIN <<ASSUME VIRGIN TAPE>>                                   07154000
         GPTMOD (BRAND'NEW'TAPE);                              <<03522>>07156000
         IF SDERR THEN RETURN;                                          07158000
         END   << Assume virgin tape.                       >> <<03733>>07160000
      ELSE IF NOT TAPEWRITTEN THEN GPTMOD (CLEAR'TO'END);      <<03733>>07162000
                                                                        07164000
<< Make sure we can't read until after backspace or rewind. >>          07166000
                                                                        07168000
      TAPEWRITTEN := TRUE;                                     <<03522>>07170000
      IF CONTIGSTARTSECT <> -1D THEN                           <<03522>>07172000
         BEGIN                                                 <<03522>>07174000
                                                               <<03522>>07176000
<< An open contiguous block.  We must close it and flush it >> <<03522>>07178000
<< to the disc before generating the EOF.                   >> <<03522>>07180000
                                                               <<03522>>07182000
         CNT := 0;                                             <<04249>>07184000
         FUNC := ENDCONTIG;                                    <<04249>>07186000
         RITESDISC;                                            <<04249>>07188000
         IF SDERR THEN RETURN;                                 <<04249>>07190000
         FUNC := WRITE'EOF;                                    <<04249>>07192000
         END;   << An open contiguous block.                >> <<03522>>07196000
      IF EOTSENSOR = EOTFOUND THEN                             <<04249>>07198000
         BEGIN   << Write EOT mark before writing EOF.      >> <<04249>>07200000
         FUNC := WRITE'EOT;                                    <<04249>>07202000
         CTRLSDISC;                                            <<04249>>07204000
         IF SDERR THEN RETURN;                                 <<04249>>07206000
         FUNC := WRITE'EOF;                                    <<04249>>07208000
         END;                                                  <<04249>>07210000
                                                               <<03522>>07212000
<< Fill remainder of current  sector  (TEMP+1  words)  with >> <<03522>>07214000
<< EOF'MARK and set CURRENTBUFINDEX to next sector.         >> <<03522>>07216000
                                                               <<03522>>07218000
                                                               <<03522>>07220000
      TEMP := (CURRENTBUFINDEX/WORDSPERSECTR+1)*WORDSPERSECTR-          07222000
        CURRENTBUFINDEX - 1;                                            07224000
      RECBUFF(CURRENTBUFINDEX) := EOF'MARK;                    <<03522>>07226000
      MOVE RECBUFF(CURRENTBUFINDEX+1):=                                 07228000
        RECBUFF(CURRENTBUFINDEX), (TEMP);                               07230000
      CURRENTBUFINDEX:=CURRENTBUFINDEX+TEMP+1;                          07232000
      WORDSINRECBUF := CURRENTBUFINDEX;                        <<00494>>07234000
      IF CURRENTBUFINDEX>=RECBUFFLEN THEN                               07236000
        BEGIN <<OUTPUT FULL BUFFER>>                                    07238000
        ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>             <<01598>>07240000
        SDISCWRITE(RECBUFF,RECBUFFLEN+1);                               07242000
        IF SDERR THEN RETURN;                                           07244000
        END;  <<OUTPUT FULL BUFFER>>                                    07246000
      GPTMOD (WRITE'EOF'MARK, CURRENTADR - 1D);                <<03522>>07248000
      IF SDERR THEN RETURN;                                    <<03522>>07250000
      CHECK'FOR'EOT;   << Set EOTSENSOR and status if req'd >> <<03522>>07252000
      BOT'SENSOR := BOT'NOT'FOUND;                             <<03522>>07254000
      END;    << 6 - Write EOF.                             >>          07258000
                                                                        07260000
      BEGIN   << 7 - Forward Space File.                    >>          07262000
      IF TAPEWRITTEN THEN                                      <<03522>>07264000
         BEGIN   << Attempt to space beyond end of data.    >> <<03522>>07266000
         SETSDISCERROR (SDERR22);                              <<03522>>07268000
         RETURN;                                               <<03522>>07270000
         END;                                                  <<03522>>07272000
      DO                                                                07274000
         BEGIN <<SCAN GPT LOOKING FOR EOFMARK>>                         07276000
         SDISCFINDGAP (ACTUAL'ADDRESS, EODSECTR);              <<03522>>07278000
         RECBUFFSA:=ENDGAP+1D;                                 <<00494>>07282000
         END   <<SCAN GPT LOOKING FOR EOFMARK>>                         07288000
        UNTIL GAPTYPE = EOFTYPE OR GAPTYPE = EODTYPE OR        <<03522>>07290000
          STARTGAP = -1D;                                      <<03522>>07292000
      IF GAPTYPE <> EOFTYPE THEN                               <<03522>>07294000
         BEGIN   << Runaway condition.                      >>          07296000
         SETSDISCERROR(SDERR27);                               <<00494>>07298000
         RETURN;                                                        07300000
         END;                                                           07302000
      RECBUFFEA := -1D;                                        <<03522>>07304000
      CURRENTBUFINDEX := 0;                                    <<03522>>07306000
      NEXTRECINBUF := TAPEREWOUND := FALSE;                    <<03733>>07308000
      ENDINDEX := ENDINDEX + GPTENTSIZE;                       <<03522>>07310000
      GPTMOD (UPDT'FOR'READ'OP);                               <<03522>>07312000
      IF SDERR THEN RETURN;                                    <<00189>>07314000
      EOFCODE := HARDWARE'EOF;                                 <<03522>>07316000
      CHECK'FOR'EOT;   << Set EOTSENSOR if required.        >> <<03522>>07318000
      BOT'SENSOR := BOT'NOT'FOUND;                             <<03522>>07320000
      END;    << 7 - Forward Space File.                    >>          07322000
                                                                        07324000
      BEGIN   << 8 - Backspace File.                        >>          07326000
      IF TAPEWRITTEN THEN                                               07328000
                                                               <<03522>>07330000
<< If you have just written data and  now  try  backspacing >> <<03522>>07332000
<< without writing an EOF, the File System does it for you. >> <<03522>>07334000
<< Thus there is no danger of having an  incomplete  sector >> <<03522>>07336000
<< flushed to disc here.                                    >> <<03522>>07338000
                                                               <<03522>>07340000
        BEGIN <<FLUSH BUFFER TO DISC>>                                  07342000
        LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                      07344000
          WORDSPERSECTR * WORDSPERSECTR;                                07346000
        ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>             <<01598>>07348000
        SDISCWRITE(RECBUFF,LENGTH);                                     07350000
        IF SDERR THEN RETURN;                                           07352000
        GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);                <<03522>>07354000
        IF SDERR THEN RETURN;                                           07356000
        TAPEWRITTEN := FALSE;                                  <<03522>>07358000
        END;  <<FLUSH BUFFER TO DISC>>                                  07360000
      IF BOT'SENSOR = BOT'FOUND THEN                           <<03522>>07364000
         BEGIN  << Trying to backspace while at load point. >>          07366000
         SETSDISCERROR (-SDERR24);   << Non-fatal error.    >> <<03640>>07368000
         RETURN;                                                        07370000
         END;                                                           07372000
      ENTRYINDEX := CURRENTGPTENT;                             <<03522>>07374000
      WHILE ENTRYINDEX > GPT'START AND EOFCODE = NO'EOF DO     <<03522>>07376000
         BEGIN   << Scan GPT backwards looking for EOF.     >>          07378000
         ENTRYINDEX := ENTRYINDEX - GPTENTSIZE;                         07380000
         ENTRYTYPE := GPT(ENTRYINDEX).GPT'TYPE'FIELD;          <<00189>>07382000
         IF ENTRYTYPE = EOFTYPE THEN                                    07384000
         BEGIN                                                          07386000
            BOFSECTOR0 := GPT(ENTRYINDEX).GPT'ADR'FIELD;       <<00189>>07388000
            BOFSECTOR1 := GPT (X := X+1);                      <<03522>>07390000
            EOFCODE := HARDWARE'EOF;                           <<03522>>07392000
            END;                                               <<03522>>07394000
         END;   << Scan GPT backwards looking for EOF.      >> <<03522>>07396000
      IF EOFCODE = NO'EOF THEN                                 <<03522>>07398000
         BEGIN   << Backspaced all the way to load point.   >> <<03522>>07400000
         BOFSECTOR := DOUBLE (STARTADDRESS);                   <<03522>>07402000
         BOT'SENSOR := BOT'FOUND;                              <<03522>>07404000
         END;                                                  <<03522>>07406000
      ENDINDEX := ENTRYINDEX;                                  <<03522>>07408000
      GPTMOD (UPDT'FOR'READ'OP);                               <<03522>>07410000
      IF SDERR THEN RETURN;                                    <<00189>>07412000
      RECBUFFSA:=BOFSECTOR;                                    <<00494>>07418000
      RECBUFFEA:=-1D;                                                   07420000
      NEXTRECINBUF:=FALSE;                                     <<00494>>07422000
      READBLOCK; <<SETS CURRENTBUFINDEX=0>>                    <<00298>>07426000
      IF EOFCODE = HARDWARE'EOF THEN                           <<03522>>07428000
         BEGIN   << Stopped backspacing before we hit BOT.  >> <<03522>>07430000
         CURRENTBUFINDEX := WORDSPERSECTR - 1;                 <<03522>>07432000
         WHILE RECBUFF(CURRENTBUFINDEX) = EOF'MARK             <<03522>>07434000
           AND CURRENTBUFINDEX >=0 DO     << Backspace over >> <<03522>>07436000
           CURRENTBUFINDEX := CURRENTBUFINDEX - 1;   << EOF >> <<03522>>07438000
         CURRENTBUFINDEX := CURRENTBUFINDEX + 1;               <<03522>>07440000
         END;    << Stopped backspacing before we hit BOT.  >> <<03522>>07442000
      CHECK'FOR'EOT;   << Reset EOTSENSOR if we're in front >> <<03522>>07444000
      END;    << 8 - Backspace File.                        >>          07448000
                                                                        07450000
      BEGIN   << 9 - Rewind and Unload.                     >>          07452000
NINE:                                                                   07454000
      IF NOT TAPEREWOUND THEN                                           07456000
        BEGIN <<TAPE NEEDS REWINDING>>                                  07458000
        IF TAPEWRITTEN THEN                                             07460000
          BEGIN <<WRITE EOF AND FLUSH BUFFER TO DISC>>         <<00189>>07462000
          LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                    07464000
            WORDSPERSECTR * WORDSPERSECTR;                              07466000
          ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>           <<01598>>07468000
          SDISCWRITE(RECBUFF,LENGTH);                                   07470000
          IF SDERR THEN RETURN;                                         07472000
          GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);              <<03522>>07474000
          IF SDERR THEN RETURN;                                         07476000
          END; <<FLUSH BUFFER TO DISC>>                                 07478000
        CURRENTGPTENT:=GPT'START;                                       07480000
        END;  <<TAPE NEEDS REWINDING>>                                  07482000
      TAPEREWOUND:=TRUE;                                                07484000
      TAPEWRITTEN:=FALSE;                                               07486000
      NEXTRECINBUF:=FALSE;                                              07488000
      BOT'SENSOR := BOT'FOUND;                                 <<03522>>07490000
      EOTSENSOR := EOTNOTFOUND;                                <<03522>>07492000
      RECBUFFSA:=DOUBLE(STARTADDRESS);                         <<00494>>07494000
      RECBUFFEA:=-1D;                                                   07496000
      CURRENTBUFINDEX:=0;                                               07498000
      IF FUNC = REW'UNLOAD AND (LOGICAL (LOADED)) THEN         <<03522>>07500000
         BEGIN <<UNLOAD DEVICE>>                                        07502000
         UNLOCK'CS80'DEVICE;                                   <<03522>>07504000
         IF SDERR THEN RETURN;                                 <<03522>>07506000
         IF LINUS THEN                                         <<03522>>07508000
            BEGIN   << Physical I/O required.               >> <<03522>>07510000
            DERR := ATACHIO (LDNUM, QMISC', DSTX, ADDR,        <<03522>>07512000
                    UNLOAD, CNT, P1, P2, FLAGS');              <<03522>>07514000
            IF ATIOERR THEN                                    <<03522>>07516000
               BEGIN                                           <<03522>>07518000
               SETSDISCERROR (SDERR38);                        <<03522>>07520000
               RETURN;                                         <<03522>>07522000
               END;                                            <<03522>>07524000
            END;   << Physical I/O required.                >> <<03522>>07526000
         SIR:=GETSIR(LPDTSIR);                                          07528000
         LOADED:=0; <<DISC AVAILABLE FOR OTHER USE>>           <<01115>>07530000
         RELSIR(LPDTSIR,SIR);                                           07532000
         JUSTALLOCATED:=TRUE;                                           07534000
         END;  <<UNLOAD DEVICE>>                                        07538000
      END;    << 9 - Rewind and Unload.                     >>          07540000
                                                                        07542000
      SETSDISCERROR (SDERR14);  << 10 - GAP not supported.  >>          07544000
                                                                        07546000
      BEGIN   << 11 - Forward Space Record.                 >>          07548000
      NULLTRANSFER:=TRUE;                                               07550000
      READSDISC;                                                        07552000
      IF SDERR THEN RETURN;                                    <<00494>>07554000
      NULLTRANSFER:=FALSE;                                              07556000
      END;    << 11 - Forward Space Record.                 >>          07558000
                                                                        07560000
      BEGIN   << 12 - Backspace Record.                     >>          07562000
      IF TAPEWRITTEN THEN                                      <<00494>>07564000
        BEGIN   << Write EOD and flush Gap Table to disc.   >> <<00494>>07566000
                                                               <<03522>>07568000
<< If you have just written data and  now  try  backspacing >> <<03522>>07570000
<< without writing an EOF, the File System does it for you. >> <<03522>>07572000
<< Thus there is no danger of having an  incomplete  sector >> <<03522>>07574000
<< flushed to disc here.                                    >> <<03522>>07576000
                                                               <<03522>>07578000
        LENGTH:=(CURRENTBUFINDEX+WORDSPERSECTR-1)/                      07582000
          WORDSPERSECTR * WORDSPERSECTR;                                07584000
        LASTCBI:=CURRENTBUFINDEX;                                       07586000
        LASTWIRB:=WORDSINRECBUF;                                        07588000
        LASTNRIB:=NEXTRECINBUF;                                         07590000
        LASTRBSA:=RECBUFFSA;                                            07592000
        ERR'RETRY := 0;  << SET ERR CNT TO ZERO >>             <<01598>>07594000
        SDISCWRITE(RECBUFF,LENGTH);                                     07596000
        IF SDERR THEN RETURN;                                           07598000
        GPTMOD (WRITE'EOD'AND'POST, RECBUFFSA);                <<03522>>07600000
        IF SDERR THEN RETURN;                                  <<03522>>07602000
        CURRENTBUFINDEX:=LASTCBI;                                       07604000
        WORDSINRECBUF:=LASTWIRB;                                        07606000
        NEXTRECINBUF:=LASTNRIB;                                         07608000
        RECBUFFSA:=LASTRBSA;                                            07610000
        CURRENTGPTENT:=CURRENTGPTENT-GPTENTSIZE;               <<00494>>07612000
        TAPEWRITTEN := FALSE;                                  <<03522>>07614000
        END;    << Write EOD and flush Gap Table to disc.   >> <<00494>>07616000
      IF BOT'SENSOR = BOT'FOUND THEN                           <<03522>>07618000
         BEGIN   << Can't backspace if already at BOT.      >> <<03522>>07620000
         SETSDISCERROR (-SDERR25);   << Non-fatal error.    >> <<03640>>07622000
         RETURN;                                               <<03522>>07624000
         END;                                                  <<03522>>07626000
      IF CURRENTBUFINDEX>0 THEN                                         07628000
         BEGIN <<RECLEN OF LAST REC IS IN BUFF>>                        07630000
         RECLEN:=RECBUFF(CURRENTBUFINDEX-1);                            07632000
         IF RECLEN <= EOF'MARK THEN                            <<03522>>07634000
            BEGIN                                                       07636000
                                                                        07638000
<< Found EOT (-2), contiguous block fill (-1) or  EOF  (0). >> <<03522>>07640000
<< In addition to backspacing over the obstruction, we must >> <<03522>>07642000
<< account for the Gap Table entrie(s) associated with  it. >> <<03522>>07644000
<< That's  easy  for  EOF or EOT (except that we have to be >> <<03522>>07646000
<< careful to space over only one EOF if more than one  ex- >> <<03522>>07648000
<< ists -- that was an earlier bug fixed this time).  But a >> <<03522>>07650000
<< contiguous block or hole takes up at least  two  entries >> <<03522>>07652000
<< and maybe more (if there was a DECLAREHOLE while writing >> <<03522>>07654000
<< a contiguous block, for example). To synchronize our Gap >> <<03522>>07656000
<< Table properly requires a few more smarts.               >> <<03522>>07658000
                                                                        07660000
            LASTCBI := CURRENTBUFINDEX - WORDSPERSECTR;        <<03522>>07662000
            DO CURRENTBUFINDEX := CURRENTBUFINDEX - 1                   07664000
              UNTIL CURRENTBUFINDEX < 0 OR                              07666000
              INTEGER (RECBUFF(CURRENTBUFINDEX)) > 0;          <<03522>>07668000
            CURRENTBUFINDEX:=CURRENTBUFINDEX+1;                         07670000
            CURRENTGPTENT:=CURRENTGPTENT-GPTENTSIZE;                    07672000
            IF RECLEN = EOF'MARK                               <<03522>>07674000
              THEN                                             <<03522>>07676000
               BEGIN   << EOF found.                        >> <<03522>>07678000
               NEXTRECINBUF := TRUE;                           <<03522>>07680000
               IF CURRENTBUFINDEX < LASTCBI THEN               <<03522>>07682000
                  CURRENTBUFINDEX := LASTCBI; << 1 EOF only >> <<03522>>07684000
                  EOFCODE := HARDWARE'EOF;                     <<03522>>07686000
               END                                             <<03522>>07688000
              ELSE                                             <<03522>>07690000
               BEGIN   << EOT or contiguous block.          >> <<03522>>07692000
               IF RECLEN = FILLCHAR THEN                       <<03522>>07694000
                  BEGIN   << Must search for start of entry >> <<03522>>07696000
                  TEMP := GPT (CURRENTGPTENT).GPT'TYPE'FIELD;  <<03522>>07698000
                  DO CURRENTGPTENT := CURRENTGPTENT -          <<03522>>07700000
                                      GPTENTSIZE               <<03522>>07702000
                     UNTIL GPT (CURRENTGPTENT).GPT'TYPE'FIELD  <<03522>>07704000
                           = LOGICAL (TEMP - 1)                <<03522>>07706000
                           OR CURRENTGPTENT <= GPT'START;      <<03522>>07708000
                  IF GPT (CURRENTGPTENT).GPT'TYPE'FIELD <>     <<03522>>07710000
                    LOGICAL (TEMP - 1) THEN                    <<03522>>07712000
                     BEGIN   << Couldn't find beg of entry. >> <<03522>>07714000
                     SETSDISCERROR (SDERR17);                  <<03522>>07716000
                     RETURN;                                   <<03522>>07718000
                     END;                                      <<03522>>07720000
                  END;   << RECLEN = FILLCHAR               >> <<03522>>07722000
               CTRLSDISC;   << Ignore EOT, contig block.    >> <<03522>>07724000
               END;    << EOT or contiguous block.          >> <<03522>>07726000
            CHECK'FOR'EOT;   << Reset EOT if we're in front >> <<03522>>07728000
            RETURN;                                                     07730000
            END;                                                        07732000
         IF (RECLEN+1)&LSR(1)<=CURRENTBUFINDEX-2 THEN                   07734000
            BEGIN <<ENTIRE LAST REC IS IN BUFF>>                        07736000
            CURRENTBUFINDEX := CURRENTBUFINDEX                          07738000
              - (RECLEN+1)&LSR(1) - 2;                                  07740000
            END   <<ENTIRE LAST REC IS IN BUFF>>                        07742000
         ELSE                                                           07744000
            BEGIN <<LEADING RECLEN OF LAST REC IS IN>>                  07746000
                  <<LAST BLOCK>>                                        07748000
            LASTCBI:=CURRENTBUFINDEX;                          <<00494>>07750000
            BACKBLOCKREAD;                                              07752000
            IF SDERR THEN RETURN;                                       07754000
                                                               <<03522>>07756000
<< If BACKBLOCKREAD ran into the load  point,  our  LASTCBI >> <<03522>>07758000
<< may  be  in the middle of the block currently in RECBUFF >> <<03522>>07760000
<< instead of just beyond the end.  The correction term (in >> <<03522>>07762000
<< BOT'SECTOR'COUNT) is used to place CURRENTBUFINDEX  pro- >> <<03522>>07764000
<< perly.  The parentheses assure no local integer overflow >> <<03522>>07766000
<< if LASTCBI + RECBUFFLEN + 1 should be > 32767.           >> <<03522>>07768000
                                                               <<03522>>07770000
            CURRENTBUFINDEX := LASTCBI - (RECLEN+1)&LSR(1) - 1 <<00494>>07772000
              + RECBUFFLEN - BOT'SECTOR'COUNT*WORDSPERSECTR;   <<03522>>07774000
            IF CURRENTBUFINDEX<0 THEN                          <<00494>>07778000
                                                               <<03522>>07780000
<< Record is larger than RECBUFF.  Keep going until we find >> <<03522>>07782000
<< the beginning.                                           >> <<03522>>07784000
                                                               <<03522>>07786000
              DO                                               <<00494>>07788000
                BEGIN                                          <<00494>>07790000
                LASTCBI:=CURRENTBUFINDEX;                      <<00494>>07792000
                BACKBLOCKREAD;                                 <<00494>>07794000
                CURRENTBUFINDEX := LASTCBI + (RECBUFFLEN + 1   <<03522>>07796000
                  - BOT'SECTOR'COUNT*WORDSPERSECTR);           <<03522>>07798000
                END                                            <<00494>>07800000
              UNTIL CURRENTBUFINDEX>=0;                        <<00494>>07802000
            END;  <<LEADING RECLEN OF LAST REC IS IN>>                  07804000
                  <<LAST BLOCK>>                                        07806000
         END   <<RECLEN OF LAST REC IS IN BUFF>>                        07808000
      ELSE                                                              07810000
         BEGIN <<TRAILING RECLEN OF LAST REC IS IN>>                    07812000
               <<LAST BLOCK>>                                           07814000
         IF CURRENTBUFINDEX<>0 THEN                                     07816000
            BEGIN                                                       07818000
            SETSDISCERROR(SDERR23);                            <<00494>>07820000
            RETURN;                                                     07822000
            END                                                         07824000
         ELSE                                                           07826000
            BEGIN <<CAN BE RETRIEVED FROM LAST BLOCK>>                  07828000
            BACKBLOCKREAD;                                              07830000
            IF SDERR THEN RETURN;                                       07832000
            IF BOT'SENSOR = BOT'NOT'FOUND THEN                 <<03522>>07834000
               BEGIN   << Didn't back into Load Point.      >> <<03522>>07836000
               CURRENTBUFINDEX := RECBUFFLEN + 1               <<03522>>07838000
                 - BOT'SECTOR'COUNT*WORDSPERSECTR;             <<03522>>07840000
               CTRLSDISC;                                      <<00494>>07842000
               END;                                            <<03522>>07844000
            RETURN;                                                     07846000
            END;  <<CAN BE RETRIEVED FROM LAST BLOCK>>                  07848000
         END;  <<TRAILING RECLEN OF LAST REC IS IN>>                    07850000
               <<LAST BLOCK>>                                           07852000
      NEXTRECINBUF:=TRUE;                                      <<00494>>07854000
      CHECK'FOR'EOT;   << Reset EOT if we're in front.      >> <<03522>>07856000
      END;    << 12 - Backspace Record.                     >>          07858000
                                                                        07860000
      SETSDISCERROR(SDERR14);  <<13 - INVALID FUNCTION>>       <<01958>>07862000
                                                                        07864000
      SETSDISCERROR(SDERR14);  <<14 - INVALID FUNCTION>>       <<01958>>07866000
                                                                        07868000
      BEGIN   << 15 - Fetch hardware status.                >>          07870000
      ATACHIO (LDNUM, QMISC', DSTX, ADDR, FUNC, CNT, P1, P2,   <<03522>>07872000
               FLAGS');                                        <<03522>>07874000
      END;    << 15 - Fetch hardware status.                >>          07876000
   END;  <<CASE STATEMENT>>                                             07878000
END;  <<CTRLSDISC>>                                                     07880000
$PAGE "SDISC - SERIAL DISC INTERFACE TO ATTACHIO AND USER"              07884000
INTEGER PROCEDURE FINDSDISCGAP(LDNUM,BLOCK,ADR,LEN);                    07886000
VALUE LDNUM,BLOCK;                                                      07888000
INTEGER LDNUM,BLOCK;                                                    07890000
DOUBLE ADR,LEN;                                                         07892000
OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                                  07894000
                                                                        07896000
BEGIN <<FINDSDISCGAP>>                                                  07898000
EQUATE CPCB=4; <<CURRENT PCB POINTER IN LOW CORE>>                      07900000
DEFINE ADB=(0:1)#; <<ABSOLUTE DB BIT OF PCB2>>                          07902000
EQUATE PCB2=2; <<THIRD WORD OF PCB>>                                    07904000
DEFINE ABS=ABSOLUTE#;                                                   07906000
DEFINE DB'IS'ABSOLUTE=ABS(ABS(CPCB)+PCB2).ADB=1#;                       07908000
INTEGER ERRCODE=FINDSDISCGAP;                                           07912000
INTEGER QDSTN;                                                          07914000
INTEGER QUSERDST;                                                       07916000
DOUBLE QSTARTBLOCK,QBLOCKLENGTH;                                        07918000
LOGICAL ABS'DB := FALSE;                                       <<03558>>07920000
DEFINE DB'WAS'ABSOLUTE=ABS'DB = TRUE#;                         <<03558>>07922000
INTEGER POINTER LDTXENT;                                                07926000
                                                                        07930000
LOGICAL PARMS=Q-4;                                                      07932000
DOUBLE QLEN,QADR;                                                       07934000
                                                                        07936000
IF PARMS.(15:1)=1 THEN                                                  07938000
   QLEN:=LEN;                                                           07940000
IF PARMS.(14:1)=1 THEN                                                  07942000
   QADR:=ADR;                                                           07944000
IF DB'IS'ABSOLUTE THEN                                                  07946000
   BEGIN                                                       <<03558>>07948000
                                                               <<03558>>07950000
COMMENT -- DB is at SYSGLOB (%1000), remember this in  ABS'DB. <<03558>>07952000
Since DB is not at a stack or data segment, if we try to do an <<03558>>07954000
EXCHANGEDB to our data segment, the system will  crash.  Isn't <<03558>>07956000
that (interesting, unfriendly, pathetic) (pick any three). The <<03558>>07958000
RESETDB call below does nothing except put DB at some stack or <<03558>>07960000
data segment (we don't know or care which one,  but  it's  the <<03558>>07962000
one  the  system  was  at before DB was set to SYSGLOB).  Then <<03558>>07964000
we are free to EXCHANGEDB to our heart's content.              <<03558>>07966000
;                                                              <<03558>>07968000
   ABS'DB := TRUE;                                             <<03558>>07970000
   RESETDB (-1);                                               <<03558>>07972000
   END;                                                        <<03558>>07974000
QUSERDST:=EXCHANGEDB(LDTDSTN);                                          07976000
@LDTXENT:=DVCLTABB+DVCLTABS+LDNUM*LDTXSIZE;                             07978000
QDSTN:=LDTXENT(LDTX1);                                                  07980000
IF QDSTN>0 THEN                                                         07982000
   EXCHANGEDB(QDSTN)                                                    07984000
ELSE                                                                    07986000
   BEGIN <<INVALID DST#>>                                               07988000
   FINDSDISCGAP:=SDERR35;                                               07990000
   GOTO RETURNN;                                                        07992000
   END;  <<INVALID DST#>>                                               07994000
IF JUSTALLOCATED THEN                                                   07996000
   BEGIN <<CAN'T CALL UNTIL OPENED>>                                    07998000
   FINDSDISCGAP:=SDERR10;                                               08000000
   GOTO RETURNN;                                                        08002000
   END;                                                                 08004000
ERRORCODE:=SDERR0;                                                      08006000
IF TAPELOADED = 0 THEN EOTSENSOR := EOTNOTFOUND;               <<03522>>08008000
IF PARMS.(14:1)=0 THEN                                                  08014000
   BEGIN <<REQUIRED PARAMETER>>                                         08016000
   FINDSDISCGAP:=SDERR43;                                               08018000
   GOTO RETURNN;                                                        08020000
   END;  <<REQUIRED PARAMETER>>                                         08022000
IF BLOCK <= 0 THEN                                             <<03522>>08024000
   BEGIN   << Illegal parameter, must be positive.          >> <<03522>>08026000
   FINDSDISCGAP := SDERR11;                                    <<03522>>08028000
   GO TO RETURNN;                                              <<03522>>08030000
   END;                                                        <<03522>>08032000
IF PARMS.(15:1)=1 THEN                                                  08034000
   GPTMOD (-BLOCK, QADR, QLEN)   << Find BLOCKth...         >>          08036000
ELSE                                                                    08038000
   GPTMOD (-BLOCK, QADR);        << ...contiguous block.    >>          08040000
FINDSDISCGAP:=ERRORCODE;                                                08042000
QSTARTBLOCK:=STARTBLOCK;                                                08044000
QBLOCKLENGTH:=BLOCKLENGTH;                                              08046000
RETURNN:                                                                08048000
EXCHANGEDB(QUSERDST);                                                   08050000
IF ERRCODE=0 THEN                                                       08052000
   BEGIN <<RETURN VALUES>>                                              08054000
   ADR:=QSTARTBLOCK;                                                    08056000
   IF PARMS.(15:1)=1 THEN                                               08058000
      LEN:=QBLOCKLENGTH;                                                08060000
   END;  <<RETURN VALUES>>                                              08062000
IF ERRCODE>0 THEN                                                       08064000
   BEGIN                                                                08066000
   IF QUSERDST<>0 THEN EXCHANGEDB(0);                                   08068000
   GENMSG(SET19,ERRCODE,%10000,LDNUM);                                  08070000
   IF QUSERDST<>0 THEN EXCHANGEDB(QUSERDST);                            08072000
   END;                                                                 08074000
IF DB'WAS'ABSOLUTE THEN                                                 08076000
   SETSYSDB;   << Leave DB at SYSGLOB if there at entry.       <<03558>>08078000
END;  <<FINDSDISCGAP>>                                                  08082000
$PAGE                                                          <<03522>>08084000
DOUBLE PROCEDURE SDISCIO(LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,                08086000
                         P1,P2,FLAGS);                                  08088000
VALUE LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                       08090000
INTEGER LDNUM,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     08092000
OPTION PRIVILEGED,UNCALLABLE;                                           08094000
                                                                        08096000
BEGIN <<SDISCIO>>                                                       08098000
INTEGER POINTER LDTXENT; <<LDTX ENTRY FOR THIS LDNUM>>                  08100000
INTEGER QDSTN,QERRORCODE;                                               08104000
EQUATE CPCB=4; <<CURRENT PCB POINTER IN LOW CORE>>                      08106000
DEFINE ADB=(0:1)#; <<ABSOLUTE DB BIT OF PCB2>>                          08108000
EQUATE PCB2=2; <<THIRD WORD OF PCB>>                                    08110000
EQUATE PCB3=3; <<FOURTH WORD OF PCB>>                                   08112000
DEFINE ABS=ABSOLUTE#;                                                   08114000
DEFINE DB'IS'ABSOLUTE=ABS(ABS(CPCB)+PCB2).ADB=1#;                       08116000
DEFINE DSTFIELD=(1:10)#,                                                08120000
       SYSBUFRS=(12:1)#;                                                08122000
                                                               <<03522>>08126000
INTEGER QUSERDST,QUSERSTACK;                                            08128000
LOGICAL ABS'DB := FALSE;                                       <<03558>>08130000
DEFINE DB'WAS'ABSOLUTE=ABS'DB = TRUE#;                         <<03558>>08132000
INTEGER RETVAL0=SDISCIO, <<WORD0 OF RETURN VALUE>>                      08136000
        RETVAL1=SDISCIO+1;<<WORD1 OF RETURN VALUE>>                     08138000
INTEGER ARRAY ERRORS(0:49)=PB:=<<ATTACHIO ERRORCODES FOR SDISC>>        08144000
         %1,%124,  %0,%124,%124, %31, %10, %10, %10,%124,      <<00239>>08146000
         %0, %74, %74, %74,  %4, %74,%124,  %0,  %0,%124,               08148000
       %164,%154,%103,%124, %73, %73, %73,%103,  %0,  %0,      <<03522>>08150000
       %124,%124, %74,%124,%124,%124, %30,%113,%124,  %4,      <<03522>>08152000
       %123,%124,%124,  %0,  %0,  %0,  %0,  %0,  %0,  %0;      <<00137>>08154000
                               <<ERRORS>>                               08156000
<<** NOTE ** : DB ANYWHERE ON ENTRY; SAME ON RETURN>>                   08158000
QERRORCODE:=SDERR0; <<INITIALLY-ALL OKAY>>                              08160000
IF DB'IS'ABSOLUTE THEN                                                  08162000
   BEGIN                                                       <<03558>>08164000
                                                               <<03558>>08166000
COMMENT -- DB is at SYSGLOB (%1000), remember this in  ABS'DB. <<03558>>08168000
Since DB is not at a stack or data segment, if we try to do an <<03558>>08170000
EXCHANGEDB to our data segment, the system will  crash.  Isn't <<03558>>08172000
that (interesting, unfriendly, pathetic) (pick any three). The <<03558>>08174000
RESETDB call below does nothing except put DB at some stack or <<03558>>08176000
data segment (we don't know or care which one,  but  it's  the <<03558>>08178000
one  the  system  was  at before DB was set to SYSGLOB).  Then <<03558>>08180000
we are free to EXCHANGEDB to our heart's content.              <<03558>>08182000
;                                                              <<03558>>08184000
   ABS'DB := TRUE;                                             <<03558>>08186000
   RESETDB (-1);                                               <<03558>>08188000
   END;                                                        <<03558>>08190000
QUSERSTACK:=ABS(ABS(CPCB)+PCB3).DSTFIELD;                               08192000
QUSERDST:=EXCHANGEDB(LDTDSTN);                                          08194000
@LDTXENT:=DVCLTABB+DVCLTABS+LDNUM*LDTXSIZE;                             08196000
QDSTN:=LDTXENT(LDTX1); <<SERIAL DISC DSTN>>                             08198000
IF QDSTN>0 THEN                                                         08200000
   EXCHANGEDB (QDSTN)                                                   08202000
ELSE                                                                    08204000
   QERRORCODE := SDERR35;                                      <<03640>>08206000
IF QERRORCODE=0 AND NOT FATALERROR                             <<03733>>08210000
  OR FUNC = CLOSE'DEVC THEN  << Unlck/unld CS80 if FATALERR >> <<03733>>08212000
   BEGIN <<MOVE PARMS AND EXECUTE>>                                     08214000
   DSTN:=QDSTN;                                                         08216000
   ERRORCODE:=SDERR0;                                                   08218000
   EOFCODE := NO'EOF;                                          <<03522>>08220000
   USERSTACK:=QUSERSTACK;                                               08222000
   PARMARRAY(0)     :=LDNUM;                                            08224000
   PARMARRAY(X:=X+1):=QMISC;                                            08226000
   IF DSTX=0 THEN DSTX:=QUSERSTACK;                                     08228000
   IF FLAGS.SYSBUFRS=1 THEN                                             08230000
      DSTX:=SYSBUFRDSTX;                                                08232000
   PARMARRAY(X:=X+1):=DSTX;                                             08234000
   PARMARRAY(X:=X+1):=ADDR;                                             08236000
   PARMARRAY(X:=X+1):=FUNC;                                             08238000
   PARMARRAY(X:=X+1):=CNT;                                              08240000
   PARMARRAY(X:=X+1):=P1;                                               08242000
   PARMARRAY(X:=X+1):=P2;                                               08244000
   PARMARRAY(X:=X+1):=FLAGS.(7:9);                                      08246000
   IF JUSTALLOCATED THEN                                                08248000
      BEGIN <<INITIALIZE GLOBAL VARIABLES TO LOAD-POINT>>               08250000
      CONTIGSTARTSECT:=-1D;                                             08254000
      TAPEWRITTEN:=FALSE;                                               08256000
      LPERRORLOG:=FALSE;                                                08258000
      NULLTRANSFER:=FALSE;                                              08260000
      ALREADYREJECTED:=FALSE;                                  <<00189>>08262000
      NEXTRECINBUF:=FALSE;                                              08264000
      CURRENTBUFINDEX:=0;                                               08266000
      WORDSINRECBUF:=0;                                                 08268000
      BOT'SENSOR := BOT'FOUND;                                 <<03522>>08270000
      EOTSENSOR:=EOTNOTFOUND;                                           08272000
      TAPEREWOUND := TRUE;                                     <<03733>>08274000
      JUSTALLOCATED:=FALSE;                                             08276000
      IF CLOSE'FILE <= FUNC <= REWIND                          <<03733>>08280000
        OR FUNC = REW'UNLOAD THEN                              <<03733>>08284000
         JUSTALLOCATED:=TRUE                                   <<00212>>08286000
      ELSE                                                     <<00212>>08288000
         BEGIN                                                 <<03522>>08290000
                                                               <<03680>>08292000
  COMMENT -- If we're here, we're about to perform  our  first <<03680>>08294000
logical operation on this "reel". Make sure the device is log- <<03680>>08296000
ically mounted (WAITFORDISC waits until this  happens)  before <<03680>>08298000
we  continue.  Note  that  any CS80 device is unlocked at this <<03680>>08300000
point, so an UNLOCK and re-LOCK does not need to  be  done  in <<03680>>08302000
WAITFORDISC.                                                   <<03680>>08304000
;                                                              <<03680>>08306000
         WAITFORDISC;                                          <<03680>>08308000
         GPTMOD (NEW'VOLUME);  << Re-fetch GPT for new reel >> <<03733>>08310000
         IF NOT (SDERR) THEN LOCK'CS80'DEVICE;                 <<03640>>08312000
         END;                                                  <<03522>>08314000
      END;  <<INITIALIZE GLOBAL VARIABLES TO LOAD-POINT>>               08316000
   XMITLOG:=0;                                                 <<00189>>08320000
                                                               <<04742>>08322000
  COMMENT -- JUSTALLOCATED is TRUE for new  device  allocation <<04742>>08324000
and whenever  a "reel" is switched.  If it is still TRUE here, <<04742>>08326000
we have not yet initialized the part of our extra data segment <<04742>>08328000
which comes from the label sector of our device (this is  done <<04742>>08330000
in  the  GPTMOD  (NEW'VOLUME) call above when JUSTALLOCATED is <<04742>>08332000
FALSE).  So we can't allow the CASE statement below to  invoke <<04742>>08334000
one  of  the  command processors which depend on those values. <<04742>>08336000
We're also stuck if the GPTMOD (NEW'VOLUME) call fails,  which <<04742>>08338000
is why we test SDERR here.                                     <<04742>>08340000
;                                                              <<04742>>08342000
   IF NOT (JUSTALLOCATED LOR SDERR) THEN                       <<04742>>08344000
     CASE FUNC.(12:4) OF                                                08346000
      BEGIN <<CASE STATEMENT>>                                          08348000
      READSDISC;      <<READ>>                                          08350000
      RITESDISC;      <<WRITE>>                                         08352000
      ;               <<OPEN FILE>>                                     08354000
      ;               <<CLOSE FILE>>                           <<00494>>08356000
      BEGIN           << Close Device.                      >> <<03522>>08358000
         DEVICE'CLOSE'FLAG := TRUE;  << Errs don't abort op >> <<03733>>08360000
         PARMARRAY(4) := REW'UNLOAD;   << Must put in XDS.  >> <<03606>>08362000
         CTRLSDISC;                                            <<03522>>08364000
         DEVICE'CLOSE'FLAG := FALSE;                           <<03733>>08366000
      END;            << Close Device.                      >> <<03522>>08368000
      CTRLSDISC;      <<REWIND>>                                        08370000
      CTRLSDISC;      <<WRITE EOF>>                                     08372000
      CTRLSDISC;      <<FORWARD SPACE FILE>>                            08374000
      CTRLSDISC;      <<BACK SPACE FILE>>                               08376000
      CTRLSDISC;      <<REWIND & UNLOAD>>                               08378000
      ;               <<GAP>>                                           08380000
      CTRLSDISC;      <<FORWARD SPACE RECORD>>                          08382000
      CTRLSDISC;      <<BACK SPACE RECORD>>                             08384000
      SETSDISCERROR(SDERR14); <<INVALID FUNCTION>>                      08386000
      SETSDISCERROR(SDERR14); <<INVALID FUNCTION>>                      08388000
      CTRLSDISC;      <<FETCH SERIAL DISC HARDWARE STATUS>>    <<01958>>08390000
      END;  <<CASE STATEMENT>>                                          08392000
   RETVAL1:=XMITLOG; <<#CHARACTERS/WORDS TRANSFERED>>                   08394000
   IF ERRORCODE=0 THEN                                                  08396000
      BEGIN <<NO ABNORMAL CONDITIONS MET>>                              08398000
      IF EOFCODE<>0 THEN                                                08400000
         RETVAL0:=EOFCODE&LSL(3)+2                                      08402000
      ELSE                                                              08404000
         RETVAL0:=1;                                                    08406000
      END                                                               08408000
   ELSE                                                                 08410000
      RETVAL0:=IF ERRORCODE>99 THEN                            <<00189>>08412000
         ERRORS(\ERRORCODE-100\)                               <<00189>>08414000
      ELSE                                                     <<00189>>08416000
         ERRORS(\ERRORCODE\);                                  <<00189>>08418000
   END   <<MOVE PARMS AND EXECUTE>>                                     08422000
ELSE                                                                    08424000
   BEGIN <<INVALID CALL>>                                               08426000
   IF FATALERROR AND QDSTN>0 THEN QERRORCODE:=SDERR3;                   08430000
   RETVAL1:=0; <<NO TRANSMISSION>>                                      08432000
   RETVAL0:=ERRORS(\QERRORCODE\);                                       08434000
   END;  <<INVALID CALL>>                                               08436000
IF QERRORCODE=0 AND QDSTN>0 THEN                                        08438000
   QERRORCODE:=ERRORCODE;                                               08440000
IF 1<=QERRORCODE<=99 AND QDSTN>0 THEN                                   08442000
   BEGIN                                                                08444000
   IF NOT FATALERROR THEN                                      <<00513>>08446000
      BEGIN                                                    <<00513>>08448000
      EXCHANGEDB(0);                                           <<00513>>08450000
      GENMSG(SET19,QERRORCODE,%10000,LDNUM);                   <<00513>>08452000
      EXCHANGEDB(QDSTN);                                       <<00513>>08454000
      FATALERROR:=TRUE;                                        <<00513>>08456000
      END;                                                     <<00513>>08458000
   END;                                                                 08460000
EXCHANGEDB(QUSERDST);                                                   08462000
IF DB'WAS'ABSOLUTE THEN                                                 08464000
   SETSYSDB;   << Leave DB at SYSGLOB if there at entry.       <<03558>>08466000
END;  <<SDISCIO>>                                                       08468000
$CONTROL SEGMENT=MAIN                                                   08470000
END.  <<SDISC>>                                                         08472000
