<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$CONTROL MAP,CODE,USLINIT                                               00010000
<< IPC - MODULE 66 >>                                                   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
$SET X0=ON,X1=OFF                                                       00028000
$CONTROL USLINIT,MAP,CODE,MAIN=MSGFILEACCESS                            00030000
begin                                                                   00032000
                                                               <<04139>>00034000
COMMENT                                                        <<04139>>00036000
                                                               <<04139>>00038000
     Fixes Since February 4, 1982                              <<04139>>00040000
                                                               <<04139>>00042000
FCONTROL 45 will no longer screw up the number of records      <<04139>>00044000
  allocated at JustOpened Time.(sr#26353)                      <<04139>>00046000
                                                               <<04139>>00048000
;                                                              <<04139>>00050000
                                                                        00052000
equate                                                                  00054000
version     = 02,             <<Version number 12/03/80>>               00056000
update      = 02;             <<Update number  12/06/80>>               00058000
                                                                        00060000
<< Compile options                                                      00062000
   X0  - on  - List prologue                                            00064000
         off - Omit prologue                                            00066000
   X1  - on  - List misc global data structures and external/forward    00068000
               procedures.                                              00070000
         off - Omit listing                                             00072000
   X2  - on  - Call DEBUG before calling SUDDENDEATH.                   00074000
             - Call SUDDENDEATH directly                                00076000
>>                                                                      00078000
                                                                        00080000
$IF X0=OFF                                                              00082000
$CONTROL NOLIST                                                         00084000
$IF                                                                     00086000
$PAGE "PROLOGUE.  INTRODUCTION."                                        00088000
COMMENT                                                        <<04139>>00090000
                                                                        00092000
Message File Access Procedures                                          00094000
-------------------------------------                                   00096000
                                                                        00098000
The IPC code spans three areas.                                         00100000
                                                                        00102000
1. File System Code.                                                    00104000
   Since msg files have their own file type (and, hence, their          00106000
   own AFT type), it is necessary to merely add a new statement         00108000
   to each of the intrinsics' file-type case statement.  For most of    00110000
   the intrinsics this statement is very simple, consisting of either a 00112000
   call to a msg access procedure (read, write, and control) or         00114000
   an error (point, readseek, etc).  Only the FOPEN intrinsic           00116000
   requires substantial modification to support msg files.              00118000
                                                                        00120000
2. Access Procedures.                                                   00122000
   This is implemented by the code of this listing.                     00124000
                                                                        00126000
3. Basic IPC.                                                           00128000
   This code provides the wait/wakeup mechanism.                        00130000
                                                                        00132000
                                                                        00134000
.............       ...............        ................             00136000
:           :       :             :        :              :             00138000
: File Syst :       : Access      :        : Basic IPC    :             00140000
: Callable  :------>: Procedures  :------->:              :             00142000
: Intrinsics:       :             :        ................             00144000
:           :       :             :                                     00146000
.............       :             :--      ................             00148000
                    :             :  --    :              :             00150000
                    ...............    --  : File System  :             00152000
                                         ->: Uncallable   :             00154000
                                           : Intrinsics   :             00156000
                                           :              :             00158000
                                           ................             00160000
                                                                        00162000
The remainder of this section discusses the access procedures.          00164000
                                                                        00166000
                                                                        00168000
This set of procedures is the equivalent of IOMOVE for message          00170000
files.  It is the heart of the Msg file implementation.                 00172000
The Msg file access method is more complex than that of regular         00174000
sequential files for the following reasons.                             00176000
                                                                        00178000
  1. A wait/wakeup mechanism is required for the "read from an          00180000
     empty file" and "write to a full file" cases.  This                00182000
     mechanism must support timeouts and software interrupts.           00184000
                                                                        00186000
  2. Like circular files, the disc file eof can wrap around the         00188000
     extent map.                                                        00190000
                                                                        00192000
  3. Both the reader and the writer(s) must use buffers in a            00194000
     coordinated and efficient manner.                                  00196000
                                                                        00198000
  4. Disc space extents may be thrown away at close time after          00200000
     they have been read, providing there are no current writers.       00202000
$PAGE "PROLOGUE.  DESIGN HIGHLIGHTS."                                   00204000
Design highlights.                                                      00206000
-----------------                                                       00208000
                                                                        00210000
1. File Boundary Conditions                                             00212000
                                                                        00214000
   There are two cases when a process is forced to wait on an           00216000
   action from one or more other processes.                             00218000
                                                                        00220000
     a) A reader accessing an empty file, the process must              00222000
        wait until a writer writes a record.                            00224000
                                                                        00226000
     b) A writer encountering a full file, the process must wait        00228000
        until a reader reads enough records on disc to free a           00230000
        physical block.                                                 00232000
                                                                        00234000
   a) Impeded reader                                                    00236000
                                                                        00238000
      This has a classic, straightforward solution.  The reader         00240000
      decrements a counting semaphore (number of records in the         00242000
      file).  When the semaphore goes to zero there are no more         00244000
      records left and the reader is placed on the wait queue           00246000
      (which is a disabled port--see basic IPC description).            00248000
      Each time a writer writes a record, the writer checks the         00250000
      wait queue.  If it is nonempty, the head entry is taken           00252000
      from the queue and sent to the reader's reply port.               00254000
      Otherwise the counting semaphore is incremented.                  00256000
                                                                        00258000
      This mechanism is gummed up somewhat by extended read mode.       00260000
      If not in extended read then only data records count in the       00262000
      counting semaphore.  Extended read causes all records (data,      00264000
      open, and close) to be counted.                                   00266000
                                                                        00268000
  b) Impeded writer                                                     00270000
                                                                        00272000
      When the file is opened the amount of free file space (in         00274000
      max-sized records) is calculated.  Each write first subtracts     00276000
      its record size and record overhead from the free space.  If      00278000
      there is not enough space the writer is placed on the write       00280000
      wait queue.                                                       00282000
                                                                        00284000
      The reader returns free space a block's worth at a time.          00286000
      The wait queue is then reduced until the freed bytes              00288000
      have been filled.  The actual write is performed by the           00290000
      reader at this time.  This is to 1) expedite the no wait          00292000
      writers' data and 2) to insure that the released writers          00294000
      will fill the file in the same order as they were freed           00296000
      (any other sequence may result in the writers' running            00298000
      out of file space).                                               00300000
                                                                        00302000
      Both readers and writers have "reply ports" which receive         00304000
      the completed read/write requests (refer to the basic IPC         00306000
      documentation for a description of ports).  The current           00308000
      limitation of IOWAIT is one request outstanding, so the           00310000
      reply ports will only have a maximum queue depth of one           00312000
      entry.                                                            00314000
                                                                        00316000
                                                                        00318000
2. Disc Space Management                                                00320000
                                                                        00322000
   Since the reader logically destroys records as they are              00324000
   read, it it desireable to also physically delete them as             00326000
   well.  The unit of allocation on the disc is the extent.             00328000
   The spent extents are only deleted at close time when there          00330000
   are no current writers.  To delete extents while there are           00332000
   writers can lead to needless work where the reader is                00334000
   deleting old extents and the writer is obtaining new ones.           00336000
                                                                        00338000
                                                                        00340000
3. Buffering                                                            00342000
                                                                        00344000
   Both reader and writer buffers are contained in the same             00346000
   buffer pool.  Reader buffers are the "head" of the queue             00348000
   whereas writer buffers comprise the "tail" of the queue.             00350000
   The buffer management runs in one of two modes.                      00352000
                                                                        00354000
     a) Coupled Mode.                                                   00356000
                                                                        00358000
        All active records are contained in the buffers.  A             00360000
        spent read buffer is added to the tail of the write             00362000
        buffer list.  Writers add to tail buffer in the list.           00364000
        If this happens to be a read buffer, then no disc I/O           00366000
        is initiated.  Note that if all the accessors were to           00368000
        close then all data would be written to the disc.  When         00370000
        the number of active records can no longer be held in           00372000
        the buffers, uncoupled mode is entered.                         00374000
                                                                        00376000
     b) Uncoupled Mode.                                                 00378000
                                                                        00380000
        The active records cannot be contained in the buffer            00382000
        area.  In this case the reader and writers use their            00384000
        own buffers independently.  Note that if the reader             00386000
        reads sufficient records such that the active records           00388000
        do fit in the buffers, the buffering mode will                  00390000
        automatically revert to coupled mode.                           00392000
                                                                        00394000
                                                                        00396000
  4. Record formatting.                                                 00398000
                                                                        00400000
     Data records are written in standard variable length format.       00402000
     Records do not span blocks.  Data record headers and open and      00404000
     close records are written starting from the bottom of the buffer   00406000
     and working up (whereas data records' data are written starting    00408000
     from the beginning of the buffer).                                 00410000
                                                                        00412000
     This method makes it possible to use the normal file system        00414000
     access method when accessing the file in "copy" mode.  When        00416000
     a new record and its header can no longer fit into the             00418000
     buffer, the buffer's block is written to disc and the record       00420000
     and its header are placed into the next block.                     00422000
                                                                        00424000
                                                                        00426000
  5. Miscellaneous                                                      00428000
                                                                        00430000
     a) No wait FREADs and FWRITEs are waited for disc I/O.  To         00432000
        do disc I/O without wait brings in additional complexity        00434000
        for very little gain to the user.  Implicit disc I/Os           00436000
        with wait have probably already occurred to make present        00438000
        the ACB and file system code.                                   00440000
                                                                        00442000
     b) Anticipatory reading is done.  However a write buffer is        00444000
        not written until the current record will not fit into          00446000
        it.  Having two or more write buffers should keep the           00448000
        writers waiting on disc I/O to a minimum.                       00450000
                                                                        00452000
     c) A bit map is kept for all currently allocated writer IDs.       00454000
        It is managed by the GETID and RELID procedures.  Currently     00456000
        a maximum of 256 concurrent writers is allowed.                 00458000
                                                                        00460000
     d) A disc error encountered by a reader prevents any more reads.   00462000
                                                                        00464000
     e) A disc error encountered by a writer prevents any more writes.  00466000
                                                                        00468000
     f) Unless otherwise noted, DB is always set to the stack upon      00470000
        entry/exit to these procedures.                                 00472000
                                                                        00474000
     g) There are two wait queues, one for readers and one for writers. 00476000
        It is possible that they could both be nonempty.  Say the       00478000
        file has a capacity of n records.  N records are written, the   00480000
        n+1 write is queued up.  Then n nowait reads are done with      00482000
        no complementary IOWAITs or IODONTWAITs being issued. The next  00484000
        read will be queued.                                            00486000
                                                                        00488000
                                                                        00490000
6. Optimization.                                                        00492000
                                                                        00494000
   a. "Immediate" nowait-soft interrupt I/O completion.                 00496000
                                                                        00498000
      When it has been determined at FREAD/FWRITE time that the         00500000
      request will not have to wait on a boundary condition,            00502000
      reply ports are not used.  Instead a two word "message            00504000
      area" in the LACB is used to house the completion message.        00506000
      A special pattern is placed into the AFT reply port word.         00508000
      When IOWAIT (or FINDWAITINGIO) sees this pattern it knows         00510000
      that the request has completed.                                   00512000
                                                                        00514000
   b. Updating the FCB.                                                 00516000
                                                                        00518000
      Everytime that a reader deletes a block it updates the            00520000
      start-of-file field in the FCB.  This operation has been          00522000
      optimized such that when the reader knows that the SOF is         00524000
      already at zero, the FCB update is skipped.                       00526000
                                                                        00528000
      How does the reader know?  The writer sets a flag when it         00530000
      exits out of the readers' buffers.                                00532000
                                                                        00536000
   c. Semi-Exclusive Mode.                                              00538000
                                                                        00540000
      In semi-exclusive mode there may be at most one reader.           00542000
      The generality of a read wait queue is not needed.  Instead       00544000
      when the reader attempts to read from the empty file, the         00546000
      reader's reply port number is placed directly into the ACB.       00548000
      If the reader has opened the file with wait, then no reply        00550000
      port is used.  In this case the reader's PIN is saved in          00552000
      the ACB.                                                          00554000
                                                                        00556000
      The above short cuts are also applied to writers when the         00558000
      file is opened exclusively (ie, there may only be one             00560000
      writer).                                                          00562000
                                                                        00564000
   d. Delayed Awake.                                                    00566000
                                                                        00568000
      When a reader or writer liberates a symbiotic process             00570000
      which was waiting on a boundary condition, the actual call        00572000
      to AWAKE is delayed until after the file's ACB has been           00574000
      released.                                                         00576000
$PAGE "PROLOGUE.  FUNCTIONAL DESCRIPTION."                              00578000
Functional Description.                                                 00580000
----------------------                                                  00582000
                                                                        00584000
1. Opening the File.                                                    00586000
                                                                        00588000
   a) First opener.                                                     00590000
                                                                        00592000
      There are two functions to be performed.  First, the msg file     00594000
      portion of the ACB must be initialized (FCINITACB).  Secondly     00596000
      for old, nonempty files, the read and write buffers must be       00598000
      filled (FCFILLBUFFERS).  This procedure also checks the last      00600000
      header written for the "last writer" close code.  Any other       00602000
      value indicates that at some prior time the system crashed        00604000
      while writting to the file.                                       00606000
                                                                        00608000
      This is a two step process because at ACB initialization time     00610000
      the location of the FCB is unknown.  The FCFILLBUFFERS call is    00612000
      delayed until the user issues the first read or write.            00614000
                                                                        00616000
   b) All openers.                                                      00618000
                                                                        00620000
      Obtain the structures local to the caller:                        00622000
                                                                        00624000
        Reply port (for waking up on boundary conditions)               00626000
                                                                        00628000
        ID number for writers                                           00630000
                                                                        00632000
        Record buffer for no wait writers.  This is required so         00634000
        that the writer can use his target area after return from       00636000
        FWRITE.  Since only one outstanding request is allowed,         00638000
        only buffer space for one max-size record is required.          00640000
                                                                        00642000
      Note that writers 1) write their open records and 2) allocate     00644000
      space for their close records upon their first FWRITE to the file,00646000
      not at FOPEN time.  This eliminates the need for FOPEN to wait    00648000
      for file space.  It also allows a writer to open/close the file   00650000
      without having any effect on it.                                  00652000
                                                                        00654000
                                                                        00656000
2. Closing the file.                                                    00658000
                                                                        00660000
   a. All outstanding requests are cancelled.  For readers, any         00662000
      outstanding claim to a record is returned.                        00664000
                                                                        00666000
   b. If this is the last reader/writer then any symbiotic waiting      00668000
      process (not in extended wait mode) is satisfied with a CCG.      00670000
                                                                        00672000
   c. Writers that have written one or more records have a close        00674000
      record written.                                                   00676000
                                                                        00678000
   d. The reply port and (possible) record buffer are deleted.          00680000
                                                                        00682000
   e. If this is the last writer, or if this is a reader with no        00684000
      current writers, then spent extents are deleted.                  00686000
                                                                        00688000
   f. If this is the last accessor then the wait queues are deleted.    00690000
                                                                        00692000
   g. An end-of-file is written to checkpoint the file.                 00694000
                                                                        00696000
                                                                        00698000
3. Writing.                                                             00700000
                                                                        00702000
   The usual course of a write is to 1) insure that there is room       00704000
   for the record, 2) write the record (usually just a data move        00706000
   to an ACB buffer), and 3) if a reader is waiting, to send a          00708000
   successful message to the reader's reply port.                       00710000
                                                                        00712000
   The following exceptions may occur:                                  00714000
                                                                        00716000
    a. First write.                                                     00718000
                                                                        00720000
      The writer's first write after an open consists of writing        00722000
      the open record, the data record, and allocating space for        00724000
      the close record.                                                 00726000
                                                                        00728000
    b. Stalled writer.                                                  00730000
                                                                        00732000
      If the record will not fit into the file then the writer is       00734000
      waited if:                                                        00736000
                                                                        00738000
      1) a reader has opened the file,                                  00740000
                                                                        00742000
      2) or this is the writer's first write after the open,            00744000
                                                                        00746000
      3) or the writer has specified extended wait.                     00748000
                                                                        00750000
      Waiting consists of placing a message on the wait queue (a        00752000
      basic IPC port).  Eventually a reader will perform the            00754000
      transfer and send a successful message to the writer.             00756000
                                                                        00758000
    c. Block indexing.                                                  00760000
                                                                        00762000
      If the record will not fit into the current block then            00764000
                                                                        00766000
      1) if the current buffer is a write buffer, a disc write          00768000
         is initiated on behalf of the buffer,                          00770000
                                                                        00772000
      2) if this current buffer is a read buffer (coupled mode) then    00774000
         the next buffer is chosen.  Otherwise the first write          00776000
         buffer becomes the last (current) write buffer.  Thus          00778000
         write buffers contain the last n blocks of the file.           00780000
         This is useful information to have when interpreting           00782000
         dumps.                                                         00784000
                                                                        00786000
   The write facility has been divided into two procedures.             00788000
                                                                        00790000
   FCWRITE     - Decides if there is room to write the record, waits    00792000
                 the writer if not, performs user checks.               00794000
                                                                        00796000
   PUTRECORD   - Actually performs the write, including indexing to     00798000
                 the next block, if necessary.                          00800000
                                                                        00802000
   PUTRECORD is also called by the liberating reader on behalf of a     00804000
   waiting writer.                                                      00806000
                                                                        00808000
   Note - If the writer's target area is in his stack, then the         00810000
          writer's stack, the reader's stack, and the ACB must all      00812000
          be present for the move.  If the code is changed to have      00814000
          wait writers perform their own move, they must first check    00816000
          to see if there is room (after they wake up).  A speedy       00818000
          second writer could have taken the space away.                00820000
                                                                        00822000
                                                                        00824000
4. Reading.                                                             00826000
                                                                        00828000
   Most read requests read a record and, if the next record is in       00830000
   another block, issue an anticipatory read of the block from disc.    00832000
                                                                        00834000
   The following exceptions may occur:                                  00836000
                                                                        00838000
   a. Extended read mode.                                               00840000
                                                                        00842000
      If the file is not in extended read mode, then only data          00844000
      records are desired.  Thus possible open/close records must       00846000
      be flushed from the front of the file before the actual read      00848000
      to the user's target area.  If the reader must wait (due to       00850000
      an empty file) then when the reader is awakened by the            00852000
      writer, the flushing process must be repeated before the          00854000
      actual read can commence.                                         00856000
                                                                        00858000
   b. Empty file.                                                       00860000
                                                                        00862000
      The reader is waited if:                                          00864000
                                                                        00866000
      1. one or more writers has opened the file,                       00868000
                                                                        00870000
      2. or this is the reader's first read to the file after           00872000
         the open,                                                      00874000
                                                                        00876000
      3. or the reader has specified extended wait.                     00878000
                                                                        00880000
      Waiting consists of placing a mesage on the wait queue            00882000
      (a basic IPC port).  Eventually a writer will deposit a record    00884000
      and send a successful message to the reader's reply port.  The    00886000
      reader then (or at IOWAIT time) performs the data transfer.       00888000
                                                                        00890000
      Waited readers, unlike waited writers, perform their own data     00892000
      movement upon being liberated.  They can do this because they     00894000
      are freed with a claim on any one record in the file - not a      00896000
      particular one.  Thus it is permissable for other readers to      00898000
      issue FREAD/IOWAITs between another reader's FREAD and IOWAIT.    00900000
      The only constraint is that a one record (claim) be set aside     00902000
      for the first reader when he is liberated from the wait queue.    00904000
                                                                        00906000
   c. Block indexing.                                                   00908000
                                                                        00910000
      If the record read is the last record in the block then:          00912000
                                                                        00914000
      1. A block's worth of max-sized records is added to the file's    00916000
         free space.  It is immediately applied to any waiting writers  00918000
         on the wait queue.                                             00920000
                                                                        00922000
      2. The file's start-of-file is advanced by one and all block      00924000
         numbers are decremented.  Exception: if there are no more      00926000
         records in the file then the start-of-file and end-of-file     00928000
         are both reset to zero.                                        00930000
                                                                        00932000
      3. If the file is not empty then the next block is obtained as    00934000
         per the buffering description in "Design Highlights."          00936000
$PAGE "PROLOGUE.  FILE STRUCTURES."                                     00938000
File Structure                                                          00940000
--------------                                                          00942000
                                                                        00944000
File label/FCB extent map                                               00946000
............................. End of file block    Start of file block  00948000
: Disc addr of extent 0     :   .                    .                  00950000
:...........................:   .                    .                  00952000
: Disc addr of extent 1     :   v                    .                  00954000
............................:   -                    .                  00956000
: Disc addr of extent 2     :                        .                  00958000
:...........................:                        .                  00960000
: Disc addr of extent 3     :                        .                  00962000
:...........................:                        .                  00964000
z                           z                        .                  00966000
:...........................:                        .                  00968000
: Disc addr of extent n-1   :                        v                  00970000
:...........................:                        -                  00972000
: Disc addr of extent n     :                                           00974000
:...........................:                                           00976000
                                                                        00978000
The EOF and SOF are examples only, meant to show that 1) the start of   00980000
file moves into the extent map as records are read and 2) that the      00982000
file can wrap around and, hence, cause the SOF to be greater than the   00984000
EOF.                                                                    00986000
                                                                        00988000
When a file becomes nonempty the SOF and EOF are reset to               00990000
the first block of extent zero.                                         00992000
                                                                        00994000
Each extent is composed of a number of blocks.  Extents all have the    00996000
same number of blocks.  Extent zero also contains space for the file    00998000
label and user labels in the exact same format as standard files.       01000000
Starting with block zero, sufficient blocks are allocated to the        01002000
file label/user labels to satisfy their space requirements.             01004000
                                                                        01006000
Extents outside of the SOF/EOF range may not exist.  They are           01008000
deleted at close time when there are no more writers accessing          01010000
the file.                                                               01012000
                                                                        01014000
                                                                        01016000
Block Structure.                                                        01018000
---------------                                                         01020000
                                                                        01022000
.............................   **********************************      01024000
: First data record         :                                           01026000
:...........................:   Exact same format as standard           01028000
: Second data record        :   variable length blocks.                 01030000
:...........................:                                           01032000
z                           z                                           01034000
:...........................:                                           01036000
: Last data record          :                                           01038000
:...........................:                                           01040000
: Record delimeter (-1)     :                                           01042000
:...........................:   **********************************      01044000
:                           :                                           01046000
: Empty space (next record  :                                           01048000
: would not fit)            :                                           01050000
:                           :                                           01052000
:...........................:                                           01054000
: Header delimiter (%377)   :                                           01056000
:...........................:                                           01058000
: Last header record        :                                           01060000
:...........................:                                           01062000
z                           z                                           01064000
:...........................:                                           01066000
: Second header record      :                                           01068000
:...........................:                                           01070000
: First header record       :                                           01072000
:...........................:                                           01074000
                                                                        01076000
                                                                        01078000
Seperating the data portion of the records from their header            01080000
enables IOMOVE to read the records with no knowledge that they          01082000
are msg file records.                                                   01084000
                                                                        01086000
                                                                        01088000
Record Format.                                                          01090000
-------------                                                           01092000
                                                                        01094000
.............................                                           01096000
: Number of bytes in record :                                           01098000
:...........................:                                           01100000
: First data word of record :                                           01102000
:...........................:                                           01104000
z                           z                                           01106000
:...........................:                                           01108000
: Last data word of record  :                                           01110000
:...........................:                                           01112000
                                                                        01114000
Length word's value does not include itself.                            01116000
                                                                        01118000
                                                                        01120000
Header Format.                                                          01122000
-------------                                                           01124000
                                                                        01126000
.............................                                           01128000
: C:LC:       :  Header Type: 0                                         01130000
:...........................:                                           01132000
: Writer's ID               : -1                                        01134000
:...........................:                                           01136000
                                                                        01138000
C (0:1)  - Set on if this was the last record written before            01140000
           the system crashed.  This bit is set on by the               01142000
           first open on the file after the crash.                      01144000
                                                                        01146000
LC (1:1)- Valid only for close headers.  Set to one if this is          01148000
          the last writer to close the file.                            01150000
                                                                        01152000
Type(8:8)- 0 data                                                       01154000
           1 open                                                       01156000
           2 close                                                      01158000
           3 Close forced by error in data transport mechanism          01160000
             (See DSN IPC Standard)                                     01162000
                                                                        01164000
                                                                        01166000
Message Access Control Block.                                           01168000
----------------------------                                            01170000
                                                                        01172000
Notes:                                                                  01174000
   1. Words that do not pertain to message files are left               01176000
      blank.                                                            01178000
                                                                        01180000
   2. This diagram shows the "combined" ACB as it appears to            01182000
      the message access procedures (the procedures in CAC).            01184000
      Thus it is a combination of the LACB and the PACB.                01186000
                                                                        01188000
                                                                        01190000
    ....................................................                01192000
  0 :   : Size of the ACB including buffers (words)    : 0              01194000
    ....................................................                01196000
  1 :                        : File number             : 1              01198000
    ....................................................                01200000
  2 : File name                                        : 2              01202000
    .....................            ...................                01204000
    z                                                  z                01206000
    ....................................................                01208000
  6 : Foptions                                         : 6              01210000
    ....................................................                01212000
  7 : Aoptions                                         : 7              01214000
    ....................................................                01216000
  8 : Record size (bytes)                              : 10             01218000
    ....................................................                01220000
  9 : Block size (words)                               : 11             01222000
    ....................................................                01224000
    z                                                  z                01226000
    ....................................................                01228000
 11 : Carriage control code (writers)                  : 13             01230000
    ....................................................                01232000
 12 : Target storage, used for IPC no wait I/O         : 14             01234000
    ....................................................                01236000
 13 : Count storage, used for IPC no wait I/O          : 15             01236100
    ....................................................                01236200
 14 : Error code                                       : 16             01238000
    ....................................................                01240000
 15 : Transmission log (units same as last read/write) : 17             01242000
    ....................................................                01244000
 16 : Total number of unread records (includes opens   : 20             01246000
    ...............                    .................                01248000
 17 : and closes)                                      : 21             01250000
    ....................................................                01252000
 18 : Block number of the file's tail (relative to the : 22             01254000
    ..................               ...................                01256000
 19 : start of file block)                             : 23             01258000
    ....................................................                01260000
 20 : Logical record transfer count                    : 24             01262000
    ..................               ...................                01264000
 21 :                                                  : 25             01266000
    ....................................................                01268000
 22 : Physical block transfer count                    : 26             01270000
    ..................               ...................                01272000
 23 :                                                  : 27             01274000
    ....................................................                01276000
 24 : Address of the head record's header              : 30             01278000
    ....................................................                01280000
 25 : Address of the tail record's header              : 31             01282000
    ....................................................                01284000
 26 : FCB control block vector                         : 32             01286000
    ....................................................                01288000
    z                                                  z                01290000
    ....................................................                01292000
 28 : Number readers        : Number readers & writers : 34             01294000
    ....................................................                01296000
 29 z                                                  z                01298000
    ....................................................                01300000
 30 :                       : Records per block        : 36             01302000
    ....................................................                01304000
 31            :Wrt buf indx:              : # buf - 1 : 37             01306000
    ....................................................                01308000
 32 : Address of the head record's data                : 40             01310000
    ....................................................                01312000
 33 : Size of the buffer (words)                       : 41             01314000
    ....................................................                01316000
    z                                                  z                01318000
    ....................................................                01320000
 38 :                       : Logical device number    : 46             01322000
    ....................................................                01324000
 39 :0:# rd buf  : # wt buf   :er :qw :m :c :d  :s :f  : 47             01326000
    ....................................................                01328000
 40 : Number of max sized free records                 : 50             01330000
    ....................................................                01332000
 41 :                                                  : 51             01334000
    ....................................................                01336000
 42 : Number of free words in the current free record  : 52             01338000
    ....................................................                01340000
 43 : Address of the next write record                 : 53             01342000
    ....................................................                01344000
 44 : Number of nondata records in the file            : 54             01346000
    ....................................................                01348000
 45 :                                                  : 55             01350000
    ....................................................                01352000
 46 : # of read requests that have a claim on file     : 56             01354000
    ....................................................                01356000
 47 : Last read error     : Last write error           : 57             01358000
    ....................................................                01360000
 48 : DST number of the physical ACB                   : 60             01362000
    ....................................................                01364000
 49 : Address of the physical ACB                      : 61             01366000
    ....................................................                01368000
 50 : DST number of the logical ACB                    : 62             01370000
    ....................................................                01372000
 51 : Address of the logical ACB                       : 63             01374000
    ....................................................                01376000
 52 : DST rel address of the stack access control blk  : 64             01378000
    ....................................................                01380000
 53 : DST rel address of the DB area                   : 65             01382000
    ....................................................                01384000
 54 : PACB vector table entry address                  : 66             01386000
    ....................................................                01388000
 55 : PACB control block vector table address          : 67             01390000
    ....................................................                01392000
 56 : Target area's DST number                         : 70             01394000
    ....................................................                01396000
 57 : Reserved for calling parameters                  : 71             01398000
    ................                         ...........                01400000
 58 :                                                  : 72             01402000
    ................                         ...........                01404000
 59 :                                                  : 73             01406000
    ....................................................                01408000
 60 : Reserved for the stack marker from file system   : 74             01410000
    ................                         ...........                01412000
 61 : intrinsics                                       : 75             01414000
    ....................................................                01416000
    z                                                  z                01418000
    ....................................................                01420000
 64 : User's soft interrupt plabel                     : 100*           01422000
    ....................................................                01424000
 65 : Number of seconds to wait on boundary condition  : 101*           01426000
    ....................................................                01428000
 66 : O:Ex:Nd:Vr:Bt:C :I :W : Carriage control         : 102*  <<04139>>01432000
    :..................................................:                01434000
 67 : Reply Port (basic IPC port)                      : 103*           01436000
    ....................................................                01438000
 68 : Writer ID                                        : 104*           01440000
    ....................................................                01442000
 69 : Control block index for nowait writer record buf : 105*           01444000
    ....................................................                01446000
 70 : DST relative addr of nowait writer record buffer : 106*           01448000
    ....................................................                01450000
 71 : No wait I/O resultant error code                 : 107*           01452000
    ....................................................                01454000
 72 : No wait I/O resultant transmission log           : 110*           01456000
    ....................................................                01458000
 72 : Write wait queue (basic IPC port)                : 110            01460000
    ....................................................                01462000
 73 : Read wait queue (basic IPC port)                 : 111            01464000
    ....................................................                01466000
 75 : Head record's length (bytes)                     : 113            01468000
    ....................................................                01470000
 76 : Head record's record type (same values as header): 114            01472000
    ....................................................                01474000
 77 : Head record's writer ID                          : 115            01476000
    ....................................................                01478000
 78 : Head record's header word value                  : 116            01480000
    ....................................................                01482000
 79 : Max size record plus its overhead (words)        : 117            01484000
    ....................................................                01486000
 80 : ACB wait queue message - see above optimization  : 120            01488000
    ....................................................                01490000
 81 : description.  See defines for precise definition : 121            01492000
    ....................................................                01494000
 82 : of this subarray (it contains the same info as a : 122            01496000
    ....................................................                01498000
 83 : wait queue message).                             : 123            01500000
    ..................               ...................                01502000
 84 :                                                  : 124            01504000
    ....................................................                01506000
 85 : Waiter's reply port, 0 if using ACB compltn area : 125            01508000
    ....................................................                01510000
 86 : ACB completion message area - see above descriptn: 126            01512000
    ..................               ...................                01514000
 87 : of the optimization shortcuts.                   : 127            01516000
    ....................................................                01518000
 88 : Waiting process's pin                            : 130            01520000
    ....................................................                01522000
 89 : Waiting process's file number                    : 131            01524000
    ....................................................                01526000
 90 : Waiting process's soft interrupt plabel          : 132            01528000
    ....................................................                01530000
 91 : DST rel address of buffer one                    : 133            01532000
    ....................................................                01534000
 92 : DST rel address of buffer two                    : 134            01536000
    ....................................................                01538000
 93 : Etc.                                             : 135            01540000
    ....................................................                01542000
                                                                        01546000
                                                                        01548000
* Value is private to a particular accessor.                            01550000
                                                                        01552000
Word   Field   Description                                              01554000
------ ------- -------------------------------------------------        01556000
39             File's global flags.                                     01558000
       (9:1)   er 1 - extended read                                     01560000
       (10:1)  qw 1 - one or more writers has been queued on the        01562000
                      wait queue.                                       01564000
       (11:1)  m  1 - Wait message is in the ACB.                       01566000
       (12:1)  c  1 - Completion message is in the ACB.                 01568000
       (13:1)  d  1 - Current write block is dirty.                     01570000
       (14:1)  s  0 - Start of file is at block zero.                   01572000
       (15:1)  f  0 - Buffers not yet initialized.                      01574000
                                                                        01576000
65             Accessor's local flags.                                  01578000
       (0:1)   O  1 - have not yet issued an FREAD/FWRITE against       01580000
                      the file.                                         01582000
       (1:1)   ex 1 - extended wait mode.                               01584000
       (2:1)   nd 1 - do not destroy the next record read.              01586000
       (3:1)   vr 1 - writer has not yet written his first record       01588000
                      (ie., he is a virgin).                            01590000
       (4:1)   bt 0 - transmission log should be expressed in words.    01592000
                  1 -      "        "     "   "     "      "  bytes.    01594000
       (5:1)   c         Not currently used (reserved for group IPC     01596000
                         standard).                                     01598000
       (6:1)   i         No wait I/O done at initiation time.           01600000
       (7:1)   w         Extended Wait disabled, but file just <<04139>>01602000
                         opened.                               <<04139>>01604000
       (8:8)   car ctl   carriage control character to be used for      01606000
                         the writer's record (a value of one indi-      01608000
                         cates no carriage control character).          01610000
39             File's global flags.                                     01614000
                                                                        01616000
       (9:1)   er 1 - extended read                                     01618000
       (10:1)  qw 1 - one or more writers has been queued on the        01620000
                                                                        01622000
       (11:1)  m  1 - wait msg is located in the ACB                    01626000
                                                                        01628000
       (12:1)  c  1 - completion msg is located in the ACB              01630000
                                                                        01632000
       (13:1)  d  1 - the current write buffer has dirty bit set        01634000
                                                                        01636000
       (14:1)  s  1 - the start of file is block zero                   01638000
                                                                        01640000
       (15:1)  f  0 - the ACB buffers have not been filled              01642000
                                                                        01644000
                                                                        01646000
                                                                        01648000
                                                                        01650000
                                                                        01654000
  72/1   Read compl  (0:8) error, (8:8) ID    Number of records         01656000
                                                                        01658000
  72/2   Write init  (0:8) # rec, (8:8) ID    Number of free records    01660000
                                                                        01662000
  72/3   Write compl (0:8) error, (8:8) ID    Number of free records    01664000
                                                                        01666000
  72/4   Control     (0:8) error, (8:8) ID    (0:4) func, (4:12) parm   01668000
                                                                        01670000
  72/5   EOF         (0:8) error, (8:8) ID    Number of records         01672000
                                                                        01674000
  72/6   Open        (0:8) error, (8:8) ID    Number of records         01676000
                                                                        01678000
  72/7   Close       (8:8) #free, (8:8) ID    Number of records         01680000
                                                                        01682000
  72/10  Initiation  0                        (0:8) fix, (8:8) update   01684000
                                                                        01686000
  73/0   Put record  (0:8) error, (8:8) ID    (0:3)  rec type,          01688000
                                              (3:13) number of records  01690000
  73/1   Delete rec  (0:8) error, (8:8) ID    (0:3)  rec type           01692000
                                              (3:13) number of records  01694000
  73/2   Delete blk  Start of file block #    End of file block #       01696000
                                                                        01698000
                                                                        01700000
Notes:                                                                  01702000
                                                                        01704000
  1. The aa/bb notation in the "octal value" column denotes             01706000
     type/subtype.  Type is the actual MMSTAT event number.             01708000
     Subtype is (0:4) of parameter 0.                                   01710000
                                                                        01712000
  2. Several items can possibly exceed their fields, in that            01714000
     case the bits beyond the field are lost.  These items are          01716000
     number of records, number of free records, start of file,          01718000
     and end of file.                                                   01720000
                                                                        01722000
  3. Parameter word zero has a common format for all the MMSTAT         01724000
     events.                                                            01726000
                                                                        01728000
     Field       Description                                            01730000
     ---------   ------------------------------------------------       01732000
     (0:4)       Event's subtype.                                       01734000
                                                                        01736000
     (4:2)       File's state                                           01738000
                 0 - empty                                              01740000
                 1 - partially full                                     01742000
                 2 - only a fraction of a free record is left           01744000
                 3 - completely full                                    01746000
                                                                        01748000
     (6:1)       Nonzero indicates that there is one or more            01750000
                 waiting readers.                                       01752000
                                                                        01754000
     (7:1)       Nonzero indicates that there is one or more            01756000
                 waiting writers.                                       01758000
                                                                        01760000
     (11:1)      Nonzero indicates that the write has a carriage        01762000
                 control character.                                     01764000
                                                                        01766000
     (12:4)      Flags local to the accessor.                           01768000
                 (12:1) - the accessor has done no FREADs/FWRITEs       01770000
                 (13:1) - extended wait                                 01772000
                 (14:1) - nondestructive read                           01774000
                 (15:1) - writer has not written any records            01776000
;                                                              <<04139>>01778000
$IF X0=OFF                                                              01780000
$CONTROL LIST                                                           01782000
$IF                                                                     01784000
$IF X1=OFF                                                              01786000
$CONTROL NOLIST                                                         01788000
$IF                                                                     01790000
$PAGE "MISCELLANEOUS DEFINITIONS."                                      01792000
<<----------------------------------------------------------------------01794000
*                                                                      *01796000
*  Miscellaneous Definitions                                           *01798000
*                                                                      *01800000
---------------------------------------------------------------------->>01802000
                                                                        01804000
                                                                        01806000
DEFINE INT = INTEGER#,                                                  01808000
       LOG = LOGICAL#,                                                  01810000
       DBL = DOUBLE#,                                                   01812000
       ABS = ABSOLUTE#,                                                 01814000
       ASMB = ASSEMBLE#;                                                01816000
INTEGER                                                                 01818000
  Q0=Q+0,Q1=Q+1,Q2=Q+2,Q3=Q+3,Q4=Q+4,                                   01820000
  Q5=Q+5,Q6=Q+6,Q7=Q+7,                                                 01822000
  Q10=Q+10,Q11=Q+11,Q12=Q+12,Q13=Q+13,                                  01824000
  Q14=Q+14,QM7=Q-7,                                                     01826000
  QM15=Q-15,QM16=Q-16,                                                  01828000
  QM17=Q-17,QM22=Q-22,                                                  01830000
  QM31=Q-31,                                                            01832000
  QM35=Q-35,                                                            01834000
  QM46=Q-46,QM48=Q-48,                                                  01836000
  QM49=Q-49,QM52=Q-52,                                                  01838000
  QM55=Q-55,QM62=Q-62,QM63=Q-63;                                        01840000
LOGICAL                                                                 01842000
  LQ3=Q+3,LQ15=Q+15,                                                    01844000
  LQM24=Q-24,LQM56=Q-56,LQM57=Q-57;                                     01846000
DOUBLE                                                                  01848000
  DQM3=Q-3,DQM2=Q-2,DQM1=Q-0,DQ0=Q-0,QDM47=Q-47;                        01850000
LOGICAL PMAP=Q-4;                                                       01852000
INTEGER ARRAY AQ0 (*) = Q-0;                                            01856000
INTEGER ARRAY AQ3 (*) = Q+3;                                            01858000
INTEGER S0 = S-0;                                                       01862000
INTEGER S1 = S-1;                                                       01864000
INTEGER S2 = S-2;                                                       01866000
INTEGER S3 = S-3;                                                       01868000
DOUBLE DS1 = S-1;                                                       01872000
DOUBLE DS3 = S-3;                                                       01874000
BYTE POINTER BPS0 = S-0;                                                01876000
INTEGER POINTER PS0 = S-0;                                              01880000
INTEGER POINTER PS1 = S-1;                                              01882000
INTEGER DELTAQ =Q-0;                                                    01886000
LOGICAL STATUS =Q-1;                                                    01888000
INTEGER X = X;                                                          01890000
EQUATE CCE=2,CCG=0,CCL=1;                                               01892000
                                                                        01894000
DEFINE CONDCODE = STATUS.(6:2)#;                                        01896000
DEFINE MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#;              01898000
                                                                        01900000
                                                                        01902000
$PAGE "FILE ERROR CODES."                                               01904000
<<---------------------------------------------------------------       01906000
*                                                               *       01908000
*  FILE ERROR CODES                                             *       01910000
*                                                               *       01912000
--------------------------------------------------------------->>       01914000
                                                                        01916000
EQUATE                                                                  01918000
SUCCESSFUL  = 0,    << NO ERRORS >>                                     01920000
ILLPARM     = 8,    << USER PASSED ILLEGAL PARAMETER >>                 01922000
SOFTIMEOUT  = 22,   << SOFTWARE TIMEOUT >>                              01924000
ACCVIOL     = 40,   << ACCESS-TYPE VIOLATION >>                         01926000
BADTCOUNT   = 43,   << XFER COUNT OVERRUN ON NON MULTI-RECORD>>         01928000
LBLIOERR    = 47,   << I/O ERROR ACCESSING FILE LABEL >>                01930000
MLTIACCERR  = 48,   << INVALID OPTION DUE TO MULTI FILE ACCESS>>        01932000
NAVAILDEV   = 55,   << NON-AVAILABLE DEVICE >>                          01934000
MEMPROB     = 57,   << INSUFFICIENT VIRTUAL MEMORY >>                   01936000
IOPENDING   = 77,   << NO WAIT I/O IS OUTSTANDING >>                    01938000
BADVARBLK   =105,   << BAD VARIABLE BLOCK STRUCTURE >>                  01940000
SYSTEMCRASH =151;   << CRASH WHILE OPENED BY WRITER(S) >>               01942000
$PAGE "PROCESS CONTROL BLOCK DEFINITIONS."                              01944000
<<---------------------------------------------------------------       01946000
*                                                               *       01948000
*  PROCESS CONTROL BLOCK (PCB) DEFINITIONS                      *       01950000
*                                                               *       01952000
--------------------------------------------------------------->>       01954000
                                                                        01956000
EQUATE                                                                  01958000
PCB'LEN     =  16,  << LENGTH OF EACH PCB >>                            01960000
PCBB        =   3,  << PCB BASE >>                                      01962000
CPCB        =   4;  << CURRENT PCB >>                                   01964000
                                                                        01966000
DEFINE                                                                  01968000
GetOwnPin   = (absolute(cpcb)-absolute(pcbb))&lsr(4)#;                  01970000
                                                                        01972000
                                                                        01974000
DEFINE                                                                  01976000
PCB'STK     = ABS(ABS(CPCB)+3).(1:10)#;    <<STACK DST NR.>>            01978000
                                                                        01980000
                                                                        01982000
$IF X1=OFF                                                              01984000
$CONTROL LIST                                                           01986000
$IF                                                                     01988000
$PAGE "FILE LABEL DEFINITIONS."                                         01990000
<<---------------------------------------------------------------       01992000
*                                                               *       01994000
*  FILE LABEL DEFINITIONS                                       *       01996000
*                                                               *       01998000
--------------------------------------------------------------->>       02000000
                                                                        02002000
EQUATE                                                                  02004000
HARDFLABERR =   7,  << IRRECOVERABLE LABEL ERROR >>                     02006000
FLABERRNO   = 247;  << MESSAGE CATALOG ENTRY NUMBER >>                  02008000
                                                                        02010000
DEFINE                                                                  02012000
ALLOCFLAB   = PUSH(S); @FLAB := TOS+1; ASSEMBLE(ADDS 128)#,             02014000
FLABSTRUCTURE                                                           02016000
            = INTEGER ARRAY FLAB(0:127);                                02018000
              DOUBLE POINTER FLABDBL=FLAB#;                             02020000
                                                                        02022000
                                                                        02024000
DEFINE                                                                  02026000
FLLOCNAME   =FLAB#,           << LOCAL FILE NAME >>                     02028000
FLGRPNAME   =FLAB(4)#,        << GROUP NAME >>                          02030000
FLACCTNAME  =FLAB(8)#,        << ACCOUNT NAME >>                        02032000
FLUSERID    =FLAB(12)#,       << CREATING USERID >>                     02034000
FLLOCKWORD  =FLAB(16)#,       << LOCKWORD >>                            02036000
FLSECMX     =FLABDBL(10)#,    << SECURITY MATRIX >>                     02038000
FLSECURE    =FLAB(22).(15:1)#,<< FILE SECURE BIT >>                     02040000
FLCREATE    =FLAB(23)#,       << CREATE DATE >>                         02042000
FLLASTACC   =FLAB(24)#,       << LAST ACCESS DATE >>                    02044000
FLLASTMOD   =FLAB(25)#,       << LAST MODIFICATION DATE >>              02046000
FLFILECODE  =FLAB(26)#,       << FILE CODE >>                           02048000
FLFCBVECT   =FLAB(27)#,       << FCB VECTOR >>                          02050000
FLLOCK      =FLAB(28)#,       << LOCK BITS, ETC. >>                     02052000
FLSTORE     =FLAB(28).(0:1)#, << FILE BEING STORED >>                   02054000
FLRESTORE   =FLAB(28).(1:1)#, << FILE BEING RESTORED >>                 02056000
FLLOAD      =FLAB(28).(2:1)#, << FILE LOADED >>                         02058000
FLEXCL      =FLAB(28).(3:1)#, << EXCLUSIVE FOPEN >>                     02060000
FLSR        =FLAB(28).(0:2)#, << STORE & RESTORE BITS >>                02062000
FLSRL       =FLAB(28).(0:3)#, << STORE, RESTORE & LOAD BITS >>          02064000
FLSRLX      =FLAB(28).(0:4)#, << STORE, RESTORE, LOAD & EXCL >>         02066000
FLSUBTYPE   =FLAB(28).(4:4)#, << SUB TYPE >>                            02068000
FLDTYPE     =FLAB(28).(8:6)#, << DEVICE TYPE >>                         02070000
FLSTATUS    =FLAB(28).(14:2)#,<< WRITE/READ STATUS >>                   02072000
FLUSERLBL   =FLAB(29)#,       << USER LABEL >>                          02074000
FLLBLEOF    =FLAB(29).(0:8)#, << # LBLS WRITTEN >>                      02076000
FLLBL       =FLAB(29).(8:8)#, << # OF USER LABELS >>                    02078000
FLFLIM      =FLABDBL(15)#,    << FILE LIMIT >>                          02080000
FLPVINFO    =FLAB (33) #,     << PVINFO FROM MOUNT>>                    02082000
FLMVTABX    =FLPVINFO.(4:4) #,<< MOUNTED VOL TABLE INDEX>>              02084000
FLCHECKSUM  =FLAB(34)#,       << FILE LABEL CHECKSUM >>                 02086000
FLCLID      =FLAB(35)#,       << COLD LOAD ID >>                        02088000
FLFOPTIONS  =FLAB(36)#,       << FOPTIONS >>                            02090000
FLRECSIZE   =FLAB(37)#,       << RECORD SIZE >>                         02092000
FLBLKSIZE   =FLAB(38)#,       << BLOCK SIZE >>                          02094000
FLSECTOFF   =FLAB(39).(0:8)#, << SECTOR OFFSET TO DATA >>               02096000
FLNUMEXTS   =FLAB(39).(11:5)#,<< NUMBER OF EXTENTS - 1 >>               02098000
FLLASTEXTSIZE=FLAB(40)#,      << LAST EXTENT SIZE >>                    02100000
FLEXTSIZE   =FLAB(41)#,       << EXTENT SIZE >>                         02102000
FLEOF       =FLABDBL(21)#,    << END-OF-DATA POINTER >>                 02104000
FLLABEL     =FLABDBL(22)#,    << FILE LABEL VTAB AND SECTOR # >>        02106000
FLVTAB      =FLAB(44).(0:8)#, << FILE LABEL VTAB INDEX >>               02108000
FLEXTMAP    =FLAB(44)#,       << ORIGIN OF EXTENT MAP >>                02110000
FLALLOCTIME =FLABDBL(54)#,    <<RESTORE TIME>>                          02112000
FLALLOCDATE =FLAB(110)#,      <<RESTORE DATE>>                          02114000
FLSTART     =FLABDBL(56)#,    <<BLOCK # OF CURRENT READ DATA BLOCK>>    02116000
FLEND       =FLABDBL(57)#,    <<BLOCK # OF CURRENT WRITE DATA BLOCK>>   02118000
FLNUMOPENCLSREC                                                         02120000
            =FLABDBL(58)#,    <<NUM OF HEADER RECORDS>>                 02122000
FLDEVNAME   =FLAB(124)#;      << DEVICE SPECIFICATION NAME >>           02124000
                                                                        02126000
$PAGE "MESSAGE FILE DEFINITIONS."                                       02128000
<<---------------------------------------------------------------       02130000
*                                                               *       02132000
* MESSAGE FILE DEFINTIONS                                       *       02134000
*                                                               *       02136000
--------------------------------------------------------------->>       02138000
                                                                        02140000
                                                                        02142000
<<* * * Record Prefix Definitions * * *>>                               02144000
                                                                        02146000
equate                                                                  02148000
block'overheadw= 2,             <<# words for block delimiter>>         02150000
record'delim   = -1,            <<Denotes end of data rec for block>>   02152000
rec'prefixw    = 1,             <<# words in record prefix (for count)>>02154000
magic'numberb  = 3;             <<Record prefix + byte round up>>       02156000
                                                                        02158000
                                                                        02160000
<<* * * Record Header Definitions * * *>>                               02162000
                                                                        02164000
equate                                                                  02166000
header'sizeb   = 4,             <<Length of the record header>>         02168000
header'sizew   = 2,                                                     02170000
data'record    = 0,             <<Data record's type>>                  02172000
open'record    = 1,             <<Open record's type>>                  02174000
close'record   = 2,             <<Close record's type>>                 02176000
xport'close'rec= 3,             <<Transport error close>>               02178000
max'header'type= 3,             <<Maximum value of the hdr type>>       02180000
header'delim   = %77;           <<Denotes end of hdrs for this block>>  02182000
                                                                        02184000
define  <<Refer to header definitions in ACB A for field descriptions>> 02186000
HDcrash        =Header.(0:1)#,                                          02188000
crash'bit      =(0:1)#,                                                 02190000
HDLastClose    =Header.(1:1)#,                                          02192000
HDType         =Header.(8:8)#,                                          02194000
HDID           =Header(-1)#;    <<Writer's I.D.>>                       02196000
                                                                        02198000
                                                                        02200000
<<* * * Basic IPC Definitions * * *>>                                   02202000
                                                                        02204000
equate                                                                  02206000
fifo           = 0,             <<Queue to the tail of msg list>>       02208000
delete'msg     = 0,             <<Take the received msg off the queue>> 02210000
no'delete      = 2,             <<Do not delete the returned msg>>      02212000
enable'int     = 4,             <<if soft int armed, then enable them>> 02214000
no'wait        = 0,             <<Return if no msg>>                    02216000
no'secure      = 2,             <<Any process can read/close>>          02218000
num'msgs       = 0,             <<Return the # msgs outstanding>>       02220000
current'timeout= 1,             <<Return timeout left of head entry>>   02222000
soft'int'index = 0,             <<Info type of soft interrupt>>         02224000
msg'lengthw    = 5,             <<Max words allowed in a msg>>          02226000
msg'lengthw'   = msg'lengthw-1;                                         02228000
                                                                        02230000
                                                                        02232000
<<* * * Basic IPC Message Formats * * *>>                               02234000
                                                                        02236000
define                                                                  02238000
MsgStructure   =array Msg(0:msg'lengthw')=q;                            02240000
                logical lmsg1=msg+1;                                    02242000
                integer msg1=msg+1,msg2=msg+2,msg3=msg+3,msg4=msg+4#,   02244000
                                                                        02246000
<<Wait message>>                                                        02248000
MsgID          =msg#,           <<ID of the writer>>                    02250000
MsgLocalFlags  =lmsg1#,         <<Flags which differ from               02252000
                                  accessor to accessor>>                02254000
MsgJustOpened  =lmsg1.(0:1)#,   <<Accessor just opened the file>>       02256000
MsgVirgin      =lmsg1.(3:1)#,   <<1=writer has not written a record>>   02258000
MsgExtendWait  =lmsg1.(1:1)#,   <<Will wait on boundary condition       02260000
                                  if no symbiotic process>>             02262000
MsgByteTlog    =lmsg1.(4:1)#,   <<Trans log in bytes>>                  02264000
MsgControl     =lmsg1.(8:8)#,   <<Carriage control code>>               02266000
MsgTargetDST   =msg2#,          <<DST # of the data buffer>>            02268000
MsgTarget      =msg3#,          <<Address of the data buffer>>          02270000
MsgLength      =msg4#,          <<Length of the data buffer>>           02272000
                                                                        02274000
<<Reply message>>                                                       02276000
MsgErrorCode   =msg#,           <<Resultant error code>>                02278000
MsgTlog        =msg(1)#,        <<Resultant transmission log>>          02280000
                                                                        02282000
MsgErrorCode'  =msg#,           <<Accessing as an array>>               02284000
MsgTlog'       =msg(1)#;                                                02286000
                                                                        02288000
                                                                        02290000
<<* * * MMSTAT Definitions * * *>>                                      02292000
                                                                        02294000
equate                                                                  02296000
<<Entry type>>                                                          02298000
trace'group1   = -58,           <<Primary trace group>>                 02300000
trace'group2   = -59,           <<Aux trace group>>                     02302000
                                                                        02304000
<<Group one>>                                                           02306000
MMread'init    = %00,           <<Read initiate>>                       02308000
MMread'compltn = %01,           <<Read completion>>                     02310000
MMwrite'init   = %02,           <<Write initiation>>                    02312000
MMwrite'compltn= %03,           <<Write completion>>                    02314000
MMcontrol      = %04,           <<Control completion>>                  02316000
MMeof          = %05,           <<Write end-of-file>>                   02318000
MMopen         = %06,           <<Open>>                                02320000
MMclose        = %07,           <<Close>>                               02322000
MMinit         = %10,           <<Initiation>>                          02324000
                                                                        02326000
<<Group 2>>                                                             02328000
MMput'record   = %20,           <<Write rec to file's tail>>            02330000
MMindex'record = %21,           <<Delete head record>>                  02332000
MMdelete'block = %22;           <<Delete head block>>                   02334000
                                                                        02336000
<<Flags Word of MMSTAT Entry>>                                          02338000
define                                                                  02340000
Tsubgroup      =tos.(0:4)#,     <<Sub-group number>>                    02342000
TFileState     =tos.(4:2)#,     <<File state                            02344000
                                  0 - empty                             02346000
                                  1 - not empty or full                 02348000
                                  2 - only partial free rec left        02350000
                                  3 - no free space whatsoever>>        02352000
TOutReads      =tos.(6:1)#,     <<Nonzero indicates one or more         02354000
                                  outstanding, unsatisfied read>>       02356000
TWaitQueue     =tos.(7:1)#,     <<State of the wait queue               02358000
                                  0 - queue empty                       02360000
                                  1 - one or more writers waiting>>     02362000
TCarriageCtl   =tos.(11:1)#,    <<Carriage control field (valid only    02364000
                                  for writer>>                          02366000
TLocalFlags    =tos.(12:4)#;    <<Local flags                           02368000
                                  (12:1) - just opened                  02370000
                                  (13:1) - extended wait                02372000
                                  (14:1) - nondestructive read          02374000
                                  (15:1) - virgin writer>>              02376000
                                                                        02378000
<<Misc MMSTAT stuff>>                                                   02380000
equate                                                                  02382000
empty          = 0,             <<File state values>>                   02384000
nonempty       = 1,                                                     02386000
almost'full    = 2,                                                     02388000
full           = 3;                                                     02390000
                                                                        02392000
define                                                                  02394000
ErrorAndReadID = ErrorCode&lsl(8)+AaHeaderID.(8:8)#,                    02396000
ErrorAndReadbID= ErrorCode&lsl(8)+AbHeaderID.(8:8)#,                    02398000
ErrorAndAaID   = ErrorCode&lsl(8)+AaID.(8:8)#,                          02400000
ErrorAndAbID   = ErrorCode&lsl(8)+AbID.(8:8)#,                          02402000
trace'group    = (11:1)#,       <<Entry type subfields>>                02404000
trace'subgroup = (12:4)#;                                               02406000
                                                                        02408000
                                                                        02410000
<<* * * Miscellaneous * * *>>                                           02412000
                                                                        02414000
equate                                                                  02416000
req'initiation = 1,                                                     02418000
user'int       = 0,                                                     02420000
file'soft'int  = 1,                                                     02422000
weight         = true,                                                  02424000
no'weight      = false,                                                 02426000
no'wait'done   = -1,                                                    02428000
soft'int'pend  = -2,                                                    02430000
no'cctl        = 1,                                                     02432000
port'wake      = 4,                                                     02434000
maxIDindex     = 16,                                                    02436000
maxIDindex'    = maxIDindex-1,                                          02438000
no'symbiote   = -1,                                                     02440000
remain'active  = 0,                                                     02442000
ownSeg         = -3,                                                    02444000
lAcbType       = 3, <<** should have its own type>>                     02446000
aft'entry'size = 4,                                                     02448000
                                                                        02450000
<<AFT definitions>>                                                     02452000
aft'size       = 4,                                                     02454000
reply'port'loc = 3,                                                     02456000
                                                                        02458000
                                                                        02460000
<<FCABORTREQUESTS return values>>                                       02462000
IOaborted      = 0,                                                     02464000
IOcompleted    = 1,                                                     02466000
noIOpending    = 2,                                                     02468000
                                                                        02470000
<<I/O definitions>>                                                     02472000
readIO         = 0,                                                     02474000
writeIO        = 1,                                                     02476000
goodIOstatus   = 1;                                                     02478000
$PAGE "ACCESS CONTROL BLOCK DEFINITIONS."                               02480000
<<---------------------------------------------------------------       02482000
*                                                               *       02484000
*  ACCESS CONTROL BLOCK (ACB) DEFINITIONS                       *       02486000
*                                                               *       02488000
--------------------------------------------------------------->>       02490000
                                                                        02492000
equate                                                                  02494000
fs'overhead     = 5,                                                    02496000
                                                                        02498000
acb'loc         = -63,                                                  02500000
sizeACB         = 48,                                                   02502000
no'write'size   = 10,                                                   02504000
write'size      = sizeACB-no'write'size,                                02506000
pacbx'loc       = 73,                                                   02508000
pacbx'size      = 18,                                                   02510000
pointers'size   = 9,                                                    02512000
                                                                        02514000
lacbx'loc       = 16,                                                   02516000
lacbx'size      = 9,                                                    02518000
                                                                        02520000
max'buf         = 16,                                                   02522000
acb'buf'size    = sizeACB+pointers'size+7+pacbx'size+lacbx'size+max'buf,02524000
pacbIDloc       = 48,                                                   02526000
max'pacbx'size' = pacbx'size+lacbx'size+max'buf,                        02528000
pacb'msg'size   = 50;     <<Entire length of msg file ext, w/o buf>>    02530000
                                                                        02532000
Define                                                                  02534000
AaxStructure   =array Acbx(0:max'pacbx'size')=q;                        02536000
                integer pointer Acb#;                                   02538000
                                                                        02540000
equate                                                                  02542000
file'sir       = %45;  << File sir >>                                   02544000
                                                                        02546000
                                                                        02548000
<<* * * Indirect Addressing ACB Defines * * *>>                         02550000
                                                                        02552000
                                                                        02554000
DEFINE                                                                  02556000
AbxDataStructure=double pointer Acbd=Acb;                               02558000
                 pointer Lacb=Acb#,                                     02560000
                                                                        02562000
AbStart        =Acb#,                                                   02564000
AbSize         =Acb.(2:14)#,    <<Size of ACB (incl). buffs>>           02566000
AbFNum         =Acb(1).(8:8)#,  <<File number>>                         02568000
AbName         =Acb(2)#,        <<File name>>                           02570000
AbName1        =Acb(2)#,        <<File name - first half>>              02572000
AbName2        =Acb(3)#,        <<File name - second half>>             02574000
AbFoptions     =Lacb(6)#,       <<FOPTIONS>>                            02576000
AbAoptions     =Lacb(7)#,       <<AOPTIONS>>                            02578000
AbRSize        =Acb(8)#,        <<Record size (bytes>>                  02580000
AbBSize        =Acb(9)#,        <<Block size (words>>                   02582000
                                                                        02584000
AbCtl          =Acb(11)#,       <<Carriage control word>>               02586000
                                                                        02588000
Abtarget       =Acb(12)#,       <<nowait I/O target>>          <<06076>>02590000
                                                                        02592000
AbTcount       =Acb(13)#,       <<nowait I/O tcount>>          <<06076>>02594000
AbTapeError    =Lacb(13).(4:1)#,<<Report recovered tape error>>         02596000
AbInhibCrLf    =Lacb(13).(5:1)#,<<Inhibit terminal CR/LF>>              02598000
AbMuiesce      =Lacb(13).(6:1)#,<<Critical output verify>>              02600000
AbStopChar     =Lacb(13).(8:8)#,<<Terminal stop character>>             02602000
                                                                        02604000
AbError        =Acb(14)#,       <<Error code>>                          02606000
AbTlog         =Acb(15)#,       <<Last I/O transmission log>>           02608000
                                                                        02610000
AbNumRecords   =Acbd(8)#,       <<Total number of unread records>>      02612000
AbNumRecLSW    =Acb(17)#,       <<Least sig word of number of records>> 02614000
                                                                        02616000
AbWriteBlock   =Acbd(9)#,       <<Block number of file's tail>>         02618000
AbRtfrCt       =Acbd(10)#,      <<Logical record transfer count>>       02620000
AbBtfrCt       =Acbd(11)#,      <<Block transfer count>>                02622000
AbReadHeader   =Acb(24)#,       <<DST rel addr of read header>>         02624000
AbWriteHeader  =Acb(25)#,       <<DST rel addr of write header>>        02626000
                                                                        02628000
AbFcb          =Acb(26)#,       <<FCB vector>>                          02630000
AbFcbDST       =acb(26).(6:10)#,<<FCB DST number>>                      02632000
AbFcbCBTabAddr =(acb(26))&lsr(10)&lsl(2)+fs'overhead#,                  02634000
                                                                        02636000
AbShCnts       =Acb(28)#,       <<LAcb( counts>>                        02638000
AbShCntIn      =Acb(28).(0:8)#, <<# of Read LAcb(s>>                    02640000
AbShCnt        =Acb(28).(8:8)#, <<# of LAcb(s>>                         02642000
AbNumReaders   =AbShCntIn#,     <<Number of open readers>>              02644000
AbNumWriters   =(AbShCnt-AbShCntIn)#,                                   02646000
                                                                        02648000
AbStatW        =Acb(29)#,       <<Access class, status, etc.>>          02650000
AbBreak        =Acb(29).(1:1)#, <<Break ($STDIN/LIST only)>>            02652000
AbDType        =Acb(29).(2:6)#, <<Device type>>                         02654000
AbAccCl        =Acb(29).(2:3)#, <<Device access class>>                 02656000
AbSubCl        =Acb(29).(5:3)#, <<Device sub-class>>                    02658000
AbStatus       =Acb(29).(8:8)#, <<Last logical I/O status>>             02660000
AbMStatus      =Acb(29).(8:5)#, <<Qualifying status part>>              02662000
AbGStatus      =Acb(29).(13:3)#,<<General status part>>                 02664000
                                                                        02666000
AbMStW         =Acb(30)#,       <<Global state flags>>                  02668000
AbNoWaitEOF    =Acb(30).(0:1)#, <<EOF advanced?>>                       02670000
AbNoWaitMode   =Acb(30).(1:1)#, <<Last I/O: 0=read, 1=write>>           02672000
AbAbortRead    =Acb(30).(2:1)#, <<Abort broken re-read?>>               02674000
AbNewEOF       =Acb(30).(3:1)#, <<EOF advanced - tape file>>            02676000
AbSaveEOFs     =Acb(30).(4:2)#, <<For saving AbEOFS>>                   02678000
AbEOFs         =Acb(30).(6:2)#, <<EOF flags - :EOD/:>>                  02680000
AbBlkFact      =Acb(30).(8:8)#, <<Records/block>>                       02682000
                                                                        02684000
AbPriv         =Acb(31).(0:1)#, <<Privileged access only>>              02686000
AbHit          =Acb(31).(1:1)#, <<Buffer hit flag>>                     02688000
AbWriteBufx    =Acb(31).(4:4)#, <<Writer's index into buffer array>>    02690000
AbNumBufs      =Acb(31).(12:4)#,<<Number of buffers less 1>>            02692000
                                                                        02694000
AbReadAddr     =Acb(32)#,       <<DST rel addr of next read rec>>       02696000
AbBufSize      =Acb(33)#,       <<Buffer size (words>>                  02698000
AbXxxx         =Acb(34)#,       <<Spare>>                               02700000
AbFMAVTx       =Acb(35)#,       <<FMAVT index>>                         02702000
AbVdAddr       =Acb(36)#,       <<Volume table index>>                  02704000
                                                                        02706000
AbDnTD         =Acb(37)#,       <<Type & disposition>>                  02708000
AbDnType       =Acb(37).(0:8)#, <<Name type for dir). search>>          02710000
AbDisp         =Acb(37).(8:8)#, <<File disposition>>                    02712000
AbAccess       =Acb(38).(0:8)#, <<Access mask>>                         02714000
AbDAddr        =Acb(38).(8:8)#, <<Logical device number>>               02716000
                                                                        02718000
<<* * * Msg file portion of standard ACB * * *>>                        02720000
                                                                        02722000
AbMsgStart     =Acb(39)#,                                               02724000
                                                                        02726000
<<Misc Msg Files Stuff>>                                                02728000
AbZero         =acb(39).(0:1)#, <<Must be set to zero (spoolfile)>>     02730000
AbNumReadBuf   =acb(39).(1:4)#, <<Number of read buffers>>              02732000
AbNumWriteBuf  =acb(39).(5:4)#, <<Number of write buffers>>             02734000
AbExtendRead   =Lacb(39).(9:1)#,<<Read open/close records>>             02736000
AbWaitWriters  =Lacb(39).(10:1)#,<<Queued writer requests>>             02738000
AbMWaitMsg     =Lacb(39).(11:1)#,<<1 - msg in ACB message area>>        02740000
AbMComplMsg    =Lacb(39).(12:1)#,<<1 - ACB completion msg>>             02742000
AbDirtyBlock   =Lacb(39).(13:1)#,<<1, the current write                 02744000
                                   block has its dirty                  02746000
                                   bit set>>                            02748000
AbNonZeroOrigin=Lacb(39).(14:1)#,<<0 - start of file is block zero>>    02750000
AbBufFilled    =Lacb(39).(15:1)#,<<0 - buffers have not been filled>>   02752000
AbBufNotFilled =(not Lacb(39))#,                                        02754000
                                                                        02756000
<<File Space>>                                                          02758000
AbFreeRecords  =Acbd(20)#,      <<Number of free records>>              02760000
AbFreeRecLSW   =Acb(41)#,       <<Least sig word of # of free records>> 02762000
AbFreeWords    =Acb(42)#,       <<Number of available words in current  02764000
                                  record (including record overhead).>> 02766000
AbWriteAddr    =Acb(43)#,       <<DST rel addr of next write rec>>      02768000
                                                                        02770000
AbNumOpenClsRec=Acbd(22)#,      <<# of nondata records in file>>        02772000
                                                                        02774000
AbNumPendOpens =Acb(46).(0:8)#, <<#of open records w/o closes>><<03036>>02776000
                                                               <<03036>>02778000
AbNumReadsPend =Acb(46).(8:8)#, <<# of outstanding read reqs     HM.10  02780000
                                  that have claim to an outstanding     02782000
                                  record).  Includes readers on         02784000
                                  wait queue.>>                         02786000
                                                                        02788000
AbReadError    =Acb(47).(0:8)#, <<Last read access error>>              02790000
AbWriteError   =Acb(47).(8:8)#, <<Last write access error>>             02792000
                                                                        02794000
AbIDMap        =Acb(48)#,       <<ID map (only in PACB)>>               02796000
                                                                        02798000
<<* * * Pointers * * *>>                                                02800000
                                                                        02802000
AbPacbDST      =Acb(48)#,       <<DST # of Physical ACB>>               02804000
AbPacbAddr     =Acb(49)#,       <<DST rel addr of Physical ACB>>        02806000
AbLacbDST      =Acb(50)#,       <<DST # of logical ACB>>                02808000
AbLacbAddr     =Acb(51)#,       <<DST rel addr of logical ACB>>         02810000
AbAcbAddr      =Acb(52)#,       <<DST rel addr of stack ACB>>           02812000
AbDbOffset     =Acb(53)#,       <<Stack DST rel addr of DB>>            02814000
AbCBTab        =Acb(54)#,       <<Physical ACB control block            02816000
                                  vector table entry addr>>             02818000
AbPacbCbTabAddr=Acb(55)#,       <<PACB control block vector table addr>>02820000
AbTargetDST    =Acb(56)#,       <<Target area DST )#>>                  02822000
                                                                        02824000
<<Words 57 - 59 are reserved for calling parameters>>                   02826000
                                                                        02828000
AbWakePin      =Acb(58)#,       <<Output parameter, if nonzero          02830000
                                  then must wake up the process         02832000
                                  by FREAD/FWRITE code>>                02834000
<<Words 60 - 63 are reserved for the stack marker>>                     02836000
                                                                        02838000
                                                                        02840000
<<* * * LACB Extension * * *>>                                          02842000
                                                                        02844000
AbLacbx        =Acb(64)#,                                               02846000
AbLacbExtension=Acb(64)#,       <<First word of LACB extension>>        02848000
AbSoftIntPlabel=Acb(64)#,       <<Plabel of user's soft interrupt       02850000
                                  procedure.>>                          02852000
AbTimeout      =Acb(65)#,       <<# seconds to wait on boundary condtn>>02854000
AbLocalFlags   =Lacb(66)#,      <<Flags which are local to accessor>>   02856000
AbLocalTFlags  =Acb(66).(0:4)#,                                         02858000
AbJustOpened   =Lacb(66).(0:1)#,<<Accessor just opened the file>>       02860000
Abextendwait   =Lacb(66).(1:1)#,<<Will wait on boundary condition       02862000
                                  even if no symbiotic process>>        02864000
AbNonDestruct  =Lacb(66).(2:1)#,<<Don't delete record on next read re>> 02866000
AbVirgin       =Lacb(66).(3:1)#,<<1 =writer has not written a record>>  02868000
AbByteTlog     =Lacb(66).(4:1)#,<<Transmission log in bytes>>           02870000
AbCloseType    =Lacb(66).(5:1)#,<<Close record code                     02872000
                                  0 - normal close                      02874000
                                  1 - transport error                   02876000
                                  Note: no current way to set this bit>>02878000
AbNoWaitDone   =Lacb(66).(6:1)#,<<Compltn msg in LACB>>                 02880000
AbControlByte  =Acb(66).(8:8)#, <<Carriage control byte>>               02882000
                                                                        02884000
AbReplyPort    =Acb(67)#,       <<Accessor's msg reply port.>>          02886000
AbID           =Acb(68)#,       <<Writer's ID>>                         02888000
AbWriteCB      =Acb(69)#,       <<CB vector for writer's rec buf>>      02890000
AbWriteCBDST   =Acb(69).(6:10)#,<<DST # for writer's rec buf>>          02892000
AbWriteCBAddr  =Acb(70)#,       <<DST rel address of writer's rec buf>> 02894000
AbJustOpenedWaitDisabled =Lacb(65).(7:1)#,<< Wait disabled   >><<04139>>02898000
                                 <<but just opened.          >><<04139>>02900000
                                                                        02902000
<<No wait/soft interrupt return status.  Used when the completion       02904000
  occurs at initiation time.>>                                          02906000
AbCmplError    =Acb(71)#,       <<Resultant error code>>                02908000
AbCmplTlog     =Acb(72)#,       <<Resultant transmission log>>          02910000
                                                                        02912000
<<* * * Extended ACB * * *>>                                            02914000
                                                                        02916000
AbPacbExtension=Acb(73)#,       <<Start of PACB extension>>             02918000
AbWriteQueue   =Acb(73)#,       <<Port # of write queue.>>              02920000
AbReadQueue    =Acb(74)#,       <<Port # of read queue.>>               02922000
                                                                        02924000
                                                                        02926000
<<Head Record Descriptors>>                                             02928000
AbRecLengthb   =Acb(75)#,       <<Length of record in bytes>>           02930000
AbHeader       =Acb(76)#,       <<Type of record (data, opn, cls>>      02932000
AbHeaderId     =Acb(77)#,       <<Record's writer ID>>                  02934000
AbHeaderCrash  =Lacb(78).(0:1)#,<<A one indicates that the system       02936000
                                  crashed after this record written).   02938000
                                  This bit is set by the first          02940000
                                  opener after the crash.>>             02942000
AbLastClose    =Lacb(78).(1:1)#,<<Set if last close, valid only for     02944000
                                  close records>>                       02946000
AbHeaderType   =Acb(78).(8:8)#, <<Type of record                        02948000
                                  0   - open                            02950000
                                  1   - data                            02952000
                                  2   - close                           02954000
                                  3   - Transport error close           02956000
                                  77  - header delimiter>>              02958000
                                                                        02960000
AbFullRecSizew =Acb(79)#,       <<Size of rec + count + header words>>  02962000
                                                                        02964000
<<Wait Queue Message>>                                                  02966000
AbMComplID     =Acb(80).(0:8)#, <<Completor ID>>                        02972000
AbMID          =Acb(80).(8:8)#, <<Waiter ID>>                           02974000
AbMMsg1        =Acb(81)#,                                               02976000
AbMLocalFlags  =Acb(81)#,       <<Local flags - see AbLocalFlags>>      02978000
AbMExtendWait  =Lacb(81).(1:1)#,                                        02980000
AbMDST         =Acb(82)#,       <<Target DST number>>                   02982000
AbMTarget      =Acb(83)#,       <<DST relative addr of target area>>    02984000
AbMLength      =Acb(84)#,       <<Length of target area>>               02986000
AbMReplyPort   =Acb(85)#,       <<Waiter's reply port, 0 if using ACB   02988000
                                  completion msg area>>                 02990000
AbMPin         =Acb(86)#,       <<Waiting process's pin>>               02992000
AbMFNum        =Acb(87)#,       <<Waiter's file number>>                02994000
AbMSoftIntPlabel=Acb(88)#,      <<Waiter's soft interrupt plabel>>      02996000
                                                                        02998000
<<Reply Message>>                                                       03000000
AbMError       =Acb(89)#,       <<Resultant error code>>                03002000
AbMTlog        =Acb(90)#,       <<Resultant transmission log>>          03004000
                                                                        03008000
<<Buffer Address Array>>                                                03010000
AbFirstBuf     =Acb(91)#,       <<Buffer DST rel addr of first buffer>> 03012000
AbSecondBuf    =Acb(92)#;       <<Buffer DST rel addr of 2nd buffer>>   03014000
                                                                        03016000
                                                                        03018000
                                                                        03020000
<<* * * Direct Addressing Partial ACB Defines * * *>>                   03022000
                                                                        03024000
define                                                                  03026000
AaStart        =qm63#,                                                  03028000
AaFNum         =qm62.(8:8)#,  <<File number>>                           03030000
AaFoptions     =lqm57#,       <<FOPTIONS>>                              03032000
AaAoptions     =lqm56#,       <<AOPTIONS>>                              03034000
AaRSize        =qm55#,        <<Record size (bytes>>                    03036000
                                                                        03038000
AaCtl          =qm52#,        <<Carriage control word>>                 03040000
AaError        =qm49#,        <<Error code>>                            03042000
AaTlog         =qm48#,        <<Last I/O transmission log>>             03044000
                                                                        03046000
AaNumRecords   =qdm47#,       <<Total number of unread records>>        03048000
AaNumRecLSW    =qm46#,        <<Least sig word of number of records>>   03050000
AaShCntIn      =qm35.(0:8)#,  <<# of Read Opens>>                       03052000
AaShCnt        =qm35.(8:8)#,  <<# of Opens>>                            03054000
AaNumReaders   =AaShCntIn#,   <<Number of open readers>>                03056000
AaNumWriters   =(AaShCnt-AaShCntIn)#,                                   03058000
                                                                        03060000
AaReadAddr     =qm31#,        <<DST rel addr of next read rec>>         03062000
AaExtendRead   =lqm24.(9:1)#, <<Read open/close records>>               03064000
AaWaitWriters  =lqm24.(10:1)#,<<Queued writer requests>>                03066000
AaBufNotFilled =(not lqm24)#,                                           03068000
                                                                        03070000
AaFreeRecLSW   =qm22#,        <<Least sig word of # of free records>>   03072000
                                                                        03074000
AaNumReadsPend =qm17.(8:8)#,  <<# of outstanding read reqs       HM.10  03076000
                                that have claim to an outstanding       03078000
                                record.  Includes readers on            03080000
                                wait queue.>>                           03082000
                                                                        03084000
AaReadError    =qm16.(0:8)#,  <<Last read access error>>                03086000
AaWriteError   =qm16.(8:8)#,  <<Last write access error>>               03088000
                                                                        03090000
AaPacbDST      =qm15#,        <<DST # of Physical ACB>>                 03092000
AaTargetDST    =qm7#,         <<Target area DST #>>                     03094000
                                                                        03096000
AaSoftIntPlabel=q1#,          <<Accessor's soft interrupt procedure>>   03098000
AaTimeout      =q2#,          <<# seconds to wait on boundary condtn>>  03100000
AaJustOpened   =lq3.(0:1)#,   <<Accessor just opened the file>>         03104000
Aaextendwait   =lq3.(1:1)#,   <<Will wait on boundary condition         03106000
                                even if no symbiotic process>>          03108000
AaNonDestruct  =lq3.(2:1)#,   <<Don't delete record on next read req>>  03110000
AaVirgin       =lq3.(3:1)#,   <<1 =writer has not written a record>>    03112000
AaByteTlog     =lq3.(4:1)#,   <<Transmission log in bytes>>             03114000
AaJustOpenedWaitDisabled =lq3.(7:1)#, <<  Wait has been  >>    <<04139>>03116000
                              <<disabled, but just opened>>    <<04139>>03118000
AaControlByte  =q3.(8:8)#,    <<Carriage control byte>>                 03120000
                                                                        03122000
AaReplyPort    =q4#,          <<Accessor's msg reply port.>>            03124000
AaID           =q5#,          <<Writer's ID>>                           03126000
AaWriteCb      =q6#,          <<CB vector for writer's rec buf>>        03128000
AaWriteCBDST   =q6.(6:10)#,   <<DST # for writer's rec buf>>            03130000
AaWriteCBAddr  =q7#,          <<DST rel address of writer's rec buf>>   03132000
                                                                        03134000
AaWriteQueue   =q10#,         <<Port # of write queue.>>                03136000
AaReadQueue    =q11#,         <<Port # of read queue.>>                 03138000
                                                                        03140000
                                                                        03142000
<<Head Record Descriptors>>                                             03144000
AaRecLengthb   =q12#,         <<Length of record in bytes>>             03146000
AaHeader       =q13#,         <<Type of record (data, opn, cls>>        03148000
AaHeaderId     =q14#,         <<Record's writer ID>>                    03150000
AaHeaderCrash  =lq15.(0:1)#;  <<A one indicates that the system         03152000
                                crashed after this record written.      03154000
                                This bit is set by the first            03156000
                                opener after the crash.>>               03158000
                                                                        03160000
define                                                                  03162000
AcAoptions     =Aq0(AcbLoc+7)#,                                         03164000
AcRead         =(AcAoptions.(12:4)=0)#,                                 03166000
AcRSize        =Aq0(AcbLoc+8)#,                                         03168000
AcNumRecords0  =Aq0(AcbLoc+16)#,                                        03170000
AcNumRecords1  =Aq0(AcbLoc+17)#,                                        03172000
AcFcbDST       =aq0(AcbLoc+26).(6:10)#,                        <<03036>>03174000
AcFcbCBTabAddr =(aq0(AcbLoc+26))&lsr(10)&lsl(2)+fs'overhead#,  <<03036>>03176000
AcExtendRead   =(Aq0(AcbLoc+39).(9:1)=1)#,                              03178000
AcNumOpenCls0  =Aq0(AcbLoc+44)#,                                        03180000
AcNumOpenCls1  =Aq0(AcbLoc+45)#,                                        03182000
AcLacbDST      =Aq0(AcbLoc+50)#,                                        03184000
AcLacbAddr     =Aq0(AcbLoc+51)#;                                        03186000
                                                                        03188000
equate                                                                  03190000
soft'plabel'loc=16;                                                     03192000
                                                                        03194000
define                                                                  03196000
LxSoftIntPlabel=Lacbx#,         <<User's soft interrupt procedure>>     03198000
LxTimeout      =Lacbx(1)#,      <<# seconds to wait on boundary condtn>>03200000
LxLocalFlags   =Lacbx(2)#,      <<Flags which are local to accessor>>   03202000
LxLocalTFlags  =Lacbx(2).(0:4)#,                                        03204000
LxJustOpened   =Lacbx(2).(0:1)#,<<Accessor just opened the file>>       03206000
Lxextendwait   =Lacbx(2).(1:1)#,<<Will wait on boundary condition       03208000
                                  even if no symbiotic process>>        03210000
LxNonDestruct  =Lacbx(2).(2:1)#,<<Don't delete record on next read re>> 03212000
LxVirgin       =Lacbx(2).(3:1)#,<<1 =writer has not written a record>>  03214000
LxByteTlog     =Lacbx(2).(4:1)#,<<Transmission log in bytes>>           03216000
LxCloseType    =Lacbx(2).(5:1)#,<<Close record code                     03218000
                                  0 - normal close                      03220000
                                  1 - transport error                   03222000
                                  Note: no current way to set this bit>>03224000
LxControlByte  =Lacbx(2).(8:8)#, <<Carriage control byte>>              03226000
                                                                        03228000
LxReplyPort    =Lacbx(3)#,       <<Accessor's msg reply port.>>         03230000
LxID           =Lacbx(4)#,       <<Writer's ID>>                        03232000
LxWriteCB      =Lacbx(5)#,       <<CB vector for writer's rec buf>>     03234000
LxWriteCBDST   =Lacbx(6).(:10)#, <<DST # for writer's rec buf>>         03236000
LxWriteCBAddr  =Lacbx(6)#,       <<DST rel address of writer's rec buf>>03238000
LxComplError   =Lacbx(7)#,       <<Nowait IO completion error code>>    03240000
LxComplTlog    =Lacbx(8)#;       <<Nowait IO completion trans log>>     03242000
                                                                        03244000
                                                                        03246000
<<---------------------------------------------------------------       03248000
*                                                               *       03250000
*  BUFFER PREFIX (BLK) DEFINITIONS                              *       03252000
*                                                               *       03254000
--------------------------------------------------------------->>       03256000
                                                                        03258000
equate                                                                  03260000
buf'prefix'size=12;                                            <<04924>>03262000
                                                                        03264000
define  <<The block number field is not used by msg files>>             03266000
BlkIOQX     =Blk#,                <<IOQ entry nr.>>                     03268000
BlkFlags    =Blk(1).(13:3)#,      <<I/O flags>>                         03270000
BlkIoOut    =Blk(1).(13:1)#,      <<Last I/O was write?>>               03272000
BlkDirty    =Blk(1).(14:1)#,      <<Buffer modified?>>                  03274000
BlkIoPend   =Blk(1).(15:1)#,      <<I/O in progress?>>                  03276000
BlkIoComp   =Blk(1).(14:2)#,      <<I/O complete - not dirty>>          03278000
BlkIoCB     =BlkDbl(1)#,          <<IOCB>>                              03280000
BlkLStat    =Blk(2)#,             <<IOCB - STATUS>>                     03282000
BlkTLog     =Blk(3)#,             <<IOCB - transmission log>>           03284000
BlkDiscAddr =BlkDbl(3)#,          <<Block sector number>>      <<04924>>03286000
BlkLogDevice=Blk(6).(0:8)#,       <<Block logical device nr.>> <<04924>>03288000
BlkExtBase  =BlkDbl(4)#,          <<Block extent base.      >> <<04775>>03290000
BlkExtSize  =Blk(10)#,            <<Block extent size.      >> <<04775>>03292000
BlkDummy    =Blk(11)#;            <<Block dummy, not used.  >> <<04775>>03294000
                                                                        03296000
                                                                        03298000
                                                                        03300000
<<---------------------------------------------------------------       03302000
*                                                               *       03304000
*  AOPTIONS AND FOPTIONS DEFINITIONS                            *       03306000
*                                                               *       03308000
--------------------------------------------------------------->>       03310000
                                                                        03312000
                                                                        03314000
DEFINE                                                                  03316000
AaAcType       = AaAOPTIONS.(12:4)#,    << ACCESS TYPE >>               03318000
AaRead         = (AaACTYPE = 0)#,       << READ ONLY >>                 03320000
AaWait         = (AaAoptions.(4:1) = 0)#,<< WAIT I/O MODE >>            03322000
Abcopy         = AbAOPTIONS.(3:1)#,                                     03324000
AbNoWait       = AbAOPTIONS.(4:1)#,     << NO-WAIT I/O MODE >>          03326000
AbSemi         = (AbAoptions.(8:2)=2)#, << SEMI EXCLUSIVE ACCESS >>     03328000
AbShare        = (AbAoptions.(8:2)=3)#, << SHARE ACCESS >>              03330000
AbAcType       = AbAOPTIONS.(12:4)#,    << ACCESS TYPE >>               03332000
AbRead         = (AbACTYPE = 0)#,       << READ ONLY >>                 03334000
AbWrite        = (AbACTYPE = 1)#,       << WRITE ONLY - DEL >>          03336000
AaControl      = AaFOPTIONS.(7:1)#,     << CARRIAGE CONTROL >>          03338000
AaFormat       = AaFOPTIONS.(8:2)#,     << RECORD FORMAT >>             03340000
AaFixed        = (AaFORMAT = 0)#,       << FIXED >>                     03342000
AaAscii        = AaFOPTIONS.(13:1)#;    << ASCII/BINARY FMT >>          03344000
$PAGE "FILE CONTROL BLOCK DEFINITIONS."                                 03346000
<<---------------------------------------------------------------       03348000
*                                                               *       03350000
*  FILE CONTROL BLOCK (FCB) DEFINITIONS                         *       03352000
*                                                               *       03354000
--------------------------------------------------------------->>       03356000
                                                                        03358000
EQUATE                                                                  03360000
MAXEXTENTS  = 32,                                                       03362000
MAX'EMAP'SIZE                                                           03364000
            = MAXEXTENTS*2,                                             03366000
FCB'EOF'LOC = 22,                                                       03368000
SIZEBFCB    = 36,   << SIZE OF FCB LESS EXTENT MAP >>                   03370000
EXT'MAP'LOC = SIZEBFCB,                                                 03372000
SIZEDFCB    = MAX'EMAP'SIZE+SIZEBFCB;   << MAXIMUM DISC FCB >>          03374000
DEFINE                                                                  03376000
FCBDATASTRUCTURE=                                                       03378000
              INTEGER ARRAY FCB(0:SIZEBFCB);                            03380000
              POINTER LFCB=FCB; DOUBLE POINTER FCBDBL=FCB#,    <<03036>>03382000
FCBDATASTRUCT1=  <<MUST BE 1ST DECLARATION IN THE PROCEDURE>>  <<03036>>03384000
              INTEGER ARRAY FCB(0:SIZEBFCB)=Q;                 <<03036>>03386000
              ARRAY LFCB(*)=FCB; DOUBLE ARRAY FCBDBL(*)=FCB#;  <<03036>>03388000
                                                                        03390000
DEFINE                                                                  03392000
ALLOCFCB    = PUSH(S); @FCB := TOS+1; ASSEMBLE(ADDS SIZEDFCB)#;         03394000
                                                                        03396000
DEFINE                                                                  03398000
FCBSIZE     =FCB.(2:14)#,     << SIZE OF FCB >>                         03400000
FCBNEWFCBV  =FCB(1)#,         << NEW FCB VECTOR >>                      03402000
FCBFOPTIONS =FCB(2)#,         << FOPTIONS >>                            03404000
FCBDEVICE   =FCB(3)#,         << POS LDEV OR NEG DEV CLASS INDX>>       03406000
FCBlkST     =FCB(4).(0:2)#,   << PREVIOUS LOCK STATE >>                 03408000
FCBDTYPE    =FCB(4).(2:6)#,   << DEVICE TYPE - FIRST EXTENT >>          03410000
FCBSUBTYPE  =FCB(4).(12:4)#,  << DEVICE SUB-TYPE - FIRST EXTENT>>       03412000
FCBOCNTOUT  =FCB(5).(0:8)#,   << # PROCESSES ACCESSING - OUTPUT>>       03414000
FCBOCNT     =FCB(5).(8:8)#,   << # PROCESSES ACCESSING - ANY >>         03416000
FCBACB      =FCB(6)#,         << CREATOR ACB VECTOR >>                  03418000
FCBRIN      =FCB(7)#,         << RIN # >>                               03420000
FCBEXCLSTAT =FCB(8)#,         << EXCLUSIVE STATUS >>                    03422000
FCBPVINFO   =FCB (9) #,       << CLASSFLG,VMASK & MVTABX IF PV>>        03424000
FCBCLASSFLG =FCBPVINFO.(0:1)#,<< CLASSFLG >>                            03426000
FCBMVTABX   =FCBPVINFO.(4:4)#,<< MVTABX >>                              03428000
FCBVMASK    =FCVPVINFO.(8:8)#,<< VMASK >>                               03430000
FCBFLIM     =FCBDBL(5)#,      << MAXIMUM # BLOCKS >>                    03432000
FCBIMAGE    =FCBDBL(6)#,      << RESERVED FOR IMAGE >>                  03434000
FCBEOF      =FCBDBL(7)#,      << END OF DATA POINTER >>                 03436000
FCBUSERLBL  =FCB(16)#,        << USER LABELS >>                         03438000
FCBLBLEOF   =FCB(16).(0:8)#,  << # LBLS WRITTEN >>                      03440000
FCBLBL      =FCB(16).(8:8)#,  << # OF USER LABELS >>                    03442000
FCBEXTSIZE  =FCB(17)#,        << EXTENT SIZE >>                         03444000
FCBBlkFACT  =FCB(18).(0:8)#,  << BLOCKING FACTOR >>                     03446000
FCBSECTPBlk =FCB(18).(8:8)#,  << SECTORS PER BLOCK >>                   03448000
FCBSECTOFF  =FCB(19).(0:8)#,  << SECTOR OFFSET TO DATA >>               03450000
FCBDISP     =FCB (19).(8:3)#, << PENDING FILE DISPOSITION >>            03452000
FCBNUMEXTS  =FCB(19).(11:5)#, << NUMBER OF EXTENTS - 1>>                03454000
FCBLASTEXTSIZE=FCB(20)#,      << LAST EXTENT SIZE >>                    03456000
FCBOCNTIN   =FCB(21).(8:8)#,  << # PROCESSES ACCESSING - INPUT >>       03458000
FCBGN       =FCB(22)#,        << GROUP NAME >>                          03460000
FCBGN1      =FCBDBL(11)#,     << GROUP NAME - FIRST HALF >>             03462000
FCBGN2      =FCBDBL(12)#,     << GROUP NAME - SECOND HALF >>            03464000
FCBAN       =FCB(26)#,        << ACCOUNT NAME >>                        03466000
FCBAN1      =FCBDBL(13)#,     << ACCOUNT NAME - FIRST HALF >>           03468000
FCBAN2      =FCBDBL(14)#,     << ACCOUNT NAME - SECOND HALF >>          03470000
FCBSTART    =FCBDBL(15)#,     << STARTING BLOCK NUMBER>>                03472000
FCBSTARTLSW =FCB(31)#,        << LEAST SIG WORD OF START BLOCK >>       03474000
FCBEND      =FCBDBL(16)#,     << ENDING BLOCK NUMBER>>                  03476000
FCBENDLSW   =FCB(33)#,        << LEAST SIG WORD OF END BLOCK >>         03478000
FCBNUMOPENCLSRECS                                                       03480000
            =FCBDBL(17)#,     << NUM OF NONDATA RECORDS >>              03482000
FCBLABEL    =FCBDBL(18)#,     << FILE LABEL LDEV AND SECTOR # >>        03484000
FCBLDEV     =FCB(36).(0:8)#,  << FILE LABEL LDEV >>                     03486000
FCBEXTMAP   =FCB(36)#;        << EXTENT MAP >>                          03488000
                                                                        03490000
$IF X1=OFF                                                              03492000
$CONTROL NOLIST                                                         03494000
$IF                                                                     03496000
$PAGE "EXTERNAL PROCEDURES."                                            03498000
intrinsic DEBUG;                                                        03500000
                                                                        03502000
double procedure                                                        03504000
  ATTACHIO(ldev,qmisc,DSTx,addr,func,cnt,p1,p2,flags);                  03506000
value ldev,qmisc,DSTx,addr,func,cnt,p1,p2,flags;                        03508000
integer ldev,qmisc,DSTx,addr,func,cnt,p1,p2,flags;                      03510000
option external;                                                        03512000
                                                                        03514000
procedure AWAKE(PCBpt,condition,waitflag);                              03516000
value PCBpt,condition,waitflag;                                         03518000
integer PCBpt,waitflag;                                                 03520000
logical condition;                                                      03522000
option external;                                                        03524000
                                                                        03526000
procedure BUILDSTACKMARKER(loc,plabel);                                 03528000
value loc,plabel;                                                       03530000
integer loc,plabel;                                                     03532000
option external;                                                        03534000
                                                                        03536000
procedure                                                               03538000
   CAUSESOFTINT(pcbptr,type,subtype,plabel,msglength,flags);            03540000
value pcbptr,type,subtype,plabel,msglength,flags;                       03542000
integer pcbptr,type,subtype,plabel,msglength;                           03544000
logical flags;                                                          03546000
option external;                                                        03548000
                                                                        03550000
integer procedure CHECKTRAPLABEL(plabel,deltaq);                        03552000
value plabel,deltaq;                                                    03554000
integer plabel,deltaq;                                                  03556000
option external;                                                        03558000
                                                                        03560000
integer procedure DISKDEALLOC(extsize,lastextsize,numext,map);          03562000
value extsize,lastextsize,numext;                                       03564000
integer extsize,lastextsize,numext;                                     03566000
double array map;                                                       03568000
option external;                                                        03570000
                                                                        03572000
double procedure DIRECADJUST(numsects,dummy,                   <<06163>>03573010
                             aname,gname,mvtabx);              <<06163>>03573020
value numsects,dummy,mvtabx;                                   <<06163>>03573030
double numsects;                                               <<06163>>03573040
integer dummy,mvtabx;                                          <<06163>>03573050
array aname,gname;                                             <<06163>>03573060
option external,variable;                                      <<06163>>03573070
                                                               <<06163>>03573080
integer procedure EXCHANGEDB(DSTnumber);                                03574000
value DSTnumber;                                                        03576000
integer DSTnumber;                                                      03578000
option external;                                                        03580000
                                                                        03582000
integer procedure                                                       03584000
  FCMSGABORT(port'number,return'port,parameter'value);                  03586000
value port'number,return'port,parameter'value;                          03588000
integer port'number;                                                    03590000
logical return'port,parameter'value;                                    03592000
option variable,external;                                               03594000
                                                                        03596000
procedure FCONV'BLK(block,ldev,code,stx,fceof,extbase,extsize);<<04775>>03598000
value block,ldev,code,stx,fceof,extbase,extsize;               <<04775>>03600000
double block,fceof,extbase;                                    <<04775>>03602000
integer ldev,code,stx,extsize;                                 <<04775>>03604000
option external;                                                        03606000
                                                                        03608000
logical procedure FCPORTCLOSE(port'number);                             03610000
value port'number;                                                      03612000
integer port'number;                                                    03614000
option external;                                                        03616000
                                                                        03618000
procedure FCPORTCONTROL(port'number,info'type,info);                    03620000
value port'number,info'type;                                            03622000
integer port'number,info'type;                                          03624000
integer array info;                                                     03626000
option external;                                                        03628000
                                                                        03630000
procedure FCPORTDISABLE(port'number);                                   03632000
value port'number;                                                      03634000
integer port'number;                                                    03636000
option external;                                                        03638000
                                                                        03640000
logical procedure FCPORTENABLE(port'number);                            03642000
value port'number;                                                      03644000
integer port'number;                                                    03646000
option external;                                                        03648000
                                                                        03650000
integer procedure FCPORTOPEN(flags);                                    03652000
value flags;                                                            03654000
logical flags;                                                          03658000
option variable,external;                                               03660000
                                                                        03662000
integer procedure FCPORTRECEIVE(port'number,message,message'length,     03664000
  waitspec);                                                            03666000
value port'number,message,message'length,waitspec;                      03668000
integer port'number,message'length;                                     03670000
integer pointer message;                                                03672000
logical waitspec;                                                       03674000
option variable,external;                                               03676000
                                                                        03678000
integer procedure FCPORTSEND(port'number,message,message'length,        03680000
  return'port,timeout,queue'type);                                      03682000
value port'number,message,message'length,return'port,                   03684000
  timeout,queue'type;                                                   03686000
integer port'number,message'length,return'port,timeout,queue'type;      03688000
integer pointer message;                                                03690000
option variable,external;                                               03692000
                                                                        03694000
integer procedure FCPORTSTATUS(port'number,item'num);                   03696000
value port'number,item'num;                                             03698000
integer port'number,item'num;                                           03700000
option external;                                                        03702000
                                                                        03704000
procedure FCREATECB(cb,vector,strategy,size,type);                      03706000
value cb,vector,strategy,size,type;                                     03708000
integer cb,vector,strategy,size,type;                                   03710000
option external;                                                        03712000
                                                                        03714000
procedure FDELETECB(vector);                                            03716000
value vector;                                                           03718000
integer vector;                                                         03720000
option external;                                                        03722000
                                                                        03724000
integer procedure FLABIO(ldev,sector,func,Flab);                        03726000
value ldev,sector,func;                                                 03728000
integer ldev,func;                                                      03730000
double sector;                                                          03732000
integer array Flab;                                                     03734000
option external;                                                        03736000
                                                                        03738000
procedure FLABIOERR (flag,filenum,fganame);                             03740000
value flag,filenum,fganame;                                             03742000
logical flag;                                                           03744000
integer filenum,fganame;                                                03746000
option external,variable;                                               03748000
                                                                        03750000
procedure FRELCB(dst,vector,flags);                                     03752000
value dst,vector,flags;                                                 03754000
integer dst,vector;                                                     03756000
logical flags;                                                          03758000
option external;                                                        03760000
                                                                        03762000
integer procedure GETSIR(sirnum);                                       03764000
value sirnum;                                                           03766000
integer sirnum;                                                         03768000
option external;                                                        03770000
procedure HELP;                                                         03772000
option external;                                                        03774000
                                                                        03776000
integer procedure IOSTAT(IOQx);                                         03778000
value IOQx;                                                             03780000
integer IOQx;                                                           03782000
option external;                                                        03784000
                                                                        03786000
procedure READYPROCESS(pcbptr);                                         03788000
value pcbptr;                                                           03790000
integer pcbptr;                                                         03792000
option external;                                                        03794000
                                                                        03796000
procedure LDEVTOVTAB (target,source,count,local);                       03798000
value count,local;                                                      03800000
double array target,source;                                             03802000
integer count;                                                          03804000
logical local;                                                          03806000
option external;                                                        03808000
                                                                        03810000
procedure LOC'ACB(dstx,dq,filenum,flags,sir1,A);               <<04490>>03812000
value dstx,dq,filenum,flags,sir1,A;                            <<04490>>03814000
integer dstx,filenum,dq,sir1,A;                                <<04490>>03816000
logical flags;                                                          03818000
option external,variable;                                      <<04490>>03820000
                                                                        03822000
procedure LOCK'CB(flags,stackdst,stk'target,cbdst,cbofst);              03824000
value flags,stackdst,stk'target,cbdst,cbofst;                           03826000
integer flags,stackdst,stk'target,cbdst,cbofst;                         03828000
option external;                                                        03830000
                                                                        03832000
procedure MMSTAT(entrie,p0,p1,p2);                                      03834000
value entrie,p0,p1,p2;                                                  03836000
integer entrie,p0,p1,p2;                                                03838000
option external;                                                        03840000
                                                                        03842000
procedure RELSIR(sirnum,a);                                             03844000
value sirnum,a;                                                         03846000
integer sirnum,a;                                                       03848000
option external;                                                        03850000
                                                                        03852000
procedure RESETCRITICAL(oldcrit);                                       03854000
value oldcrit;                                                          03856000
integer oldcrit;                                                        03858000
option external;                                                        03860000
                                                                        03862000
integer procedure SETCRITICAL;                                          03864000
option external;                                                        03866000
                                                                        03868000
procedure SUDDENDEATH(deathnumber);                                     03870000
value deathnumber;                                                      03872000
integer deathnumber;                                                    03874000
option external;                                                        03876000
                                                                        03878000
procedure UNLOC'ACB(dq,flags);                                          03880000
value dq,flags;                                                         03882000
integer dq;                                                             03884000
logical flags;                                                          03886000
option external;                                                        03888000
                                                                        03890000
procedure UNLOCK'CB(flags,cbdst,cbofst);                                03892000
value flags,cbdst,cbofst;                                               03894000
integer flags,cbdst,cbofst;                                             03896000
option external;                                                        03898000
                                                                        03900000
procedure WAIT(waitflag,subpri);                                        03902000
value waitflag,subpri;                                                  03904000
integer waitflag;                                                       03906000
logical subpri;                                                         03908000
option external;                                                        03910000
                                                                        03912000
double procedure WAITFORIO(ioqx);                                       03914000
value ioqx;                                                             03916000
integer ioqx;                                                           03918000
option external;                                                        03920000
                                                                        03922000
double procedure CHECKFORECORDS(acb);                                   03924000
value acb;                                                              03926000
integer pointer acb;                                                    03928000
option forward;                                                         03930000
                                                                        03932000
logical procedure CHECKRECSPACE(Acb,JustOpened,RecLength);              03934000
value Acb,JustOpened,RecLength;                                         03936000
integer pointer Acb;                                                    03938000
logical JustOpened;                                                     03940000
integer RecLength;                                                      03942000
option forward;                                                         03944000
                                                                        03946000
procedure FREEWRITERS(Acb,NumRecords,NumWords);                         03948000
value Acb,NumRecords,NumWords;                                          03950000
integer pointer Acb;                                                    03952000
double NumRecords;                                                      03954000
integer NumWords;                                                       03956000
option forward;                                                         03958000
                                                                        03960000
integer procedure                                                       03962000
  PUTRECORD(acb,RecordType,CallerDST,target,user'length,control,id);    03964000
value acb,RecordType,CallerDST,target,user'length,control,id;           03966000
integer pointer acb;                                                    03968000
integer RecordType,CallerDST,target,user'length,control,id;             03970000
option forward;                                                         03972000
                                                                        03974000
double procedure FCGETVERSION;                                          03976000
option forward;                                                         03978000
$IF X1=OFF                                                              03980000
$CONTROL LIST                                                           03982000
$IF                                                                     03984000
$PAGE CONTROL "KERNEL PROCEDURES."                                      03986000
$CONTROL SEGMENT=IPC                                                    03988000
procedure HELPFUL;                                                      03990000
                                                                        03992000
<<Function                                                              03994000
  Provides an STT entry for the HELP Debugging Facility.>>              03996000
                                                                        03998000
option privileged,internal;                                             04000000
                                                                        04002000
begin                                                                   04004000
HELP;                                                                   04006000
end;  <<HELPFUL>>                                                       04008000
procedure UGLYMSGACCESS;                                                04010000
                                                                        04012000
<<Function                                                              04014000
  Called when an irrecoverable access error is encountered.>>           04016000
                                                                        04018000
<<Input                                                                 04020000
  None.>>                                                               04022000
                                                                        04024000
<<Output                                                                04026000
  None.>>                                                               04028000
                                                                        04030000
option privileged,internal;                                             04032000
                                                                        04034000
begin                                                                   04036000
equate                                                                  04038000
  ugly'msg'access             = 495;                                    04040000
                                                                        04042000
                                                                        04044000
$IF X2=ON                                                               04046000
DEBUG;                                                                  04048000
$IF                                                                     04050000
SUDDENDEATH(ugly'msg'access);                                           04052000
end;  <<UGLYMSGACCESS>>                                                 04054000
procedure MAKEMMSTAT(Acb,Type,Word1,Word2);                             04056000
value Acb,Type,Word1,Word2;                                             04058000
                                                                        04060000
<<Function                                                              04062000
  If required, an MMSTAT event is formatted and recorded.               04064000
  One of these two conditions must be met:                              04066000
    1. Global trace flag is on.                                         04068000
    2. Acb trace field indicates this event should be traced.>>         04070000
                                                                        04072000
<<Input>>                                                               04074000
  integer pointer                                                       04076000
    Acb;                <<Address of the Access Control Block.>>        04078000
  integer                                                               04080000
    Type,               <<Group number and subType.>>                   04082000
    Word1,Word2;        <<Type specific info of the MMSTAT event.>>     04084000
                                                                        04086000
<<Output                                                                04088000
  An MMSTAT event is conditionally recorded.>>                          04090000
                                                                        04092000
begin                                                                   04094000
AbxDataStructure;                                                       04096000
integer                                                                 04098000
  Event,Flags;                                                          04100000
define globTrace'flg = absolute(%1267)#;                       <<03036>>04102000
array MmstatEvent(0:1)=pb:=trace'group1,trace'group2;                   04104000
                                                                        04106000
                                                                        04108000
<<Check if tracing is enabled on this event type>>                      04110000
if globTrace'flg then                                                   04112000
  begin  <<Somebody wants this event traced>>                           04114000
  <<Build the flags word (word0)>>                                      04116000
  tos:=0;                                                               04118000
  Tsubgroup:=Type.trace'subgroup;                                       04120000
  if AbNumRecords > 0d then                                             04122000
    begin  <<File state is nonempty>>                                   04124000
    if AbFreeRecords = 0d then                                          04126000
      TfileState:=if AbFreeWords > 0 then almost'full else full         04128000
    else                                                                04130000
      TfileState:=nonempty;                                             04132000
    end;                                                                04134000
  if CHECKFORECORDS(Acb) < 0D then ToutReads:=1;                        04136000
  TwaitQueue:=AbWaitWriters;                                            04138000
  if AbControlByte <> no'cctl then TCarriageCtl:=1;                     04140000
  TLocalFlags:=AbLocalTFlags;                                           04142000
  Flags:=tos;                                                           04144000
                                                                        04146000
  <<Build event word>>                                                  04148000
  Event:=MmstatEvent(Type.trace'group);                                 04150000
                                                                        04152000
  <<Record the event>>                                                  04154000
  MMSTAT(Event,Flags,Word1,Word2);                                      04156000
  end;                                                                  04158000
end;  <<MAKEMMSTAT>>                                                    04160000
integer procedure GETEXTENTNUM(Fcb,BlockNum);                           04162000
value Fcb,BlockNum;                                                     04164000
                                                                        04166000
<<Function                                                              04168000
  Returns the extent number of the block.>>                             04170000
                                                                        04172000
<<Input>>                                                               04174000
  integer pointer                                                       04176000
    Fcb;                <<Address of the File Control Block.>>          04178000
  double                                                                04180000
    BlockNum;           <<Block number contained in the extent.>>       04182000
  <<DB                    Set to the File Control Block data segment.>> 04184000
                                                                        04186000
<<Output                                                                04188000
    GETEXTENTNUM          Extent number.                                04190000
    Condition codes                                                     04192000
      CCE                 Not the first block in the extent             04194000
      CCG                 First block in the extent                     04196000
      CCL                 Not returned>>                                04198000
                                                                        04200000
option privileged,internal;                                             04202000
                                                                        04204000
begin                                                                   04206000
double pointer                                                          04208000
  Fcbdbl=Fcb;                                                           04210000
double                                                                  04212000
  AbsBlockNum,BlockLimit;                                               04214000
                                                                        04216000
BlockLimit:=FcbFLim/(dbl(FcbBlkFact));                                  04218000
tos:=BlockNum+FcbStart;                                                 04220000
if Ds1 >= BlockLimit then Ds1:=Ds1-BlockLimit;                          04222000
AbsBlockNum:=Ds1;                                                       04224000
x:=FcbSectPBlk;                                                         04226000
mpyd;                                                                   04228000
tos:=tos+dbl(log(FcbSectOff));  <<Sector # of block>>                   04230000
tos:=FcbExtSize;                                                        04232000
asmb(ldiv);                                                             04234000
tos:=(if (tos=0 or AbsBlockNum=0d) then ccg else cce);                  04236000
CondCode:=tos;                                                          04238000
GETEXTENTNUM:=tos;                                                      04240000
end;  <<GETEXTENTNUM>>                                                  04242000
$PAGE "OBTAINING/RELEASING THE ACB."                                    04244000
integer procedure LOCEXTENDACB(AcbLoc,TargetDST,Target);                04246000
value AcbLoc,TargetDST,Target;                                          04248000
                                                                        04250000
<<Function                                                              04252000
  Fills in the Q+ area of the caller with the msg file extensions>>     04254000
                                                                        04256000
<<Input>>                                                               04258000
  integer                                                               04260000
    AcbLoc,             <<Addr of Acb relative to caller's q.>>         04262000
    TargetDST,          <<Data segment # of caller.>>                   04264000
    Target;             <<User's DB rel target address.>>               04266000
                                                                        04268000
<<Output                                                                04270000
    LOCEXTENDACB          Data seg rel target address.>>                04272000
                                                                        04274000
option privileged,internal;                                             04276000
                                                                        04278000
begin                                                                   04280000
integer pointer                                                         04282000
  Acb;                                                                  04284000
AbxDataStructure;                                                       04286000
                                                                        04288000
                                                                        04290000
<<Switch over to the stack>>                                            04292000
if TargetDST <> 0 then                                                  04294000
  begin                                                                 04296000
  LOCEXTENDACB:=Target;                                                 04298000
  EXCHANGEDB(0);                                                        04300000
  end;                                                                  04302000
@Acb:=@Aq0(AcbLoc)-DeltaQ;                                              04304000
if TargetDST = 0 then                                                   04306000
  begin                                                                 04308000
  AbTargetDST:=PCB'stk;                                                 04310000
  LOCEXTENDACB:=Target+AbDbOffset;                                      04312000
  end;                                                                  04314000
                                                                        04316000
<<Get the extended LACB>>                                               04318000
tos:=@AbLacbx;                                                          04320000
tos:=AbLacbDST;                                                         04322000
if <> then                                                              04324000
  begin  <<LACB exists (not in copy mode)>>                             04326000
  tos:=AbLacbAddr+lacbx'loc; tos:=lacbx'size;                           04328000
  asmb(mfds 4);                                                         04330000
  end;                                                                  04332000
                                                                        04334000
<<Get the extended ACB and its buffer addresses>>                       04336000
tos:=@AbPacbExtension;                                                  04338000
tos:=AbPacbDST; tos:=AbPacbAddr+pacbx'loc;                              04340000
tos:=pacbx'size+AbNumBufs+1; asmb(mfds 4);                              04342000
end;  <<LOCEXTENDACB>>                                                  04344000
procedure UNLOCEXTENDACB(Acb);                                          04346000
value Acb;                                                              04348000
                                                                        04350000
<<Function                                                              04352000
  Rolls back the message file extensions to the PACB and                04354000
  the LACB.>>                                                           04356000
                                                                        04358000
<<Input>>                                                               04360000
  integer pointer                                                       04362000
    Acb;                <<Address of the Access Control Block.>>        04364000
                                                                        04366000
<<Output                                                                04368000
  None.>>                                                               04370000
                                                                        04372000
option privileged,internal;                                             04374000
                                                                        04376000
begin                                                                   04378000
AbxDataStructure;                                                       04380000
                                                                        04382000
                                                                        04384000
<<Roll back the LACB extension>>                                        04386000
tos:=AbLacbDST;                                                         04388000
if <> then                                                              04390000
  begin  <<LACB exists (not in copy mode)>>                             04392000
  tos:=AbLacbAddr+lacbx'loc;                                            04394000
  tos:=@AbLacbExtension; tos:=lacbx'size;                               04396000
  asmb(mtds 4);                                                         04398000
  end;                                                                  04400000
                                                                        04402000
<<Roll back the PACB extension>>                                        04404000
tos:=AbPacbDST; tos:=ABPacbAddr+pacbx'loc;                              04406000
tos:=@AbPacbExtension; tos:=pacbx'size+AbNumBufs+1;                     04408000
asmb(mtds 4);                                                           04410000
                                                                        04412000
<<If caller did not have DB pointing to the stack, then return it       04414000
  to his data segment.>>                                                04416000
if AbTargetDST <> PCB'stk then                                          04418000
  EXCHANGEDB(AbTargetDST)                                               04420000
else                                                                    04422000
  AbTargetDST:=0;                                                       04424000
end;  <<UNLOCEXTENDACB>>                                                04426000
procedure FCPREPAFT(FileNum,Aft3Contents);                              04428000
value FileNum,Aft3Contents;                                             04430000
                                                                        04432000
<<Function                                                              04434000
  Changes the contents of the fle's AFT entry, word three               04436000
  (port number word for nowait I/O).>>                                  04438000
                                                                        04440000
<<Input>>                                                               04442000
  integer                                                               04444000
    FileNum,            <<File's file number.>>                         04446000
    Aft3Contents;       <<Desired value.>>                              04448000
                                                                        04450000
<<Output                                                                04452000
  None.>>                                                               04454000
                                                                        04456000
option privileged,uncallable;                                           04458000
                                                                        04460000
begin                                                                   04462000
push(q,dl); asmb(xch,sub);  <<Form dl-q>>                               04464000
X:=tos-(FileNum+1)*aft'entry'size;  <<X:=@Aft0(File)>>                  04466000
Aq3(X):=Aft3Contents;                                                   04468000
end;  <<FCPREPAFT>>                                                     04470000
$PAGE "OPEN/CLOSE UTILITY PROCEDURES."                                  04472000
integer procedure GETID(IDArray);                                       04474000
value IDArray;                                                          04476000
                                                                        04478000
<<Function                                                              04480000
  Finds a free entry in the ID array.>>                                 04482000
                                                                        04484000
<<Input                                                                 04486000
    DB                    Any data segment.>>                           04488000
  pointer                                                               04490000
    IDArray;            <<First word of ID array.>>                     04492000
                                                                        04494000
<<Output                                                                04496000
    GETID                 The number of the ID obtained.  A zero        04498000
                          is returned if no ID can be found.>>          04500000
                                                                        04502000
option privileged,internal;                                             04504000
                                                                        04506000
begin                                                                   04508000
integer                                                                 04510000
  I:=-1,ID=GETID;                                                       04512000
                                                                        04514000
                                                                        04516000
while (I:=I+1) <= maxIDindex and ID = 0 do                              04518000
  begin  <<Scan through the ID bit map, looking for a one>>             04520000
  tos:=IDArray(I);                                                      04522000
  if <> then                                                            04524000
    begin  <<Found a one, clear its bit map entry>>                     04526000
    asmb(dup; scan; del; trbc 0,x);                                     04528000
    GETID:=X+I*16+1;                                                    04530000
    IDArray(I):=tos;                                                    04532000
    end                                                                 04534000
  else                                                                  04536000
    del;                                                                04538000
  end;                                                                  04540000
end;  <<GETID>>                                                         04542000
procedure RELID(IDNum,IDArray);                                         04544000
value IDNum,IDArray;                                                    04546000
                                                                        04548000
<<Function                                                              04550000
  Deletes an entry from the ID array.>>                                 04552000
                                                                        04554000
<<Input                                                                 04556000
    DB                    Any data segment.>>                           04558000
  integer                                                               04560000
    IDNum;              <<ID number to be returned.  A zero ID          04562000
                          number is ignored.>>                          04564000
  pointer                                                               04566000
    IDArray;            <<Address of the first word of the ID           04568000
                          array.>>                                      04570000
                                                                        04572000
<<Output                                                                04574000
  None.>>                                                               04576000
                                                                        04578000
option privileged,internal;                                             04580000
                                                                        04582000
begin                                                                   04584000
if IDNum <> 0 then                                                      04586000
  begin                                                                 04588000
  tos:=IDNum-1; tos:=16; asmb(div,stax);                                04590000
  @IDArray:=tos+@IDArray;  <<Set IDArray to target word>>               04592000
  tos:=IDArray;                                                         04594000
  asmb(tsbc 0,x);                                                       04596000
  IDArray:=tos;                                                         04598000
  end;                                                                  04600000
end;  <<RELID>>                                                         04602000
procedure DELETERESOURCES(Acb,Last);                                    04604000
value Acb,Last;                                                         04606000
                                                                        04608000
<<Function                                                              04610000
  Deletes all msg file resources that belong to the process.>>          04612000
                                                                        04614000
<<Input>>                                                               04616000
  integer pointer                                                       04618000
    Acb;                <<Address of the Access Control Block.>>        04620000
  logical                                                               04622000
    Last;               <<If true then this is the last accessor.>>     04624000
                                                                        04626000
<<Output                                                                04628000
  None.>>                                                               04630000
                                                                        04632000
option privileged,internal;                                             04634000
                                                                        04636000
begin                                                                   04638000
array IDmap(0:maxIDindex');                                             04640000
AbxDataStructure;                                                       04642000
                                                                        04644000
                                                                        04646000
if AbReplyPort <> 0 then                                                04648000
  while not FCPORTCLOSE(AbReplyPort) do FCPORTRECEIVE(AbReplyPort);     04650000
                                                                        04652000
if not AbRead then                                                      04654000
  begin  <<Writer>>                                                     04656000
  if AbWriteCB <> 0 then FDELETECB(AbWriteCB);                          04658000
                                                                        04660000
  <<Delete the writer's ID from the pacb ID map>>                       04662000
  tos:=@IDMap;                                                          04664000
  tos:=AbPacbDST;  <<Get ID array from pacb>>                           04666000
  tos:=AbPacbAddr+pacbIdloc;                                            04668000
  tos:=maxIDindex;                                                      04670000
  asmb(mfds 1);                                                         04672000
  RELID(AbID,IDMap);                                                    04674000
  tos:=tos-maxIDindex;  <<Move ID array back to pacb>>                  04676000
  tos:=@IDMap; tos:=maxIDindex;                                         04678000
  asmb(mtds 4);                                                         04680000
  end;                                                                  04682000
if Last then                                                            04684000
  begin  <<Last accessor, clean up the file>>                           04686000
  if AbReadQueue <> 0 then                                              04688000
    if not FCPORTCLOSE(AbReadQueue) then UGLYMSGACCESS;                 04690000
  if AbWriteQueue <> 0 then                                             04692000
    if not FCPORTCLOSE(AbWriteQueue) then UGLYMSGACCESS;                04694000
  end;                                                                  04696000
end;  <<DELETERESOURCES>>                                               04698000
$PAGE "COMMUNICATIONS PROCEDURES."                                      04700000
logical procedure PUTWAITQUEUE(Acb,DST,Target,Length);                  04702000
value Acb,DST,Target,Length;                                            04704000
                                                                        04706000
<<Function                                                              04708000
  Places the wait message into the appropriate wait queue               04710000
  (either the ACB resident queue or the port queue)>>                   04712000
                                                                        04714000
<<Input>>                                                               04716000
  integer pointer                                                       04718000
    Acb;                <<Address of the Access Control Block.>>        04720000
  integer                                                               04722000
    DST,                <<Target data segment number (writer)>>         04724000
    Target,             <<DST relative address (writer)>>               04726000
    Length;             <<Length of area (see call for units)>>         04728000
                                                                        04730000
<<Output                                                                04732000
    PUTWAITQUEUE          true  - use reply port for compl msg          04734000
                          false - use ACB msg area>>                    04736000
                                                                        04738000
<<Algorithm                                                             04740000
  1. The port wait queue must be used if:                               04742000
                                                                        04744000
     a. more than one accessor can queue up,                            04746000
     b. or the timeout mechanism is required (only                      04748000
        available on the wait queue).                                   04750000
                                                                        04752000
  2. If the port wait queue is used, then the reply                     04754000
     port must be used.                                                 04756000
                                                                        04758000
  3. The reply port must be used for no wait I/O so                     04760000
     that IOWAIT/IODONTWAIT can efficiently check                       04762000
     the request's status.                                              04764000
>>                                                                      04766000
                                                                        04768000
option privileged,internal;                                             04770000
                                                                        04772000
begin                                                                   04774000
AbxDataStructure;                                                       04776000
MsgStructure;                                                           04778000
integer                                                                 04780000
  WaitQueue;                                                            04782000
                                                                        04784000
                                                                        04786000
if AbShare or (AbTimeout <> 0) or not AbRead and AbSemi then            04788000
  begin  <<Must use port for the wait queue>>                           04790000
  PUTWAITQUEUE:=true;                                                   04792000
  WaitQueue:=if AbRead then AbReadQueue else AbWriteQueue;              04794000
  MsgID:=AbID; MsgLocalFlags:=AbLocalFlags;                             04796000
  MsgTargetDST:=DST; MsgTarget:=Target; MsgLength:=Length;              04798000
  FCPORTSEND(WaitQueue,Msg,msg'lengthw,AbReplyPort,AbTimeout,fifo);     04800000
  if <> then UGLYMSGACCESS;                                             04802000
  end                                                                   04804000
else                                                                    04806000
  begin  <<Don't need the generality of ports, use ACB wait msg area>>  04808000
  AbMWaitMsg:=1;                                                        04810000
  if <> then UGLYMSGACCESS;                                             04812000
  AbMID:=AbID; AbMLocalFlags:=AbLocalFlags;                             04814000
  AbMDST:=DST; AbMTarget:=Target; AbMLength:=Length;                    04816000
  if AbNoWait and AbSoftIntPlabel = 0 then                              04818000
    AbMReplyPort:=AbReplyPort                                           04820000
  else                                                                  04822000
    begin  <<Can use the ACB completion msg area>>                      04824000
    AbMReplyPort:=0;                                                    04826000
    AbMPin:=GetOwnPin;                                                  04828000
    AbMSoftIntPlabel:=AbSoftIntPlabel;                                  04830000
    AbMFNum:=AbFNum;                                                    04832000
    end;                                                                04834000
  end;                                                                  04836000
end;  <<PUTWAITQUEUE>>                                                  04838000
integer procedure GETWAITQUEUE(Acb,Port,Msg,DeleteFlag);                04840000
value Acb,Port,Msg,DeleteFlag;                                          04842000
                                                                        04844000
<<Function                                                              04846000
  Gets the wait queue message from the appropriate place                04848000
  (either the ACB message area or the port wait queue)>>                04850000
                                                                        04852000
<<Input>>                                                               04854000
  integer pointer                                                       04856000
    Acb;                <<Address of the Access Control Block.>>        04858000
  integer                                                               04860000
    Port;               <<Port number of the wait queue>>               04862000
  logical                                                               04864000
    DeleteFlag;         <<0 - delete the message                        04866000
                          1 - leave the message>>                       04868000
                                                                        04870000
<<Output                                                                04872000
    GETWAITQUEUE          = 0 - no message outstanding                  04874000
                          > 0 - reply port>>                            04876000
  integer pointer                                                       04878000
    Msg;                <<Contents of the message>>                     04880000
                                                                        04882000
option privileged,internal;                                             04884000
                                                                        04886000
begin                                                                   04888000
AbxDataStructure;                                                       04890000
                                                                        04892000
                                                                        04894000
if AbMWaitMsg then                                                      04896000
  begin  <<Message is in the Acb message area>>                         04898000
  if DeleteFlag = delete'msg then AbMWaitMsg:=0;                        04900000
  GETWAITQUEUE:=AbMReplyPort;                                           04902000
  Msg:=AbMID;                                                  <<02048>>04904000
  move Msg(1):=AbMMsg1,(4);                                    <<02048>>04906000
  CondCode:=cce;                                                        04908000
  end                                                                   04910000
else                                                                    04912000
  begin  <<Message is on the wait queue>>                               04914000
  GETWAITQUEUE:=FCPORTRECEIVE(Port,Msg,msg'lengthw,DeleteFlag);         04916000
  if < then UGLYMSGACCESS;                                              04918000
  tos:=if > then ccg else cce;                                          04920000
  CondCode:=tos;                                                        04922000
  end;                                                                  04924000
end;  <<GETWAITQUEUE>>                                                  04926000
procedure PUTMYCOMPLTNMSG(Acb,ErrorCode,Tlog);                          04928000
value Acb,ErrorCode,Tlog;                                               04930000
                                                                        04932000
<<Function                                                              04934000
  Sends a message to own LACB (bypassing the overhead of sending        04936000
  to own reply port)>>                                                  04938000
                                                                        04940000
<<Input>>                                                               04942000
  integer pointer                                                       04944000
    Acb;                <<Address of the Access Control Block.>>        04946000
  integer                                                               04948000
    ErrorCode,          <<Resultant error code.>>                       04950000
    Tlog;               <<Resultant transmission log.>>                 04952000
                                                                        04954000
<<Output                                                                04956000
  None.>>                                                               04958000
                                                                        04960000
option privileged,internal;                                             04962000
                                                                        04964000
begin                                                                   04966000
AbxDataStructure;                                                       04968000
                                                                        04970000
                                                                        04972000
AbNoWaitDone:=1;                                                        04974000
AbCmplError:=ErrorCode;                                                 04976000
AbCmplTlog:=Tlog;                                                       04978000
if AbSoftIntPlabel <> 0 then                                            04980000
  begin  <<User accessing with soft interrupts>>                        04982000
  FCPREPAFT(AbFNum,soft'int'pend);                                      04984000
  tos:=no'wait'done; tos:=AbFNum;                                       04986000
  CAUSESOFTINT(0,user'int,file'soft'int,AbSoftIntPlabel,2,0);           04988000
  if <> then UGLYMSGACCESS;                                             04990000
  end                                                                   04992000
else                                                                    04994000
  FCPREPAFT(AbFNum,no'wait'done);  <<No wait I/O>>                      04996000
end;  <<PUTMYCOMPLTNMSG>>                                               04998000
procedure PUTCOMPLMSG(Acb,Port,Error,Tlog,ID);                 <<02048>>05000000
value Acb,Port,Error,Tlog,ID;                                  <<02048>>05002000
                                                                        05004000
<<Function                                                              05006000
  Places the completion message into the appropriate area               05008000
  (either the ACB completion area or the reply port)>>                  05010000
                                                                        05012000
<<Input>>                                                               05014000
  integer pointer                                                       05016000
    Acb;                <<Address of the Access Control Block.>>        05018000
  integer                                                               05020000
    Port,               <<Destinatin port, zero implies that            05022000
                          the ACB area is to be used.>>                 05024000
    Error,              <<Resultant error code.>>                       05026000
    Tlog,               <<Resultant transmission log.>>        <<02048>>05028000
    ID;                 <<Sendee's ID.>>                       <<02048>>05030000
                                                                        05032000
<<Output                                                                05034000
  None.>>                                                               05036000
                                                                        05038000
option privileged,internal;                                             05040000
                                                                        05042000
begin                                                                   05044000
AbxDataStructure;                                                       05046000
integer array                                                           05048000
  Msg(*)=Error;                                                         05050000
equate                                                                  05052000
  awaken       = 0,                                                     05054000
  no'interrupt = 1,                                                     05056000
  no'awaken    = 2;                                                     05058000
                                                                        05060000
                                                                        05062000
subroutine MAKESOFTINT(WakeFlag);                                       05064000
value WakeFlag;                                                         05066000
                                                                        05068000
<<Function                                                              05070000
  Soft interrupts the target process.>>                                 05072000
                                                                        05074000
<<Input>>                                                               05076000
  logical                                                               05078000
    WakeFlag;           <<Specifies if target process is to be          05080000
                          awakened immediately or delayed until         05082000
                          after the ACB is released.>>                  05084000
                                                                        05086000
  begin                                                                 05088000
  tos:=no'wait'done; tos:=AbMFNum;  <<Form soft int msg>>               05090000
  CAUSESOFTINT(AbMPin,user'int,file'soft'int,AbMSoftIntPlabel,          05092000
    2,S3);                                                              05094000
  if > then AbWakePin:=-AbMPin;                                         05096000
  end;  <<MAKESOFTINT>>                                                 05098000
if Port <> 0 then                                                       05100000
  begin  <<Must use port for the reply>>                                05102000
  if AbWakePin = 0 then                                                 05104000
    begin  <<Have not awakened any process yet>>                        05106000
    tos:=FCPORTSEND(Port,Msg,2,AbReplyPort,,no'awaken);                 05108000
    if <> then UGLYMSGACCESS;                                           05110000
    AbWakePin:=tos;                                                     05112000
    end                                                                 05114000
  else                                                                  05116000
    begin  <<Already have one process to wake by FREAD/FWRITE>>         05118000
    FCPORTSEND(Port,Msg,2,AbReplyPort);  <<Must wake this one directly>>05120000
    if <> then UGLYMSGACCESS;                                           05122000
    end;                                                                05124000
  end                                                                   05126000
else                                                                    05128000
  begin  <<Don't need the generality of ports, use ACB msg area>>       05130000
  AbMComplMsg:=1;                                                       05132000
  if <> then UGLYMSGACCESS;                                             05134000
  AbMComplID:=ID;                                              <<02048>>05136000
  AbMError:=Error;                                                      05138000
  AbMTlog:=Tlog;                                                        05140000
  if AbWakePin <> 0 then                                                05142000
    begin  <<Have already delayed one wake, can't delay any more>>      05144000
    if AbMSoftIntPlabel <> 0 then                                       05146000
      MAKESOFTINT(awaken)                                               05148000
    else                                                                05150000
      AWAKE(AbMPin*pcb'len,port'wake,remain'active);                    05152000
    end                                                                 05154000
  else                                                                  05156000
    begin  <<1st process to be awakened, delay it until ACB released>>  05158000
    if AbMSoftIntPlabel <> 0 then                                       05160000
      MAKESOFTINT(no'interrupt)                                         05162000
    else                                                                05164000
      AbWakePin:=AbMPin;                                                05166000
    end;                                                                05168000
  end;                                                                  05170000
end;  <<PUTCOMPLMSG>>                                                   05172000
integer procedure GETCOMPLTNMSG(Acb,Msg);                               05174000
value Acb,Msg;                                                          05176000
                                                                        05178000
<<Function                                                              05180000
  Gets the two word completion message from the proper source.>>        05182000
                                                                        05184000
<<Input>>                                                               05186000
  integer pointer                                                       05188000
    Acb;                <<Address of the Access Control Block.>>        05190000
                                                                        05192000
<<Output                                                                05194000
    GETCOMPLTNMSG        0          - there was no msg                  05196000
                         reply port - msg was received>>                05198000
  integer pointer                                                       05200000
    Msg;               <<Message contents.>>                            05202000
                                                                        05204000
option privileged,internal;                                             05206000
                                                                        05208000
begin                                                                   05210000
AbxDataStructure;                                                       05212000
                                                                        05214000
                                                                        05216000
CondCode:=cce;                                                          05218000
AbNoWaitDone:=0;                                                        05220000
if <> then                                                              05222000
  begin  <<Completing a no wait I/O that was "done" at init time>>      05224000
  MsgErrorCode':=AbCmplError;                                           05226000
  MsgTlog':=AbCmplTlog;                                                 05228000
  GETCOMPLTNMSG:=AbReplyPort;                                           05230000
  end                                                                   05232000
else if AbMComplMsg and AbMComplID = AbID then                 <<02048>>05234000
  begin  <<ACB used as the message medium>>                             05236000
  AbMComplMsg:=0;                                                       05238000
  MsgErrorCode':=AbMError;                                              05240000
  MsgTlog':=AbMTlog;                                                    05242000
  GETCOMPLTNMSG:=AbMReplyPort;                                          05244000
  end                                                                   05246000
else                                                                    05248000
  begin  <<Used ports, message is on the reply port>>                   05250000
  GETCOMPLTNMSG:=FCPORTRECEIVE(AbReplyPort,Msg,2,enable'int);           05252000
  if < then CondCode:=ccl;                                              05254000
  end;                                                                  05256000
end;  <<GETCOMPLTNMSG>>                                                 05258000
procedure LONGWAIT(Acb,Port,CallerDST,Target,UserLengthb);              05260000
value Acb,Port,CallerDST,Target,UserLengthb;                            05262000
                                                                        05264000
<<Function                                                              05266000
  Waits either for another process to satisfy a file blockage           05268000
  or for a timeout.  Note that during this time the file's ACB is       05270000
  released.>>                                                           05272000
                                                                        05274000
<<Input>>                                                               05276000
  integer pointer                                                       05278000
    Acb;                <<Address of the Access Control Block.>>        05280000
  integer                                                               05282000
    Port,               <<Port # of the appropriate wait queue.>>       05284000
    CallerDST,          <<DST number of Target area.>>                  05286000
    Target,             <<User Target area.>>                           05288000
    UserLengthb;        <<Length of the user Target area.>>             05290000
                                                                        05292000
<<Output                                                                05294000
  None>>                                                                05296000
                                                                        05298000
<<Algorithm                                                             05300000
  Issue SENDMSG with Target parameters and timeout to wait queue        05302000
  Release the ACB                                                       05304000
  Enable the process's reply port                                       05306000
  Wait on the port                                                      05308000
  Obtain the ACB                                                        05310000
>>                                                                      05312000
                                                                        05314000
option privileged,internal;                                             05316000
                                                                        05318000
begin                                                                   05320000
AbxDataStructure;                                                       05322000
equate                                                                  05324000
  port'wait             = -4,                                           05326000
  long'wait             = 1;                                            05328000
integer                                                                 05330000
  QRelativeAcb;                                                         05332000
logical                                                                 05334000
  UsePorts;                                                             05336000
                                                                        05338000
                                                                        05340000
logical subroutine DONE;                                                05342000
                                                                        05344000
<<Function                                                              05346000
  Tests if request has finished.>>                                      05348000
                                                                        05350000
  begin                                                                 05352000
  if UsePorts then                                             <<02048>>05354000
     DONE:=FCPORTENABLE(AbReplyPort)                           <<02048>>05356000
  else                                                         <<02048>>05358000
     begin  <<Must check ACB message area>>                    <<02048>>05360000
     if AbMComplMsg and (AbMComplID = AbID) then               <<02048>>05362000
       DONE:=true  <<Our completion message is ready>>         <<02048>>05364000
     else                                                      <<02048>>05366000
       DONE:=false;                                            <<02048>>05368000
     end;                                                      <<02048>>05370000
  end;  <<DONE>>                                                        05372000
                                                                        05374000
                                                                        05376000
UsePorts:=PUTWAITQUEUE(Acb,CallerDST,Target,UserLengthb);               05378000
                                                                        05380000
while not DONE do                                                       05382000
  begin                                                                 05384000
  <<Roll back the PACB proper>>                                         05386000
  tos:=AbPacbDST; tos:=AbPacbAddr+no'write'size;                        05388000
  tos:=@AbStart+no'write'size; tos:=write'size;                         05390000
  asmb(mtds 3);                                                         05392000
                                                                        05394000
  <<Roll back the PACB extension>>                                      05396000
  tos:=AbPacbAddr+pacbx'loc;                                            05398000
  tos:=@AbPacbExtension; tos:=pacbx'size+AbNumBufs+1;                   05400000
  asmb(mtds 4);                                                         05402000
                                                                        05404000
  <<Release the Pacb>>                                                  05406000
  tos:=@Acb; push(q);                                                   05408000
  QRelativeAcb:=tos-tos;                                                05410000
  UNLOCK'CB(0,AbPacbDST,AbPacbCbTabAddr);                               05412000
                                                                        05414000
  <<Wait for symbiotic process to act>>                                 05416000
  RESETCRITICAL(0);                                                     05418000
  WAIT(port'wait,long'wait);                                            05420000
  SETCRITICAL;                                                          05422000
                                                                        05424000
  <<Lock the Pacb>>                                                     05426000
  LOCK'CB(0,0,QRelativeAcb+no'write'size,AbPacbDst,AbPacbCbTabAddr);    05428000
  tos:=tos+no'write'size;  <<Move the standard Pacb into the acb area>> 05430000
  tos:=write'size;                                                      05432000
  asmb(mds 5);                                                          05434000
                                                                        05436000
  <<Move the Pacb extension into the acb area>>                         05438000
  tos:=@AbPacbExtension;                                                05440000
  tos:=AbPacbDST; tos:=AbPacbAddr+pacbx'loc;                            05442000
  tos:=pacbx'size+AbNumBufs+1; asmb(mfds 4);                            05444000
  end;                                                                  05446000
end;  <<LONGWAIT>>                                                      05448000
integer procedure ABORTREQUESTS(Acb);                                   05450000
value Acb;                                                              05452000
                                                                        05454000
<<Function                                                              05456000
  Aborts possible, unsatisfied request from the caller.>>               05458000
                                                                        05460000
<<Input>>                                                               05462000
  integer pointer                                                       05464000
    Acb;                <<Address of the Access Control Block.>>        05466000
                                                                        05468000
<<Output                                                                05470000
    ABORTREQUESTS         0 - I/O request aborted                       05472000
                          1 - I/O request has already  completed, it    05474000
                              has not been deleted                      05476000
                          2 - No I/O request was outstanding>>          05480000
<<Algorithm                                                             05482000
  Issue abort request to the wait port                                  05484000
  If local port not empty then return false                             05486000
>>                                                                      05488000
                                                                        05490000
option privileged,internal;                                             05492000
                                                                        05494000
begin                                                                   05496000
AbxDataStructure;                                                       05498000
integer                                                                 05500000
  WaitQueue;                                                            05502000
                                                                        05504000
                                                                        05506000
subroutine RETURNREQUEST;                                               05508000
                                                                        05510000
<<Function                                                              05512000
  Returns any resource claim that the aborted request might have.>>     05514000
                                                                        05516000
  begin                                                                 05518000
  if AbRead then                                                        05520000
    AbNumReadsPend:=AbNumReadsPend-1                                    05522000
  else                                                                  05524000
    <<May have aborted large message at head of queue, possible         05526000
      small second message may now be able to write to file.>>          05528000
    FREEWRITERS(Acb,0d,0);                                              05530000
  ABORTREQUESTS:=IOaborted;                                             05532000
  end;  <<RETURNREQUEST>>                                               05534000
                                                                        05536000
                                                                        05538000
if AbMComplMsg and AbMComplID = AbID                           <<02048>>05540000
or AbNoWaitDone or (FCPORTSTATUS(AbReplyPort,num'msgs) > 0) then        05542000
  ABORTREQUESTS:=IOcompleted                                            05544000
else                                                                    05546000
  begin  <<No completed I/O, check for pending requests>>               05548000
  ABORTREQUESTS:=noIOpending;                                           05550000
  if AbMWaitMsg and AbMID = AbID then                                   05552000
    begin                                                               05554000
    AbMWaitMsg:=0;                                                      05556000
    RETURNREQUEST;                                                      05558000
    end                                                                 05560000
  else                                                                  05562000
    begin  <<Look at wait port>>                                        05564000
    WaitQueue:=if AbRead then AbReadQueue else AbWriteQueue;            05566000
    if FCMSGABORT(WaitQueue,AbReplyPort,AbID) > 0 then                  05568000
      RETURNREQUEST;                                                    05570000
    end;                                                                05572000
  if AbSoftIntPlabel = 0 then FCPORTDISABLE(AbReplyPort);               05574000
  end;                                                                  05576000
end;  <<ABORTREQUESTS>>                                                 05578000
$PAGE "I/O PROCEDURES."                                                 05580000
integer procedure DISCIO(Acb,BlockNum,IoType,Buf,Blk);                  05582000
value Acb,BlockNum,IoType,Buf,Blk;                                      05584000
                                                                        05586000
<<Function                                                              05588000
  Initiates disc I/O for the file.>>                                    05590000
                                                                        05592000
<<Input>>                                                               05594000
  integer pointer                                                       05596000
    Acb;                <<Address of the Access Control Block.>>        05598000
  double                                                                05600000
    BlockNum;           <<Physical block number, if absent then the>>   05602000
                        <<buffer contains the block number.>>           05604000
  integer                                                               05606000
    IoType,             <<Specifies read (0) or write (1).>>            05608000
    Buf;                <<ACB address of buffer.>>                      05610000
  pointer                                                               05612000
    Blk;                <<DB relative addr of the block desc.>>         05614000
                                                                        05616000
<<Output                                                                05618000
    DISCIO                File system error code.>>                     05620000
                                                                        05622000
option variable,privileged,internal;                                    05624000
                                                                        05626000
begin                                                                   05628000
equate                                                                  05630000
  << Unblocked, buffered sequential access.                 >> <<04775>>05632000
  ATTACHIOflags = %140000;                                     <<04775>>05634000
define                                                                  05636000
  BlkSpecified   = pmap#;                                               05638000
double pointer                                                          05640000
  Blkdbl=Blk;                                                           05642000
double                                                                  05644000
  Sector;                                                               05646000
integer                                                                 05648000
  Error=DISCIO,P1=Sector,P2=Sector+1,LogDevice,QRelativeAcb;            05650000
array                                                                   05652000
  BlockArray(0:buf'prefix'size);                                        05654000
                                                                        05656000
                                                                        05658000
<<Initialize>>                                                          05660000
if not BlkSpecified then                                                05662000
  begin  <<Block descriptor not moved in>>                              05664000
  tos:=@Blk:=@BlockArray;                                               05666000
  tos:=AbPacbDst; tos:=Buf-buf'prefix'size;                             05668000
  tos:=buf'prefix'size;                                                 05670000
  asmb(mfds 1);  <<Leave pointers on the stack for the move back>>      05672000
  end;                                                                  05674000
                                                                        05676000
<<Get the disc address>>                                                05678000
tos:=@Acb; push(q);                                                     05680000
QRelativeAcb:=tos-tos;                                                  05682000
FCONV'BLK(BlockNum,QRelativeAcb,IoType,0,0d,0d,0);             <<04775>>05684000
BlkExtSize := tos;      << Save extent size in block header.>> <<04924>>05686000
BlkExtBase := tos;      << Save extent base address.        >> <<04924>>05688000
                                                               <<04924>>05690000
ddel; del;  <<Delete "EOF rec #" and "Sectors available in extent">>    05692000
if S0 = 1 then asmb(del,zero);                                          05694000
error:=tos;  <<Code>>                                                   05696000
                                                                        05698000
if error > 2 then                                                       05700000
  begin  <<File system error>>                                          05702000
  DISCIO:=error;                                                        05704000
  AbStatus:=0;                                                          05706000
  end                                                                   05708000
else if error = 2 then                                                  05710000
  UGLYMSGACCESS                                                         05712000
else                                                                    05714000
  begin  <<Initiate the I/O>>                                           05716000
  LogDevice:=tos; BlkDiscAddr:=Sector:=tos; BlkLogDevice:=LogDevice;    05718000
                                                               <<04775>>05720000
  << Stack EXTENT parameter information for ATTACHIO for    >> <<04775>>05722000
  << I/O caching.                                           >> <<04775>>05724000
                                                               <<04775>>05726000
  tos := BlkExtBase;     << Block's extent base address.    >> <<04924>>05728000
  tos := BlkExtSize;     << Block's extent size.            >> <<04924>>05730000
  tos:=ATTACHIO(LogDevice,0,AbPacbDst,Buf,IoType,AbBSize,P1,P2,         05732000
  ATTACHIOflags);                                                       05734000
  del; BlkIOQx:=tos;                                                    05736000
  << Remove stacked EXTENT information, sent to ATTACHIO.   >> <<04775>>05738000
  del;ddel;              << Block extent base and size.     >> <<04924>>05740000
  BlkIOCB:=0d;                                                          05742000
  BlkDirty:=0;                                                          05744000
  BlkIoOut:=IoType;                                                     05746000
  BlkIoPend:=1;                                                         05748000
  if not BlkSpecified then                                              05750000
    begin  <<Must roll back out the block descriptor>>                  05752000
    tos:=tos-buf'prefix'size;                                           05754000
    asmb(cab); tos:=tos-buf'prefix'size;                                05756000
    tos:=buf'prefix'size;                                               05758000
    asmb(mtds 4);                                                       05760000
    end;                                                                05762000
  end;                                                                  05764000
end;  <<DISCIO>>                                                        05766000
integer procedure QUIESCEIO(Acb,Buf,Blk);                               05768000
value Acb,Buf,Blk;                                                      05770000
                                                                        05772000
<<Function                                                              05774000
  Waits for the completion of the I/O request against a buffer.         05776000
  The ACB status field is updated.>>                                    05778000
                                                                        05780000
<<Input>>                                                               05782000
  integer pointer                                                       05784000
    Acb;                <<Address of the Access Control Block.>>        05786000
  integer                                                               05788000
    buf;                <<Address of the block>>                        05790000
  pointer                                                               05792000
    Blk;                <<DB relative addr of the block desc.           05794000
                          Note: if Blk is not specified, then DB        05796000
                                must be at the stack.>>                 05798000
                                                                        05800000
<<Output                                                                05802000
                                                                        05804000
    QUIESCEIO             File system error code of completion>>        05806000
                                                                        05808000
option variable,privileged,internal;                                    05810000
                                                                        05812000
begin                                                                   05814000
AbxDataStructure;                                                       05816000
define                                                                  05818000
  BlkSpecified    = pmap#;                                              05820000
array                                                                   05822000
  BlockArray(0:buf'prefix'size);                                        05824000
double pointer                                                          05826000
  Blkdbl=Blk;                                                           05828000
double                                                                  05830000
  BlockNum;                                                             05832000
integer pointer                                                         05834000
  BufArray:=@AbFirstBuf;                                                05836000
integer                                                                 05838000
  I:=-1;                                                                05840000
logical                                                                 05842000
  Found:=false;                                                         05844000
                                                                        05846000
                                                                        05848000
subroutine KWIESCEIO;                                                   05850000
  begin  <<Wait for the I/O to complete>>                               05852000
  if BlkIOQx <> 0 then                                                  05854000
    begin  <<An I/O took place on this buffer>>                         05856000
    if log(BlkIoPend) then                                              05858000
      begin  <<I/O is pending on the block>>                            05860000
      tos:=WAITFORIO(BlkIOQx);                                          05862000
      if <> then UGLYMSGACCESS;                                         05864000
      BlkIOCB:=tos;                                                     05866000
      end;                                                              05868000
    if BlkLStat <> goodIOstatus then QUIESCEIO:=IOSTAT(BlkLStat);       05870000
    BlkFlags:=0;                                                        05872000
    end;                                                                05874000
  end;  <<KWIESCEIO>>                                                   05876000
                                                                        05878000
                                                                        05880000
if not BlkSpecified then                                                05882000
  begin  <<Roll in the buffer's prefix area>>                           05884000
  tos:=@Blk:=@BlockArray;                                               05886000
  tos:=AbPacbDst; tos:=Buf-buf'prefix'size;                             05888000
  tos:=buf'prefix'size;                                                 05890000
  asmb(mfds 1);  <<Leave pointers on the stack for move back>>          05892000
  end;                                                                  05894000
                                                                        05896000
if log(BlkDirty) then                                                   05898000
  begin  <<Not yet written to the disc>>                                05900000
  <<Ascertain the buffer's buffer number>>                              05902000
  while not Found and (I:=I+1) <= AbNumBufs do                          05904000
    begin  <<Scan buffer address array>>                                05906000
    if Buf = BufArray(I) then Found:=true;                              05908000
    end;                                                                05910000
  if not Found then UGLYMSGACCESS;                                      05912000
                                                                        05914000
  <<Deduce the block's block number>>                                   05916000
  if (I+1<=AbNumReadBuf) or (AbWriteBlock<=dbl(AbNumBufs)) then         05918000
    BlockNum:=dbl(I)                                                    05920000
  else                                                                  05922000
    BlockNum:=(AbWriteBlock+dbl(I)-dbl(AbNumBufs));                     05924000
  if (QUIESCEIO:=DISCIO(Acb,BlockNum,writeIO,Buf,Blk)) = successful then05926000
    KWIESCEIO;                                                          05928000
  end                                                                   05930000
else                                                                    05932000
  KWIESCEIO;                                                            05934000
                                                                        05936000
if not BlkSpecified then                                                05938000
  begin  <<Roll the buffer prefix back out to the Pacb>>                05940000
  tos:=tos-buf'prefix'size;                                             05942000
  asmb(cab); tos:=tos-buf'prefix'size;                                  05944000
  tos:=buf'prefix'size;                                                 05946000
  asmb(mtds 4);                                                         05948000
  end;                                                                  05950000
end;  <<QUIESCEIO>>                                                     05952000
$PAGE "READ UTILITY PROCEDURES."                                        05954000
procedure FREEWRITERS(Acb,NumRecords,NumWords);                         05956000
value Acb,NumRecords,NumWords;                                          05958000
                                                                        05960000
<<Function                                                              05962000
  Pulls writers off of the wait queue until either the queue            05964000
  is exhausted or the new free space is exhausted.>>                    05966000
                                                                        05968000
<<Input>>                                                               05970000
  integer pointer                                                       05972000
    Acb;                <<Address of the Access Control Block.>>        05974000
  double                                                                05976000
    NumRecords;         <<Number of free records to add.>>              05978000
  integer                                                               05980000
    NumWords;           <<Number of free words to add>>                 05982000
                                                                        05984000
<<Output                                                                05986000
  None.>>                                                               05988000
                                                                        05990000
<<Algorithm                                                             05992000
  release space to free area                                            05994000
  Done:=false                                                           05996000
  do                                                                    05998000
    begin                                                               06000000
    read head message from wait queue                                   06002000
    if message exists then                                              06004000
      begin                                                             06006000
      if request length <= current # free bytes then                    06008000
        begin                                                           06010000
        if writer has just opened the write an open record              06012000
        put the record                                                  06014000
        awaken the writer by sending msg to his return port             06016000
        end                                                             06018000
      end                                                               06020000
    else                                                                06022000
      Done:=true                                                        06024000
    end until Done                                                      06026000
>>                                                                      06028000
                                                                        06030000
option privileged,internal;                                             06032000
                                                                        06034000
begin                                                                   06036000
AbxDataStructure;                                                       06038000
MsgStructure;                                                           06040000
integer                                                                 06042000
  Error,Length,Embed,ReplyPort,RecordLength;                            06044000
logical                                                                 06046000
  Done;                                                                 06048000
                                                                        06050000
                                                                        06052000
subroutine FREEWRITER;                                                  06054000
  begin                                                                 06056000
  GETWAITQUEUE(Acb,AbWriteQueue,Msg,delete'msg);                        06058000
  if <> then UGLYMSGACCESS;                                             06060000
  if MsgVirgin then                                                     06062000
    PUTRECORD(Acb,open'record,0,0,0,no'cctl,MsgID);                     06064000
  Error:=PUTRECORD(Acb,data'record,MsgTargetDST,MsgTarget,MsgLength,    06066000
  MsgControl,MsgID);                                                    06068000
  if Error = successful then                                            06070000
    begin                                                               06072000
    tos:=MsgLength;                                                     06074000
    if not AbByteTlog then tos:=(tos+1)&lsr(1);                         06076000
    Length:=tos;                                                        06078000
    end                                                                 06080000
  else                                                                  06082000
    Length:=0;                                                          06084000
  PUTCOMPLMSG(Acb,ReplyPort,Error,Length,MsgID);               <<02048>>06086000
  end;  <<FREEWRITER>>                                                  06088000
                                                                        06090000
                                                                        06092000
<<Fold in new released space>>                                          06094000
AbFreeWords:=AbFreeWords+numWords;                                      06096000
while AbFreeWords >= AbFullRecSizew do                                  06098000
  begin                                                                 06100000
  AbFreeWords:=AbFreeWords-AbFullRecSizew;                              06102000
  NumRecords:=NumRecords+1d;                                            06104000
  end;                                                                  06106000
AbFreeRecords:=AbFreeRecords+NumRecords;                                06108000
                                                                        06110000
<<Release the writers>>                                                 06112000
Done:=not AbWaitWriters;                                                06114000
while not Done do                                                       06116000
  begin                                                                 06118000
  ReplyPort:=GETWAITQUEUE(Acb,AbWriteQueue,Msg,no'delete);              06120000
  if > then                                                             06122000
    begin  <<Exhausted the wait queue>>                                 06124000
    AbWaitWriters:=0;                                                   06126000
    Done:=true;                                                         06128000
    end                                                                 06130000
  else                                                                  06132000
    begin  <<Process head entry>>                                       06134000
    Embed:=if MsgControl = no'cctl then 0 else 1;                       06136000
    RecordLength:=(magic'numberb+header'sizeb+MsgLength+Embed)&lsr(1);  06138000
    if CHECKRECSPACE(Acb,MsgVirgin,RecordLength) then                   06140000
      FREEWRITER                                                        06142000
    else                                                                06144000
      Done:=true;                                                       06146000
    end;                                                                06148000
  end;  <<while loop>>                                                  06150000
end;  <<FREEWRITERS>>                                                   06152000
integer procedure GETRECORDETAILS(Acb);                                 06154000
value Acb;                                                              06156000
                                                                        06158000
<<Function                                                              06160000
  Gets the record length and header from the buffer data segment        06162000
  and places them into the Acb.>>                                       06164000
                                                                        06166000
<<Input>>                                                               06168000
  integer pointer                                                       06170000
    Acb;                <<Address of the Access Control Block.>>        06172000
                                                                        06174000
<<Output                                                                06176000
    GETRECORDETAILS       Error code of (possible) disc I/O.>>          06178000
                                                                        06180000
option privileged,internal;                                             06182000
                                                                        06184000
begin                                                                   06186000
AbxDataStructure;                                                       06188000
                                                                        06190000
                                                                        06192000
subroutine GETEXIT(ErrorCode);                                          06194000
value ErrorCode;                                                        06196000
                                                                        06198000
<<Function                                                              06200000
  Returns from the procedure.>>                                         06202000
                                                                        06204000
<<Input>>                                                               06206000
  integer                                                               06208000
    ErrorCode;         <<Operation status.>>                            06210000
                                                                        06212000
<<Output                                                                06214000
  None.>>                                                               06216000
                                                                        06218000
  begin                                                                 06220000
  GETRECORDETAILS:=ErrorCode;                                           06222000
  asmb(exit 1);                                                         06224000
  end;  <<GETEXIT>>                                                     06226000
if (AbReadAddr = AbFirstBuf) and (AbWriteBlock >= dbl(AbNumBufs)) then  06228000
  begin  <<First record of the block, make sure block input is done>>   06230000
  if (tos:=QUIESCEIO(Acb,AbFirstBuf)) <> successful then GETEXIT(*);    06232000
  end;                                                                  06234000
                                                                        06236000
<<Get first word of record (its length or block delimiter)>>            06238000
tos:=@AbRecLengthb;                                                     06240000
tos:=AbPacbDST; tos:=AbReadAddr;                                        06242000
tos:=1; asmb(mfds 4);                                                   06244000
                                                                        06246000
<<Get the record's header>>                                             06248000
tos:=@AbHeaderID;                                                       06250000
tos:=AbPacbDST; tos:=AbReadHeader-(header'sizew-1);                     06252000
tos:=header'sizew; asmb(mfds 4);                                        06254000
AbHeader:=AbHeaderType;                                                 06256000
                                                                        06258000
GETEXIT(successful);                                                    06260000
end;  <<GETRECORDETAILS>>                                               06262000
double procedure CHECKFORECORDS(Acb);                                   06264000
value Acb;                                                              06266000
                                                                        06268000
<<Function                                                              06270000
  Checks if there are any records left for a new read request.>>        06272000
                                                                        06274000
<<Input>>                                                               06276000
  integer pointer                                                       06278000
    Acb;                <<Address of the Access Control Block.>>        06280000
                                                                        06282000
<<Output                                                                06284000
    CHECKFORECORD         > 0 - number of records that can be read      06286000
                          = 0 - either the file is empty or the current 06288000
                                number of outstanding reads matches     06290000
                                the number of unread records            06292000
                          < 0   more outstanding reads than unread      06294000
                                records>>                               06296000
                                                                        06298000
option privileged,internal;                                             06300000
                                                                        06302000
begin                                                                   06304000
AbxDataStructure;                                                       06306000
                                                                        06308000
                                                                        06310000
CHECKFORECORDS:=AbNumRecords-dbl(AbNumReadsPend)                        06312000
  -(if AbExtendRead then 0d else AbNumOpenClsRec);                      06314000
end;  <<CHECKFORECORD>>                                                 06316000
logical procedure CHECKRECSPACE(Acb,JustOpened,RecLength);              06318000
value Acb,JustOpened,RecLength;                                         06320000
                                                                        06322000
<<Function                                                              06324000
  Tests if there is enough file space to satisfy the write.>>           06326000
                                                                        06328000
<<Input>>                                                               06330000
  integer pointer                                                       06332000
    Acb;                <<Address of the access control block.>>        06334000
  logical                                                               06336000
    JustOpened;         <<True if this is the writer's first write req>>06338000
  integer                                                               06340000
    RecLength;          <<Total record length (including hdr words)>>   06342000
                                                                        06344000
<<Output                                                                06346000
  CHECKRECSPACE           Result of the test.                           06348000
                          True  - room in the file                      06350000
                          False - insufficient room in the file.>>      06352000
                                                                        06354000
option privileged,internal;                                             06356000
                                                                        06358000
begin                                                                   06360000
AbxDataStructure;                                                       06362000
integer                                                                 06364000
  FreeWords,NumRecords;                                                 06366000
                                                                        06368000
                                                                        06370000
<<Initialize>>                                                          06372000
FreeWords:=AbFreeWords;                                                 06374000
                                                                        06376000
<<Perform the test>>                                                    06378000
if JustOpened or AbJustOpenedWaitDisabled then                 <<04139>>06380000
  begin  <<Must allocate additional space for open/close recs>>         06382000
  if header'sizew+RecLength <= FreeWords then                           06384000
    NumRecords:=1  <<Need only allocate for close record>>              06386000
  else if header'sizew < FreeWords                                      06388000
  or (header'sizew+RecLength) <= AbFullRecSizew then                    06390000
    NumRecords:=2  <<Open rec will fit with current or new rec>>        06392000
  else                                                                  06394000
    NumRecords:=3; <<They all need record frames>>                      06396000
  if AbFreeRecords >= dbl(NumRecords) then                              06398000
    begin                                                               06400000
    AbFreeRecords:=AbFreeRecords-1d;  <<Allocate close record>>         06402000
    CHECKRECSPACE:=true;                                                06404000
    end;                                                                06406000
  end                                                                   06408000
else if (AbFreeRecords > 0d) or (RecLength+2 <= FreeWords) then         06410000
  CHECKRECSPACE:=true;                                                  06412000
end;  <<CHECKRECSPACE>>                                                 06414000
integer procedure FILLBUFFERS(Acb);                                     06416000
value Acb;                                                              06418000
                                                                        06420000
<<Function                                                              06422000
  Finishes initialization of the ACB by filling the ACB read            06424000
  and write buffers.>>                                                  06426000
                                                                        06428000
<<Input>>                                                               06430000
  integer pointer                                                       06432000
    Acb;                <<Address of the Access Control Block.>>        06434000
                                                                        06436000
<<Output                                                                06438000
    FILLBUFFERS           Resultant error number.>>                     06440000
                                                                        06442000
option privileged,internal;                                             06444000
                                                                        06446000
begin                                                                   06448000
AbxDataStructure;                                                       06450000
integer pointer                                                         06452000
  OldHeader,Rec,Header;                                                 06454000
integer                                                                 06456000
  I,J;                                                                  06458000
double                                                                  06460000
  Di,WriteBlock,NumWriteBuf;                                            06462000
logical                                                                 06464000
  DSTFlag:=1,Crash:=false;                                              06466000
                                                                        06468000
                                                                        06470000
subroutine FILLEXIT(ErrorCode);                                         06472000
value ErrorCode;                                                        06474000
                                                                        06476000
<<Function                                                              06478000
  Returns from the access method.>>                                     06480000
                                                                        06482000
<<Input>>                                                               06484000
  integer                                                               06486000
    ErrorCode;            <<Resultant error number.>>                   06488000
                                                                        06490000
<<Output                                                                06492000
  None.>>                                                               06494000
                                                                        06496000
  begin                                                                 06498000
  FILLBUFFERS:=ErrorCode;                                               06500000
  if DSTFlag = 0 then EXCHANGEDB(0);  <<Switch DB back to the stack>>   06502000
  assemble(exit 1);                                                     06504000
  end;  <<FILLEXIT>>                                                    06506000
subroutine READISC(Buf,BlockNum);                                       06508000
value Buf,BlockNum;                                                     06510000
                                                                        06512000
<<Function                                                              06514000
  Reads error free block from the disc to the target buffer.>>          06516000
                                                                        06518000
<<Input>>                                                               06520000
  integer                                                               06522000
    Buf;                <<Target buffer.>>                              06524000
  double                                                                06526000
    BlockNum;           <<File's block number.>>                        06528000
                                                                        06530000
<<Output                                                                06532000
  None.>>                                                               06534000
                                                                        06536000
  begin                                                                 06538000
  if (tos:=DISCIO(Acb,BlockNum,readIO,Buf)) <> successful then          06540000
    FILLEXIT(*);                                                        06542000
  del;                                                                  06544000
  if (tos:=QUIESCEIO(Acb,Buf)) <> successful then FILLEXIT(*);          06546000
  del;                                                                  06548000
  end;  <<READISC>>                                                     06550000
<<Initialize>>                                                          06552000
NumWriteBuf:=dbl(AbNumWriteBuf);                                        06554000
AbBufFilled:=1;                                                         06556000
                                                                        06558000
<<Fill the buffers>>                                                    06560000
if AbNumRecords <> 0d then                                              06562000
  begin  <<Nonempty file>>                                              06564000
  I:=-1; J:=-1; Di:=AbWriteBlock+1d; tos:=@AbFirstBuf;                  06566000
  while (I:=I+1) < AbNumReadBuf and (Di:=Di-1d) >= 0d do                06568000
    begin  <<Fill read buffers>>                                        06570000
    tos:=Ps0(I);                                                        06572000
    READISC(*,dbl(I));                                                  06574000
    end;                                                                06576000
  WriteBlock:=                                                          06578000
    if Di > NumWriteBuf then (AbWriteBlock-NumWriteBuf+1d)              06580000
    else dbl(I);                                                        06582000
  while (J:=J+1) < AbNumWriteBuf and (Di:=Di-1d) >= 0d do               06584000
    begin  <<Fill write buffers>>                                       06586000
    tos:=Ps0(I);                                                        06588000
    READISC(*,WriteBlock);                                              06590000
    I:=I+1;                                                             06592000
    WriteBlock:=WriteBlock+1d;                                          06594000
    end;                                                                06596000
                                                                        06598000
  <<Form write pointers>>                                               06600000
  AbWriteBufx:=I-1;                                                     06602000
  @Rec:=Ps0(I-1);                                                       06604000
  @OldHeader:=@Header:=@Rec+AbBSize-1;                                  06606000
                                                                        06608000
  DSTFlag:=EXCHANGEDB(AbPacbDST);                                       06610000
  <<Examine the last block for possible system crash>>                  06612000
  while HDType <> header'delim do                                       06614000
    begin  <<Index into the last block>>                                06616000
    if (@Rec+block'overheadw) > @Header or HDType > max'header'type then06618000
      FILLEXIT(badvarblk);                                              06620000
    Crash:=not log(HDLastClose);                                        06622000
    if HDType = data'record then @Rec:=@Rec+(Rec+1)&lsr(1)+1;           06624000
    @Header:=(@OldHeader:=@Header)-header'sizew;                        06626000
    end;                                                                06628000
  OldHeader.crash'bit:=Crash;                                           06630000
                                                                        06632000
  DSTFlag:=EXCHANGEDB(0);                                               06634000
  AbWriteHeader:=@Header; AbWriteAddr:=@Rec;                            06636000
                                                                        06638000
  <<Adjust free space>>                                                 06640000
  tos:=0; tos:=@Header-@Rec+1-block'overheadw;                          06642000
  tos:=AbFullRecSizew; asmb(div);                                       06644000
  AbFreeWords:=tos;                                                     06646000
  AbFreeRecords:=tos+AbFreeRecords;                                     06648000
  AbNonZeroOrigin:=1;                                                   06650000
  end;                                                                  06652000
FILLEXIT(successful);                                                   06654000
end;  <<FILLBUFFERS>>                                                   06656000
$PAGE "MESSAGE FILE ACCESS - RECORD DELETION."                          06658000
procedure DELETEBLOCK(Acb,DataSpace);                                   06660000
value Acb,DataSpace;                                                    06662000
                                                                        06664000
<<Function                                                              06666000
  Releases a spent read block to the file free space.>>                 06668000
                                                                        06670000
<<Input>>                                                               06672000
  integer pointer                                                       06674000
    Acb;                <<Address of the Access Control Block.>>        06676000
  integer                                                               06678000
    DataSpace;          <<Amount of words to return to free space.>>    06680000
                                                                        06682000
<<Output                                                                06684000
    None.>>                                                             06686000
                                                                        06688000
                                                                        06690000
<<Algorithm                                                             06692000
  if the file is empty then                                             06694000
    reset the write pointers to first read buffer                       06696000
  else                                                                  06698000
    decrement the block number variables in Acb and buffer area         06700000
  Invoke FREEWRITERS to release (possible) writers from                 06702000
  wait queue.                                                           06704000
  end                                                                   06706000
                                                                        06708000
  Note: Changing the start of file requires that all information        06710000
        in the FCB be consistent (up to date).  This is because         06712000
        future file system activities may update the label              06714000
        based completely on the contents of the FCB.  Examples          06716000
        of this are FRENAME and (more likely) FCONVBLK obtaining        06718000
        a new extent for a writer.                                      06720000
>>                                                                      06722000
                                                                        06724000
option privileged,internal;                                             06726000
                                                                        06728000
begin                                                                   06730000
FcbDataStructure;  <<Must be first declaration>>                        06732000
AbxDataStructure;                                                       06734000
integer                                                                 06736000
  QRelativeFcb;                                                         06738000
logical                                                                 06740000
  EmptyFile;                                                            06742000
                                                                        06744000
                                                                        06746000
subroutine UPDATEFCB;                                                   06748000
  begin                                                                 06750000
  LOCK'CB(0,0,QRelativeFcb,AbFcbDST,AbFcbCBTabAddr);                    06752000
  tos:=sizeBFCB;                                                        06754000
  asmb(mds 1);                                                          06756000
  FcbStart:=if EmptyFile then 0d else FcbStart+1d;                      06758000
  if FcbStart >= FcbFLim/dbl(FcbBlkFact) then FcbStart:=0d;             06760000
  FcbEnd:=AbWriteBlock;                                                 06762000
  FcbEOF:=AbNumRecords-AbNumOpenClsRec;                                 06764000
  FcbNumOpenClsRecs:=AbNumOpenClsRec;                                   06766000
                                                                        06768000
  <<Update FCB>>                                                        06770000
  asmb(deca,dxch;deca);  <<Decrement old move addresses, for move back>>06772000
  tos:=-fcb'eof'loc;                                                    06774000
  asmb(mds 6);                                                          06776000
  UNLOCK'CB(0,AbFcbDST,AbFcbCbTabAddr);                                 06778000
  MAKEMMSTAT(Acb,MMdelete'block,FcbStartLsw,FcbEndLsw);                 06780000
  end;  <<UPDATEFCB>>                                                   06782000
                                                                        06784000
                                                                        06786000
<<Initialize>>                                                          06788000
EmptyFile:=(AbNumRecords = 0d);                                         06790000
tos:=@Fcb; push(q);                                                     06792000
QRelativeFcb:=tos-tos;                                                  06794000
                                                                        06796000
<<Decrement the ACB's block numbers>>                                   06798000
if EmptyFile then                                                       06800000
  begin  <<Reset the writer's pointers>>                                06802000
  AbDirtyBlock:=0;                                                      06804000
  AbWriteBlock:=0d;                                                     06806000
  AbWriteHeader:=(AbWriteAddr:=AbFirstBuf)+AbBSize-1;                   06808000
  AbNonZeroOrigin:=0;                                                   06810000
  if <> then UPDATEFCB;                                                 06812000
  end                                                                   06814000
else                                                                    06816000
  begin                                                                 06818000
  AbWriteBlock:=AbWriteBlock-1d;                                        06820000
  UPDATEFCB;                                                            06822000
  end;                                                                  06824000
                                                                        06826000
                                                                        06828000
<<Free up possibly waiting writers>>                                    06832000
FREEWRITERS(Acb,0d,DataSpace);                                          06834000
MAKEMMSTAT(Acb,MMdelete'block,FcbStartLsw,FcbEndLsw);                   06836000
end;  <<DELETEBLOCK>>                                                   06838000
integer procedure INDEXRECORD(Acb,WaitType);                            06840000
value Acb,WaitType;                                                     06842000
                                                                        06844000
<<Function                                                              06846000
  Indexes to the next read logical record.>>                            06848000
                                                                        06850000
<<Input>>                                                               06852000
  integer pointer                                                       06854000
    Acb;                <<Address of the Access Control Block.>>        06856000
  logical                                                               06858000
    WaitType;           <<If true then wait for record to be            06860000
                          read in.>>                                    06862000
<<Output                                                                06864000
  INDEXRECORD             Result of (possible) disc I/O>>               06866000
                                                                        06868000
<<Algorithm                                                             06870000
  If current record is a delimiter then                                 06872000
    Index to the next block                                             06874000
  else                                                                  06876000
    begin                                                               06878000
    Decrement the number of records                                     06880000
    Adjust the data and header pointers                                 06882000
    Get new record's characteristics                                    06884000
    If new record is a delimiter then index to next block               06886000
    end                                                                 06888000
                                                                        06890000
  Note                                                                  06892000
  AbError is not set by this procedure or any procedure that it         06894000
  calls.  This is to allow the current read to escape anticipatory      06896000
  read errors.  However AbReadError is set so that future reads will    06898000
  get the error.                                                        06900000
>>                                                                      06902000
                                                                        06904000
option privileged,internal;                                             06906000
                                                                        06908000
begin                                                                   06910000
AbxDataStructure;                                                       06912000
array                                                                   06914000
  Blk(0:buf'prefix'size);                                               06916000
integer                                                                 06918000
  DataSpace;                                                            06920000
                                                                        06922000
                                                                        06924000
subroutine INDEXEXIT(ErrorCode);                                        06926000
value ErrorCode;                                                        06928000
                                                                        06930000
<<Function                                                              06932000
  Returns from this procedure.>>                                        06934000
                                                                        06936000
<<Input>>                                                               06938000
  integer                                                               06940000
    ErrorCode;                                                          06942000
                                                                        06944000
<<Output                                                                06946000
  None.>>                                                               06948000
                                                                        06950000
  begin                                                                 06952000
  if (INDEXRECORD:=ErrorCode) <> successful then                        06954000
    AbReadError:=ErrorCode;                                             06956000
  MAKEMMSTAT(Acb,MMindex'record,ErrorAndReadbID,                        06958000
    AbHeader&lsl(13)+AbNumRecLSW.(3:13));                               06960000
  asmb(exit 2);                                                         06962000
  end;  <<INDEXEXIT>>                                                   06964000
subroutine INDEXBLOCK(WaitType);                                        06966000
value WaitType;                                                         06968000
                                                                        06970000
<<Function                                                              06972000
  Indexes to the next block.>>                                          06974000
                                                                        06976000
<<Input>>                                                               06978000
  logical                                                               06980000
    WaitType;           <<If true then wait for block to be read        06982000
                          in from disc.>>                               06984000
                                                                        06986000
<<Output                                                                06988000
  None.>>                                                               06990000
                                                                        06992000
<<Algorithm                                                             06994000
  If necessary quiesce disc output on the buffer                        06996000
  If file contained in buffer area then                                 06998000
    begin                                                               07000000
    Bubble all buffers up by one                                        07002000
    Place used buffer address into the last write buffer slot           07004000
    end                                                                 07006000
  else                                                                  07008000
    begin                                                               07010000
    Bubble only the read buffers by one                                 07012000
    Place used buffer address into the last read buffer slot            07014000
    Issue disc read to the used read buffer                             07016000
    If disc read is pending on the head buffer then wait for it         07018000
    to complete.                                                        07020000
    end                                                                 07022000
  Delete the block                                                      07024000
>>                                                                      07026000
                                                                        07028000
  begin                                                                 07030000
  <<Finish possible block output (to return the IOQ)>>                  07032000
  tos:=@Blk;                                                            07034000
  tos:=AbPacbDst; tos:=AbFirstBuf-buf'prefix'size;                      07036000
  tos:=buf'prefix'size;                                                 07038000
  asmb(mfds 4);                                                         07040000
  if log(BlkIoPend) then                                                07042000
    begin                                                               07044000
    if (tos:=QUIESCEIO(Acb,AbFirstBuf)) <> successful then              07046000
      INDEXEXIT(*)                                                      07048000
    else                                                                07050000
       del;                                                             07052000
    end                                                                 07054000
  else if log(BlkDirty) then                                            07056000
    begin  <<No I/O in progress, reset dirty bit>>                      07058000
    BlkDirty:=0;                                                        07060000
    tos:=AbPacbDst; tos:=AbFirstBuf-buf'prefix'size;                    07062000
    tos:=@Blk;                                                          07064000
    tos:=buf'prefix'size;                                               07066000
    asmb(mtds 4);                                                       07068000
    end;                                                                07070000
                                                                        07072000
  <<Get next block>>                                                    07074000
  if AbNumRecords <> 0d then                                            07076000
    begin  <<Get next data block>>                                      07078000
    <<Find the next block>>                                             07080000
    if AbWriteBlock <= dbl(AbNumBufs) then                              07082000
      begin  <<Desired block is in a buffer>>                           07084000
      tos:=AbFirstBuf;                                                  07086000
      move AbFirstBuf:=AbSecondBuf,(AbNumBufs),2;                       07088000
      Ps0:=S1; ddel;                                                    07090000
      AbWriteBufx:=AbWriteBufx-1;                                       07092000
      end                                                               07094000
    else                                                                07096000
      begin  <<Read buffer(s) not contiguous with write buffer(s)>>     07098000
      <<Fill old read buffer>>                                          07100000
      tos:=DISCIO(Acb,dbl(AbNumReadBuf),readIO,AbFirstBuf);             07102000
      if S0 <> successful then INDEXEXIT(*); del;                       07104000
      <<Index to desired read buffer>>                                  07106000
      tos:=AbFirstBuf;                                                  07108000
      move AbFirstBuf:=AbSecondBuf,(AbNumReadBuf-1),2;                  07110000
      Ps0:=S1; ddel;                                                    07112000
      end;                                                              07114000
    AbBtfrCt:=AbBtfrCt+1d;                                              07116000
    end;                                                                07118000
                                                                        07120000
  <<Calculate the # words to return to free space>>                     07122000
  <<Note - number of records = 0 only if doing an anticipatory read>>   07124000
  DataSpace:=AbBSize-(if AbNumRecords <> 0d then block'overheadw        07126000
    else (AbReadHeader-AbReadAddr+1) <<Never allocated this part>>);    07128000
                                                                        07130000
  AbReadAddr:=AbFirstBuf;                                               07132000
  AbReadHeader:=AbFirstBuf+AbBSize-1;                                   07134000
  if WaitType then GETRECORDETAILS(Acb);                                07136000
                                                                        07138000
  DELETEBLOCK(Acb,DataSpace);                                           07140000
  end;  <<INDEXBLOCK>>                                                  07142000
<<Based on the current record, index to the next record>>               07144000
if AbHeaderType = header'delim then                                     07146000
  INDEXBLOCK(WaitType)  <<Passed a block boundary>>                     07148000
else                                                                    07150000
  begin  <<Still in same block>>                                        07152000
  AbNumRecords:=AbNumRecords-1d;                                        07154000
  if AbHeaderType = data'record then                                    07156000
    begin                                                               07158000
    AbRTfrCt:=AbRTfrCt+1d;                                              07160000
    AbReadAddr:=AbReadAddr+(AbRecLengthb+1)&lsr(1)+1;                   07162000
    end                                                                 07164000
  else                                                                  07166000
    AbNumOpenClsRec:=AbNumOpenClsRec-1d;                                07168000
  AbReadHeader:=AbReadHeader-header'sizew;                              07170000
  if AbReadAddr >= AbReadHeader then INDEXEXIT(badvarblk);              07172000
  GETRECORDETAILS(Acb);                                                 07174000
  if AbHeaderType = header'delim then INDEXBLOCK(WaitType);             07176000
  end;                                                                  07178000
                                                                        07180000
INDEXEXIT(successful);                                                  07182000
end;  <<INDEXRECORD>>                                                   07184000
$PAGE "WRITE UTILITY PROCEDURES."                                       07186000
procedure FREEREADER(Acb);                                              07188000
value Acb;                                                              07190000
                                                                        07192000
<<Function                                                              07194000
  Frees (possible) waiting reader.>>                                    07196000
                                                                        07198000
<<Input>>                                                               07200000
  integer pointer                                                       07202000
    Acb;                <<Address of the Access Control Block.>>        07204000
                                                                        07206000
<<Output                                                                07208000
  None.>>                                                               07210000
                                                                        07212000
option privileged,internal;                                             07214000
                                                                        07216000
begin                                                                   07218000
AbxDataStructure;                                                       07220000
MsgStructure;                                                           07222000
integer                                                                 07224000
  ReplyPort;                                                            07226000
                                                                        07228000
<<Free (possible) waiting reader>>                                      07230000
if AbNumRecords-(if AbExtendRead then 0d else AbnumOpenClsrec) <<06074>>07232000
>= 1d and AbNumReadsPend >= 1 then                             <<06074>>07233000
  begin  <<At least one reader on the wait queue>>                      07234000
  ReplyPort:=GETWAITQUEUE(Acb,AbReadQueue,Msg,delete'msg);              07236000
  if = then  <<Req has not timed out and been put on reply port>>       07238000
    PUTCOMPLMSG(Acb,ReplyPort,successful,MsgLength,MsgID);     <<02048>>07240000
  end;                                                                  07242000
end;  <<FREEREADER>>                                                    07244000
procedure FILL(FillWord,ByteCount,Destination);                         07246000
value FillWord,ByteCount,Destination;                                   07248000
                                                                        07250000
<<Function                                                              07252000
  Propagates the contents of FillWord into a record.>>                  07254000
                                                                        07256000
<<Input>>                                                               07258000
  integer                                                               07260000
    FillWord,           <<Contains the word to be used as               07262000
                          filler.>>                                     07264000
    ByteCount;          <<Number of bytes to fill.>>                    07266000
  double                                                                07268000
    Destination;        <<Word 0 - target DST number                    07270000
                               1 - target word address>>                07272000
                                                                        07274000
<<Output                                                                07276000
  None.>>                                                               07278000
                                                                        07280000
option privileged,internal;                                             07282000
                                                                        07284000
begin                                                                   07286000
integer                                                                 07288000
  FillWordCount;                                                        07290000
                                                                        07292000
if ByteCount = 1 then                                                   07294000
  begin  <<Get right byte from the target area>>                        07296000
  tos:=FillWord;                                                        07298000
  tos:=@FillWord;                                                       07300000
  tos:=Destination;                                                     07302000
  tos:=1;                                                               07304000
  asmb(mfds 4);                                                         07306000
  tos:=tos&lsr(8);  <<Merge user's byte into FillWord>>                 07308000
  FillWord.(0:8):=tos;                                                  07310000
  end;                                                                  07312000
                                                                        07314000
<<Fill the first word>>                                                 07316000
tos:=Destination;                                                       07318000
tos:=@FillWord;                                                         07320000
tos:=1;                                                                 07322000
asmb(mtds 2);  <<Leave destination+1 on the stack>>                     07324000
                                                                        07326000
<<Fill the remaining words>>                                            07328000
if (ByteCount:=ByteCount-2) > 0 then                                    07330000
  begin                                                                 07332000
  if (FillWordCount:=ByteCount&lsr(1)) > 0 then                         07334000
    begin  <<Propagate fill word into the data area>>                   07336000
    asmb(ddup,deca);                                                    07338000
    tos:=FillWordCount;                                                 07340000
    asmb(mds 3);                                                        07342000
    end;                                                                07344000
  if log(ByteCount) then FILL(FillWord,1,Ds1);                          07346000
  end;                                                                  07348000
end;  <<FILL>>                                                          07350000
integer procedure                                                       07352000
  PUTRECORD(Acb,RecordType,CallerDST,Target,UserLengthb,Control,ID);    07354000
value Acb,RecordType,CallerDST,Target,UserLengthb,Control,ID;           07356000
                                                                        07358000
<<Function                                                              07360000
  Puts the writer's data into a write buffer.>>                         07362000
                                                                        07364000
<<Input>>                                                               07366000
  integer pointer                                                       07368000
    Acb;                <<Address of the Access Control Block.>>        07370000
  integer                                                               07372000
    RecordType,         <<Type of record to be written                  07374000
                          0 - data record                               07376000
                          1 - open record                               07378000
                          2 - close record>>                            07380000
    CallerDST,          <<Data segment number of the target.>>          07382000
    Target,             <<Address of the target area.>>                 07384000
    UserLengthb,        <<Byte count of the target area.>>              07386000
    Control,            <<Carriage control byte.>>                      07388000
    ID;                 <<Writer's ID.>>                                07390000
                                                                        07392000
<<Output                                                                07394000
  PUTRECORD               Resultant file system error code.>>           07396000
                                                                        07398000
<<Algorithm                                                             07400000
  Notes: 1. This procedure assumes that there is already room for the   07402000
            record in the file.                                         07404000
                                                                        07406000
         2. Acb Error is left alone by this procedure and all           07408000
            procedures that it calls.  This allows a reader to invoke   07410000
            this procedure at no risk to the reader.                    07412000
                                                                        07414000
  If data overflows the block then                                      07416000
    begin <write the data to the disc>                                  07418000
    Increment block number                                              07420000
    If the block is in a write buffer then                              07422000
      issue disc write                                                  07424000
    Index to the next buffer                                            07426000
    If disc output is pending on the new buffer then wait               07428000
    end                                                                 07430000
  Move the record header to the header area of the buffer               07432000
  If data record then move the data to the buffer                       07434000
  Insert record delimiter                                               07436000
  If block is full then initiate disc output on it                      07438000
  Increment # active records                                            07440000
  If readers are waiting then                                           07442000
    begin                                                               07444000
    Get the head entry from wait queue                                  07446000
    Send message to the reader's reply port                             07448000
    end                                                                 07450000
>>                                                                      07452000
                                                                        07454000
option privileged,internal;                                             07456000
                                                                        07458000
begin                                                                   07460000
AbxDataStructure;                                                       07462000
integer                                                                 07464000
  WriteBuf,DataLengthw,DataLengthb,TotalRecSizew,                       07466000
  BlockAddr;                                                            07468000
array                                                                   07470000
  Blk(0:buf'prefix'size);                                               07472000
logical                                                                 07474000
  Embed:=false;                                                         07476000
integer  <<HeaderDelimiter and Header array must be contiguous>>        07478000
  HeaderDelimiter:=header'delim;                                        07480000
integer array                                                           07482000
  Header(-1:0)=q;                                                       07484000
integer                                                                 07486000
  RecordDelimiter:=record'delim;                                        07488000
                                                                        07490000
                                                                        07492000
subroutine PUTEXIT(ErrorCode);                                          07494000
value ErrorCode;                                                        07496000
                                                                        07498000
<<Function                                                              07500000
  Returns from the access procedure.>>                                  07502000
                                                                        07504000
<<Input>>                                                               07506000
  integer                                                               07508000
    ErrorCode;         <<Operation status.>>                            07510000
                                                                        07512000
<<Output                                                                07514000
  None.>>                                                               07516000
                                                                        07518000
  begin                                                                 07520000
  AbWriteError:=PUTRECORD:=ErrorCode;                                   07522000
  MAKEMMSTAT(Acb,MMput'record,ErrorCode&lsl(8)+ID,                      07524000
    RecordType&lsl(13)+AbNumRecLSW.(3:13));                             07526000
  asmb(exit 7);                                                         07528000
  end;  <<PUTEXIT>>                                                     07530000
                                                                        07532000
subroutine GETBLOCKPREFIX;                                              07534000
  begin                                                                 07536000
  tos:=@Blk;                                                            07538000
  tos:=AbPacbDst;                                                       07540000
  tos:=@AbFirstBuf+AbWriteBufx;  <<Get write buffer addr>>              07542000
  tos:=Ps0; delb;                                                       07544000
  tos:=BlockAddr:=tos-buf'prefix'size;                                  07546000
  tos:=buf'prefix'size;                                                 07548000
  asmb(mfds 4);                                                         07550000
  end;  <<GETBLOCKPREFIX>>                                              07552000
                                                                        07554000
                                                                        07556000
subroutine SAVEBLOCKPREFIX;                                             07558000
  begin                                                                 07560000
  tos:=AbPacbDst; tos:=BlockAddr;                                       07562000
  tos:=@Blk; tos:=buf'prefix'size;                                      07564000
  asmb(mtds 4);                                                         07566000
  end;  <<SAVEBLOCKPREFIX>>                                             07568000
                                                                        07570000
                                                                        07572000
subroutine STARTOUTPUT;                                                 07574000
  begin                                                                 07576000
  if AbWriteBufx >= AbNumReadBuf then                                   07578000
    begin  <<Uncoupled mode, write out block>>                          07580000
    AbNonZeroOrigin:=1;                                                 07582000
    tos:=AbWriteBufx+@AbFirstBuf; WriteBuf:=Ps0; del;                   07584000
    GETBLOCKPREFIX;                                                     07586000
    if BlkDirty then                                                    07588000
      begin  <<No anitcipatory write was done>>                         07590000
      if (tos:=DISCIO(Acb,AbWriteBlock,writeIO,WriteBuf,Blk)) <> 0 then 07592000
        PUTEXIT(*);                                                     07594000
      del;                                                              07596000
      SAVEBLOCKPREFIX;                                                  07598000
      end;                                                              07600000
    end;                                                                07602000
  end;  <<STARTOUTPUT>>                                                 07604000
                                                                        07606000
                                                                        07608000
subroutine INDEXBLOCK;                                                  07610000
                                                                        07612000
<<Function                                                              07614000
  If necessary writes out the current block, then obtains the           07616000
  next buffer.>>                                                        07618000
                                                                        07620000
  begin                                                                 07622000
  <<If necessary write out the current buffer>>                         07624000
  STARTOUTPUT;                                                          07626000
  AbWriteBlock:=AbWriteBlock+1d;                                        07628000
                                                                        07630000
  <<Select the next buffer>>                                            07632000
  if AbWriteBlock > dbl(Abnumbufs) then                                 07634000
    begin  <<Next buffer has disc output initiated>>                    07636000
    tos:=@AbFirstBuf+AbNumReadBuf; tos:=Ps0;  <<Bubble up wrt bfs>>     07638000
    asmb(xch,dup;inca);                                                 07640000
    tos:=AbNumWriteBuf-1;                                               07642000
    asmb(move 2);                                                       07644000
    Ps0:=S1;  <<First write buffer becomes last write buffer>>          07646000
    GETBLOCKPREFIX;                                                     07648000
    if (tos:=QUIESCEIO(Acb,@Ps1,Blk)) <> successful then <<Old o/p>>    07650000
      PUTEXIT(*);                                                       07652000
    del; ddel;                                                          07654000
    end                                                                 07656000
  else                                                                  07658000
    begin  <<A virgin buffer>>                                          07660000
    AbWriteBufx:=AbWriteBufx+1;                                         07662000
    GETBLOCKPREFIX;                                                     07664000
    end;                                                                07666000
                                                                        07668000
  <<Update parameters>>                                                 07670000
  tos:=@AbFirstBuf+AbWriteBufx;  <<Get write buffer addr>>              07672000
  AbWriteAddr:=Ps0; del;                                                07674000
  Abbtfrct:=Abbtfrct+1d;                                                07676000
  AbFreeWords:=0;                                                       07678000
  AbWriteHeader:=AbWriteAddr+AbBSize-1;                                 07680000
                                                                        07682000
  <<Set the buffer to dirty (because we're about to move data           07684000
    into it)>>                                                          07686000
  BlkDirty:=1;                                                          07688000
  SAVEBLOCKPREFIX;                                                      07690000
  end;  <<INDEXBLOCK>>                                                  07692000
                                                                        07694000
                                                                        07696000
subroutine INSERTCONTROL;                                               07698000
                                                                        07700000
<<Function                                                              07702000
  Inserts carriage control character into the ACB buffer.>>             07704000
                                                                        07706000
  begin                                                                 07708000
  tos:=AbWriteAddr&lsl(1)+UserLengthb+2; <<Form record's byte end addr>>07710000
  EXCHANGEDB(AbPacbDST);  <<Switch to buffer's DST>>                    07712000
  asmb(dup,deca);  <<Shift the current record one byte to right>>       07714000
  tos:=-UserLengthb;                                                    07716000
  asmb(mvb 2);                                                          07718000
  Bps0:=Control;  <<Insert the carriage control byte>>                  07720000
  del;                                                                  07722000
  EXCHANGEDB(0);  <<Back to the stack>>                                 07724000
  end;  <<INSERTCONTROL>>                                               07726000
                                                                        07728000
                                                                        07730000
subroutine INITIALIZE;                                                  07732000
                                                                        07734000
<<Function                                                              07736000
  Performs one time initialization for the procedure.>>                 07738000
                                                                        07740000
  begin                                                                 07742000
  if AbWriteError <> successful then PUTEXIT(AbWriteError);             07744000
  if Control <> no'cctl then Embed:=1;                                  07746000
  DataLengthb:=UserLengthb+int(Embed);                                  07748000
  DataLengthw:=(DataLengthb+1)&lsr(1);                                  07750000
  TotalRecSizew:=header'sizew                                           07752000
    +(if RecordType <> data'record then 0 else rec'prefixw+DataLengthw);07754000
  end;  <<INITIALIZE>>                                                  07756000
                                                                        07758000
                                                                        07760000
<<Mainline>>                                                            07762000
INITIALIZE;                                                             07764000
                                                                        07766000
<<Check if should index the block>>                                     07768000
if (AbWriteHeader-AbWriteAddr) < (TotalRecSizew+1) then INDEXBLOCK;     07770000
if (AbFreeWords-TotalRecSizew) < 0 then                                 07772000
  begin  <<Won't fit into current record frame>>                        07774000
  AbFreeWords:=AbFreeWords+AbFullRecSizew;                              07776000
  AbFreeRecords:=AbFreeRecords-1d;                                      07778000
  end;                                                                  07780000
                                                                        07782000
<<Put record header into the buffer>>                                   07784000
Header:=0;  <<Prep the local header array>>                             07786000
HDType:=RecordType;                                                     07788000
if (close'record <= RecordType <= xport'close'rec) then        <<03036>>07790000
  begin                                                        <<03036>>07792000
  if AbNumPendOpens <= 1 then HdLastClose:=1;                  <<03036>>07794000
  AbNumPendOpens:=AbNumPendOpens-1;                            <<03036>>07796000
  end                                                          <<03036>>07798000
else if RecordType = open'record then                          <<03036>>07800000
  AbNumPendOpens:=AbNumPendOpens+1;                            <<03036>>07802000
HDID:=ID;                                                               07804000
tos:=AbPacbDST;  <<Insert the header delimiter and the header>>         07806000
tos:=AbWriteHeader:=AbWriteHeader-header'sizew;                         07808000
tos:=@HeaderDelimiter;                                                  07810000
tos:=header'sizew+1;                                                    07812000
asmb(mtds 3);                                                           07814000
                                                                        07816000
<<Move user's data to the buffer area>>                                 07818000
tos:=AbWriteAddr;  <<Stack the record's buf address for the moves>>     07820000
if RecordType = data'record then                                        07822000
  begin                                                                 07824000
  tos:=@DataLengthb; tos:=1; asmb(mtds 2);  <<Move the record's Length>>07826000
  tos:=CallerDST;  <<Move the record's data>>                           07828000
  tos:=Target;                                                          07830000
  tos:=DataLengthw;                                                     07832000
  asmb(mds 3);                                                          07834000
  if Embed then INSERTCONTROL;                                          07836000
  AbWriteAddr:=S0;                                                      07838000
  end;                                                                  07840000
tos:=@RecordDelimiter; tos:=1; asmb(mtds 4);  <<Insert delimiter>>      07842000
                                                                        07844000
<<Update ACB variables>>                                                07846000
AbFreeWords:=AbFreeWords-TotalRecSizew;                                 07848000
AbNumRecords:=AbNumRecords+1d;                                          07850000
if not AbDirtyBlock then                                                07852000
  begin  <<First new record written into the block, set buffer dirty>>  07854000
  AbDirtyBlock:=1;                                                      07856000
  GETBLOCKPREFIX;                                                       07858000
  BlkDirty:=1;                                                          07860000
  SAVEBLOCKPREFIX;                                                      07862000
  end;                                                                  07864000
if RecordType = data'record then                                        07866000
  AbRtfrCt:=AbRtfrCt+1d                                                 07868000
else                                                                    07870000
  AbNumOpenClsrec:=AbNumOpenClsRec+1d;                                  07872000
                                                                        07874000
<<If cannot fit anymore records into the buffer then start the          07876000
  disc output>>                                                         07878000
if (AbWriteHeader-AbWriteAddr) < header'sizew then STARTOUTPUT;         07880000
                                                                        07882000
if RecordType = data'record or AbExtendRead then FREEREADER(Acb);       07884000
PUTEXIT(successful);                                                    07886000
end;  <<PUTRECORD>>                                                     07888000
$PAGE "FILE SYSTEM SUPPORT PROCEDURES."                                 07890000
integer procedure FCABORTREQUESTS(Dummy1,Dummy2);                       07892000
value Dummy1,Dummy2;                                                    07894000
                                                                        07896000
<<Function                                                              07898000
  Aborts possible, unsatisfied request from the caller.>>               07900000
                                                                        07902000
<<Input                                                                 07904000
    DB                    Set to the data segment containing the        07906000
                          user's parameter array.                       07908000
    Access control blk    Must be directly above the input parameters,  07910000
                          see ACB definition A in global defines.>>     07912000
  integer                                                               07914000
    Dummy1,Dummy2;      <<Dummy parameters necessary to properly        07916000
                          locate the acb.>>                             07918000
                                                                        07920000
<<Output                                                                07922000
    FCABORTREQUESTS       0 - I/O request aborted                       07924000
                          1 - I/O request has already completed, it     07926000
                              has not been deleted                      07928000
                                                                        07930000
                          2 - No I/O request was outstanding>>          07932000
<<Algorithm                                                             07934000
  Issue abort request to the wait port                                  07936000
  If local port not empty then return false                             07938000
>>                                                                      07940000
                                                                        07942000
option privileged,uncallable;                                           07944000
                                                                        07946000
begin                                                                   07948000
AaxStructure;                                                           07950000
                                                                        07952000
                                                                        07954000
LOCEXTENDACB(acb'loc,AaTargetDST,0);                                    07956000
@Acb:=@AaStart;                                                         07958000
if (FCABORTREQUESTS:=ABORTREQUESTS(Acb)) = successful then              07960000
  FCPREPAFT(AaFNum,0);  <<I/O aborted, clear the aft entry>>            07962000
UNLOCEXTENDACB(Acb);                                                    07964000
end;  <<FCABORTREQUESTS>>                                               07966000
logical procedure FCCHECKFILEND(AcbLoc,BlockNum);              <<03036>>07968000
value AcbLoc,BlockNum;                                                  07970000
                                                                        07972000
<<Function                                                              07974000
  Determines if the block number is beyond the end of                   07976000
  the file.>>                                                           07978000
                                                                        07980000
<<Input>>                                                               07982000
  integer                                                               07984000
    AcbLoc;             <<Caller's q-relative location of the acb.>>    07986000
  double                                                                07988000
    BlockNum;           <<Block number of the desired block.>>          07990000
                                                                        07992000
<<Output                                                                07994000
  FCCHECKFILEND           True  - The block is within the file.         07996000
                          False - The block lies beyond the file's      07998000
                                  end.>>                                08000000
                                                                        08002000
option privileged,uncallable;                                           08004000
                                                                        08006000
begin                                                                   08008000
FcbDataStruct1;                                                         08010000
                                                                        08012000
AcbLoc:=AcbLoc-DeltaQ;                                                  08014000
LOCK'CB(0,0,1,AcFCBDst,AcFCBCBTabAddr);                                 08016000
tos:=sizebfcb;                                                          08018000
asmb(mds 6);                                                            08020000
if BlockNum <= FcbEnd then FCCHECKFILEND:=true;                         08022000
UNLOCK'CB(0,AcFcbDst,AcFcbCBTabAddr)                                    08024000
end;  <<FCCHECKFILEND>>                                                 08026000
double procedure FCHECKMSGBLOCK(Target,Length);                         08028000
value Target,Length;                                                    08030000
                                                                        08032000
<<Function                                                              08034000
  Verifies that a msg file block is in proper format.>>                 08036000
                                                                        08038000
<<Input                                                                 08040000
    DB                    Points to target data segment.>>              08042000
  integer pointer                                                       08044000
    Target;             <<Address of the block.>>                       08046000
  integer                                                               08048000
    Length;             <<Length of the block (+words).>>               08050000
                                                                        08052000
<<Output                                                                08054000
  FCHECKMSGFILE           word 0 - Total number of records in block     08056000
                          word 1 - number of nondata recs in block      08058000
  Condition code          =      - Block has proper format              08060000
                          <      - Block has improper format            08062000
                          >      - Not returned.>>                      08064000
                                                                        08066000
option privileged,uncallable;                                           08068000
                                                                        08070000
begin                                                                   08072000
equate                                                                  08074000
  ugly'record       = false;                                            08076000
integer pointer                                                         08078000
  Header,Rec;                                                           08080000
integer                                                                 08082000
  NumRecords=FCHECKMSGBLOCK,NumOpenClsRec=FCHECKMSGBLOCK+1;             08084000
                                                                        08086000
                                                                        08088000
subroutine CHECKEXIT(GoodFormat);                                       08090000
value GoodFormat;                                                       08092000
logical                                                                 08094000
  GoodFormat;                                                           08096000
  begin                                                                 08098000
  condcode:=if GoodFormat then cce else ccl;                            08100000
  asmb(exit 2);                                                         08102000
  end;  <<CHECKEXIT>>                                                   08104000
<<Initialize>>                                                          08106000
@Rec:=@Target;                                                          08108000
@Header:=@Target+Length-1;                                              08110000
                                                                        08112000
<<Verify the block>>                                                    08114000
while HDType <> header'delim do                                         08116000
  begin  <<Verify a Record>>                                            08118000
  if HDType > max'header'type then CHECKEXIT(ugly'record);              08120000
  if (@Rec+block'overheadw) > @Header then CHECKEXIT(ugly'record);      08122000
  NumRecords:=NumRecords+1;                                             08124000
  if HDType = data'record then                                          08126000
    @Rec:=@Rec+(Rec+1)&lsr(1)+1                                         08128000
  else                                                                  08130000
    NumOpenClsRec:=NumOpenClsRec+1;                                     08132000
  @Header:=@Header-header'sizew;                                        08134000
  end;                                                                  08136000
CHECKEXIT((Rec = Record'delim));                                        08138000
end;  <<FCHECKMSGBLOCK>>                                                08140000
double procedure FCRETURNINFO(RSize,AcbLoc);                            08142000
value RSize,AcbLoc;                                                     08144000
                                                                        08146000
<<Function                                                              08148000
  Returns information peculiar to msg files.>>                          08150000
                                                                        08152000
<<Input                                                                 08154000
    DB                    Any data segment.>>                           08156000
  integer                                                               08158000
    AcbLoc;             <<Caller's q-relative location of the acb.>>    08160000
                                                                        08162000
<<Output                                                                08164000
    FCRETURNINFO          Number of records in file>>                   08166000
  integer                                                               08168000
    RSize;              <<Record size in bytes>>                        08170000
                                                                        08172000
option privileged,uncallable;                                           08174000
                                                                        08176000
begin                                                                   08178000
double                                                                  08180000
  EOF=FCRETURNINFO;                                                     08182000
                                                                        08184000
                                                                        08186000
AcbLoc:=AcbLoc-DeltaQ;                                                  08188000
if AcRead and AcExtendRead then                                         08190000
  begin  <<Reading all records, let eof show all records>>              08192000
  tos:=AcNumRecords0; tos:=AcNumRecords1;                               08194000
  EOF:=tos;                                                             08196000
  RSize:=AcRSize+header'sizeb;                                          08198000
  end                                                                   08200000
else                                                                    08202000
  begin                                                                 08204000
  tos:=AcNumRecords0; tos:=AcNumRecords1;                               08206000
  tos:=AcNumOpenCls0; tos:=AcNumOpenCls1;                               08208000
  asmb(dsub);                                                           08210000
  EOF:=tos;                                                             08212000
  RSize:=AcRSize;                                                       08214000
  end;                                                                  08216000
return 1;                                                               08218000
end;  <<FCRETURNINFO>>                                                  08220000
procedure FCGETINFO(AcbLoc,ItemType,Item);                              08222000
value AcbLoc,ItemType,Item;                                             08224000
                                                                        08226000
<<Function                                                              08228000
  Returns information peculiar to msg files.>>                          08230000
                                                                        08232000
<<Input>>                                                               08234000
  integer                                                               08236000
    AcbLoc,             <<Caller's q-relative location of the acb.>>    08238000
    ItemType;           <<Type of the desired item                      08240000
                          0 - Soft interrupt plabel>>                   08242000
                                                                        08244000
<<Output>>                                                              08246000
  pointer                                                               08248000
    Item;               <<Value of the item>>                           08250000
                                                                        08252000
option privileged,uncallable;                                           08254000
                                                                        08256000
begin                                                                   08258000
AcbLoc:=AcbLoc-DeltaQ;                                                  08260000
case ItemType of                                                        08262000
  begin                                                                 08264000
  begin  <<0 - Return the current value of soft int plabel>>            08266000
  tos:=@Item;                                                           08268000
  tos:=AcLacbDST; tos:=AcLacbAddr+Soft'plabel'loc;                      08270000
  tos:=1;                                                               08272000
  asmb(mfds);                                                           08274000
  end;                                                                  08276000
  end;                                                                  08278000
end;  <<FCGETINFO>>                                                     08280000
procedure FCAWAKEN(Pin);                                                08282000
value Pin;                                                              08284000
                                                                        08286000
<<Function                                                              08288000
  Wakes up a symbiotic process (after the File System has               08290000
  unlocked the ACB).>>                                                  08292000
                                                                        08294000
<<Input>>                                                               08296000
  integer                                                               08298000
    Pin;                <<Process's process ID number.>>                08300000
                                                                        08302000
<<Output                                                                08304000
    None.>>                                                             08306000
                                                                        08308000
option privileged,uncallable;                                           08310000
begin                                                                   08312000
integer                                                                 08314000
  PCBPtr;                                                               08316000
                                                                        08318000
                                                                        08320000
PCBPtr:=Pin*pcb'len;                                                    08322000
if < then                                                               08324000
  READYPROCESS(-PCBPtr)  <<Soft interrupt>>                             08326000
else                                                                    08328000
  AWAKE(PCBPtr,port'wake,remain'active);                                08330000
end;  <<FCAWAKEN>>                                                      08332000
procedure FCUPDATEWRITE(AcbLoc,NumOpenClsRec);                          08334000
value AcbLoc,NumOpenClsRec;                                             08336000
                                                                        08338000
<<Function                                                              08340000
  Updates # open and close header records.>>                            08342000
                                                                        08344000
<<Input>>                                                               08346000
  integer                                                               08348000
    AcbLoc,             <<Caller's q-relative address of the acb.>>     08350000
    NumOpenClsRec;      <<Number of nondata records in the block.>>     08352000
                                                                        08354000
<<Output                                                                08356000
  None.>>                                                               08358000
                                                                        08360000
option privileged,uncallable;                                           08362000
                                                                        08364000
begin                                                                   08366000
AcbLoc:=AcbLoc-DeltaQ;                                                  08368000
tos:=AcNumOpenCls0; tos:=AcNumOpenCls1;                                 08370000
tos:=0; tos:=NumOpenClsRec;                                             08372000
asmb(dadd);                                                             08374000
AcNumOpenCls1:=tos; AcNumOpenCls0:=tos;                                 08376000
end;  <<FCUPDATEWRITE>>                                                 08378000
$PAGE "MESSAGE FILE ACCESS - WRITE EOF."                                08380000
integer procedure UPDATELABEL(Acb,Fcb,Flab);                            08382000
value Acb,Fcb,Flab;                                                     08384000
                                                                        08386000
<<Function                                                              08388000
  Updates the file's label (based on the FCB).>>                        08390000
                                                                        08392000
<<Input>>                                                               08394000
  integer pointer                                                       08396000
    Acb,                <<Address of the Access Control Block.>>        08398000
    Fcb,                <<Stack DB address of the File Control Block.>> 08400000
    Flab;               <<Stack DB address of the file label.  If this  08402000
                          parameter is omitted, then the actual file    08404000
                          label will be read and used.>>                08406000
                                                                        08408000
<<Output                                                                08410000
    UPDATELABEL           Resultant file system error code.             08412000
    Label                 Updated.>>                                    08414000
                                                                        08416000
option variable,privileged,internal;                                    08418000
                                                                        08420000
begin                                                                   08422000
define                                                                  08424000
  Labelspec = pmap#;                                                    08426000
double                                                                  08428000
  DiskAddr;                                                             08430000
double pointer                                                          08432000
  Fcbdbl=Fcb,Flabdbl=Flab;                                              08434000
AbxDataStructure;                                                       08436000
                                                                        08438000
                                                                        08440000
subroutine UPDATELABELEXIT(ErrorCode);                                  08442000
value ErrorCode;                                                        08444000
                                                                        08446000
<<Function                                                              08448000
  Returns from the access method.>>                                     08450000
                                                                        08452000
<<Input>>                                                               08454000
  integer                                                               08456000
    ErrorCode;         <<Operation status.>>                            08458000
                                                                        08460000
<<Output                                                                08462000
  None.>>                                                               08464000
                                                                        08466000
  begin                                                                 08468000
  if ErrorCode <> successful then                                       08470000
    AbReadError:=ErrorCode;                                             08472000
  UPDATELABEL:=ErrorCode;                                               08474000
  asmb(exit 4);                                                         08476000
  end;  <<UPDATELABELEXIT>>                                             08478000
                                                                        08480000
                                                                        08482000
subroutine LABELIO (RW);                                                08484000
value RW;                                                               08486000
                                                                        08488000
<<Function                                                              08490000
  Reads or writes the file label into the stack buffer.>>               08492000
                                                                        08494000
<<Input>>                                                               08496000
  integer                                                               08498000
    RW;                 <<Type of I/O.                                  08500000
                          0 - read                                      08502000
                          1 - write>>                                   08504000
                                                                        08506000
<<Output                                                                08508000
  None.>>                                                               08510000
                                                                        08512000
  begin                                                                 08514000
  X:=FLABIO(FcbLDev,DiskAddr,RW,Flab);  <<R/W label>>                   08516000
  if <> then  <<Error?>>                                                08518000
    begin                                                               08520000
    FLABIOERR(X,AbFNum);  <<Handle error>>                              08522000
    UPDATELABELEXIT(lblIOerr);                                          08524000
    end;                                                                08526000
  end;  <<LABELIO>>                                                     08528000
<<Get label's disc sector number from the extent map>>                  08530000
tos:=FcbLabel;                                                          08532000
asmb(xch); tos:=tos.(8:8); asmb(xch);  <<Delete ldev field>>            08534000
DiskAddr:=tos;  <<File label sector number>>                            08536000
                                                                        08538000
if not Labelspec then                                                   08540000
  begin                                                                 08542000
  AllocFlab;  <<Allocate file label buffer>>                            08544000
  LABELIO(readIO);                                                      08546000
  end;                                                                  08548000
                                                                        08550000
<<Update the label's fields>>                                           08552000
FlEOF:=FcbEOF;  <<Update eof>>                                          08554000
FlStart:=FcbStart;                                                      08556000
FlUserLbl:=FcbUserLbl;                                                  08558000
FlEnd:=FcbEnd;                                                          08560000
FlNumOpenClsRecs:=FcbNumOpenClsRec;                                     08562000
move FlExtMap:=FcbExtMap,(FcbNumExts+1)&lsl(1);                         08564000
LDEVTOVTAB(Flextmap,Flextmap,Flnumexts+1,FcbMVTabx<>0);                 08566000
                                                                        08568000
LABELIO(writeIO);                                                       08570000
UPDATELABELEXIT(successful);                                            08572000
end;  <<UPDATELABEL>>                                                   08574000
integer procedure WRITEOF(Acb,Fcb,Flab);                                08576000
value Acb,Fcb,Flab;                                                     08578000
                                                                        08580000
<<Function                                                              08582000
  Checkpoints the disc file.>>                                          08584000
                                                                        08586000
<<Input>>                                                               08588000
  integer pointer                                                       08590000
    Acb,                <<Address of the Access Control Block.>>        08592000
    Fcb,                <<Stack DB address of the File Control Block.   08594000
                          If this parameter is omitted, then the        08596000
                          true file control block will be found and     08598000
                          used.>>                                       08600000
    Flab;               <<Stack DB address of the file label.  If this  08602000
                          parameter is omitted, then the actual file    08604000
                          label will be read and used.>>                08606000
                                                                        08608000
<<Output                                                                08610000
    WRITEOF               Resultant file system error code.             08612000
    Label, FCB            Updated.>>                                    08614000
                                                                        08616000
<<Algorithm                                                             08618000
  If head of file in current read block then                            08620000
    begin  <Squeeze read portion out of the buffer>                     08622000
    Move unread records to beginning of the buffer                      08624000
    Move unread headers to end of the buffer                            08626000
    end                                                                 08628000
  Write out the write buffers with wait                                 08630000
  Update the file control block                                         08632000
  Update and write out the file label                                   08634000
>>                                                                      08636000
                                                                        08638000
option variable,privileged,internal;                                    08640000
                                                                        08642000
begin                                                                   08644000
define                                                                  08646000
  Fcbspec   = pmap.(14:1)#,                                             08648000
  Labelspec = pmap#;                                                    08650000
integer pointer                                                         08652000
  Rec,Header;                                                           08654000
double                                                                  08656000
  RealFcbAddr,LocalFcbAddr;                                             08658000
integer                                                                 08660000
  RecDispl,QRelativeFcb,FirstBuf,FirstBufEnd,HeaderLen,RecLen,I,        08662000
  FcbDST,FcbAddr,ReturnAddr,A,DSTNum,ReadHeaderAddr,                    08664000
  HeaderDispl,Error:=successful;                                        08666000
double pointer                                                          08668000
  FcbDbl=Fcb;                                                           08670000
AbxDataStructure;                                                       08672000
logical                                                                 08674000
  FcbModified:=false;                                                   08676000
                                                                        08678000
                                                                        08680000
subroutine WRITEOFEXIT(ErrorCode);                                      08682000
value ErrorCode;                                                        08684000
                                                                        08686000
<<Function                                                              08688000
  Returns from the procedure.>>                                         08690000
                                                                        08692000
<<Input>>                                                               08694000
  integer                                                               08696000
    ErrorCode;         <<Operation status.>>                            08698000
                                                                        08700000
<<Output                                                                08702000
  None.>>                                                               08704000
                                                                        08706000
  begin                                                                 08708000
  if ErrorCode = successful then ErrorCode:=Error;                      08710000
  if ErrorCode <> successful then                                       08712000
    AbReadError:=ErrorCode;                                             08714000
  WRITEOF:=ErrorCode;                                                   08716000
  if FcbModified then                                                   08718000
    begin  <<Copy stack FCB area to the FCB>>                           08720000
    tos:=RealFcbAddr; tos:=LocalFcbAddr;                                08722000
    tos:=FcbSize;                                                       08724000
    asmb(mds 5);                                                        08726000
                                                                        08728000
    UNLOCK'CB(0,AbFcbDST,AbFcbCbTabAddr);                               08730000
    RELSIR(file'sir,A);  <<Release file sir>>                           08732000
    end;                                                                08734000
  MAKEMMSTAT(Acb,MMeof,ErrorAndAbID,AbNumRecLSW);                       08736000
  asmb(exit 4);                                                         08738000
  end;  <<WRITEOFEXIT>>                                                 08740000
subroutine DISKIO(BlockNum,Funct,Buf);                                  08742000
value BlockNum,Funct,Buf;                                               08744000
                                                                        08746000
<<Function                                                              08748000
  Performs Error free disc I/O.>>                                       08750000
                                                                        08752000
<<Input>>                                                               08754000
double                                                                  08756000
  BlockNum;             <<Desired file block number.>>                  08758000
integer                                                                 08760000
  Funct,                <<0 - read, 1 - write.>>                        08762000
  Buf;                  <<Buffer address.>>                             08764000
                                                                        08766000
  begin                                                                 08768000
  tos:=DISCIO(Acb,BlockNum,Funct,Buf);                                  08770000
  if S0 <> successful then Error:=S0;                                   08772000
  del;                                                                  08774000
  end;  <<DISKIO>>                                                      08776000
subroutine KWIESCEIO(Buf);                                              08778000
value Buf;                                                              08780000
                                                                        08782000
<<Function                                                              08784000
  Waits for I/O to finish on a buffer.>>                                08786000
                                                                        08788000
<<Input>>                                                               08790000
integer                                                                 08792000
  Buf;                  <<Buffer address.>>                             08794000
                                                                        08796000
  begin                                                                 08798000
  if (tos:=QUIESCEIO(Acb,Buf)) <> successful then Error:=tos else del;  08800000
  end;  <<KWIESCEIO>>                                                   08802000
subroutine GETFCB;                                                      08804000
  begin                                                                 08806000
  if not Fcbspec then                                                   08808000
    begin  <<Get the real FCB>>                                         08810000
    A:=GETSIR(file'sir);  <<Get file sir now!>>                         08812000
    ReturnAddr:=tos;                                                    08814000
    AllocFcb;                                                           08816000
    tos:=ReturnAddr;                                                    08818000
                                                                        08820000
    <<Lock FCB and move its contents to the stack>>                     08822000
    tos:=@Fcb; push(q); QRelativeFcb:=tos-tos;                          08824000
    LOCK'CB(0,0,QRelativeFcb,AbFcbDST,AbFcbCBTabAddr);                  08826000
    RealFcbAddr:=Ds1; LocalFcbAddr:=Ds3;                                08828000
    tos:=sizeDFCB;                                                      08830000
    asmb(mds 6);                                                        08832000
    FcbModified:=true;                                                  08834000
    end                                                                 08836000
  else                                                                  08838000
    begin  <<Update the extent map of the stack FCB because quiescing>> 08840000
           <<the I/O may have added a new extent.>>                     08842000
    <<First obtain the address of the real FCB>>                        08844000
    tos:=@Fcb; push(q);                                                 08846000
    QRelativeFcb:=tos-tos;                                              08848000
    LOCK'CB(0,0,QRelativeFcb+ext'map'loc,AbFcbDST,AbFcbCbTabAddr);      08850000
                                                                        08852000
    <<Now overlay the stack Fcb's extent map with the real Fcb's        08854000
      map.>>                                                            08856000
    tos:=tos+ext'map'loc;                                               08858000
    tos:=(FcbNumExts+1)&lsl(1);                                         08860000
    asmb(mds 6);                                                        08862000
    UNLOCK'CB(0,AbFcbDST,AbFcbCbTabAddr);                               08864000
    end;                                                                08866000
  end;  <<GETFCB>>                                                      08868000
                                                                        08870000
                                                                        08872000
subroutine ADJUSTBLOCK;                                                 08874000
<<Moves the first record and header to the edges of the block.>>        08876000
  begin                                                                 08878000
  ReadHeaderAddr:=AbReadHeader;                                         08880000
  EXCHANGEDB(AbPacbDST);  <<Switch to the buffer area>>                 08882000
                                                                        08884000
  <<Find first record to save>>                                         08886000
  @Header:=FirstBufEnd; @Rec:=FirstBuf;                                 08888000
  while @Header <> ReadHeaderAddr do                                    08890000
    begin  <<Form the record pointer>>                                  08892000
    if HDType = data'Record then @Rec:=@Rec+(Rec+1)&lsr(1)+1;           08894000
    @Header:=@Header-header'sizew;                                      08896000
    end;                                                                08898000
                                                                        08900000
  <<Form amount to move>>                                               08902000
  tos:=@Header;                                                         08904000
  while HDType <> header'delim do @Header:=@Header-header'sizew;        08906000
  HeaderLen:=S0-@Header+1;                                              08908000
  @Header:=tos;                                                         08910000
                                                                        08912000
  <<Move header>>                                                       08914000
  tos:=FirstBufEnd;                                                     08916000
  move *:=Header,(-HeaderLen);  <<Compress out the header data Recs>>   08918000
  RecDispl:=@Rec-FirstBuf;                                              08920000
                                                                        08922000
  <<Move data>>                                                         08924000
  RecLen:=0;                                                            08926000
  while Rec(RecLen) <> record'delim do                                  08928000
    RecLen:=RecLen+(Rec(RecLen)+1)&lsr(1)+1;                            08930000
  tos:=FirstBuf;  <<Compress out the read data records>>                08932000
  move *:=Rec,(RecLen+1);                                               08934000
                                                                        08936000
  EXCHANGEDB(0);  <<Back to the stack>>                                 08938000
                                                                        08940000
  <<Adjust pointers>>                                                   08942000
  HeaderDispl:=FirstBufEnd-AbReadHeader;                                08944000
  AbReadAddr:=FirstBuf;                                                 08946000
  AbReadHeader:=FirstBufEnd;                                            08948000
  if AbWriteBlock = 0d then                                             08950000
    begin  <<Both the reader and the writer on same block>>             08952000
    AbWriteAddr:=AbWriteAddr-RecDispl;  <<Adjust pointers>>             08954000
    AbWriteHeader:=AbWriteHeader+HeaderDispl;                           08956000
    FREEWRITERS(Acb,0d,RecDispl+HeaderDispl);                           08958000
    end;                                                                08960000
  DISKIO(0d,writeIO,FirstBuf);                                          08962000
  end;  <<ADJUSTBLOCK>>                                                 08964000
                                                                        08966000
                                                                        08968000
subroutine UPDATEFCB;                                                   08970000
<<Updates the msg file specific variables of the FCB.>>                 08972000
  begin                                                                 08974000
  FcbEOF:=AbNumRecords-AbNumOpenClsRec;                                 08976000
  if AbCopy then                                               <<06077>>08978000
     begin                                                     <<06077>>08978100
     if AbWriteBlock <> 0d                                     <<06077>>08978200
        then FcbEnd := AbWriteBlock - 1d;                      <<06077>>08978300
     end                                                       <<06077>>08978400
  else                                                         <<06077>>08978500
     FcbEnd := AbWriteBlock;                                   <<06077>>08978600
  FcbNumOpenClsRecs:=AbNumOpenClsRec;                                   08980000
  end;  <<UPDATEFCB>>                                                   08982000
                                                                        08984000
                                                                        08986000
<<Initialize>>                                                          08988000
FirstBuf:=AbFirstBuf; FirstBufEnd:=FirstBuf+AbBSize-1;                  08990000
                                                                        08992000
if not AbCopy then                                                      08994000
  begin                                                                 08996000
  <<Move the 1st record to the edge of the block>>                      08998000
  if AbReadHeader <> FirstBufEnd then ADJUSTBLOCK;                      09000000
                                                                        09002000
  <<Flush out the buffers>>                                             09004000
  I:=AbNumBufs; tos:=@AbFirstBuf;                                       09006000
  do                                                                    09008000
    begin  <<Insure that each block is on the disc>>                    09010000
    tos:=Ps0(I);  <<Get next buffer address>>                           09012000
    KWIESCEIO(*);                                                       09014000
    end until (I:=I-1) < 0;                                             09016000
  AbDirtyBlock:=0;                                                      09018000
  end;                                                                  09020000
                                                                        09022000
<<Update file system data structures>>                                  09024000
GETFCB;                                                                 09026000
UPDATEFCB;                                                              09028000
if LabelSpec then                                                       09030000
  UPDATELABEL(Acb,Fcb,Flab)                                             09032000
else                                                                    09034000
  UPDATELABEL(Acb,Fcb);                                                 09036000
WRITEOFEXIT(successful);                                                09038000
end;  <<WRITEOF>>                                                       09040000
$PAGE "MESSAGE FILE ACCESS - FCCLOSE PROCEDURE."                        09042000
procedure FCCLOSE(FileNum,Fcb,Flab);                                    09044000
value FileNum,Fcb,Flab;                                                 09046000
                                                                        09048000
<<Function                                                              09050000
  Closes the calling process's access to the file.>>                    09052000
                                                                        09054000
<<Input>>                                                               09056000
  integer                                                               09058000
    FileNum;            <<File's file number.>>                         09060000
  integer pointer                                                       09062000
    Fcb,                <<Stack DB address of the File Control Block.>> 09064000
    Flab;               <<Stack DB address of the file label.>>         09066000
<<  DB                    Must be at the stack.>>                       09068000
                                                                        09070000
<<Output                                                                09072000
    For a Writer, a close record is written.  The file control          09074000
    block and the label are updated.>>                                  09076000
                                                                        09078000
<<Algorithm                                                             09080000
  Abort the (possible) user's outstanding requests                      09082000
  Flush the user's reply port                                           09084000
  If Writer then                                                        09086000
    begin                                                               09088000
    if wrote >=1 rec then write the Close Record                        09090000
    If no wait Writer then deallocate record buffer control block       09092000
    end                                                                 09094000
  Deallocate the user's reply port                                      09096000
  write all buffers to the disc                                         09098000
  Update the file label                                                 09100000
  If last then                                                          09102000
    Deallocate the ACB's ports                                          09104000
  else                                                                  09106000
    begin                                                               09108000
    If this is the last read or write accessor and other accessors are  09110000
    waiting then                                                        09112000
      begin                                                             09114000
      Send marker message to the proper wait port                       09116000
      while not marker message do                                       09118000
        begin                                                           09120000
        Examine message                                                 09122000
        If not extended wait then                                       09124000
          send message indicating complementary accessor gone           09126000
        else                                                            09128000
          send message back to the back of the waiting queue            09130000
        end                                                             09132000
      end                                                               09134000
    end                                                                 09136000
>>                                                                      09138000
                                                                        09140000
option privileged,uncallable;                                           09142000
                                                                        09144000
begin                                                                   09146000
integer pointer                                                         09150000
  Acb;                                                                  09152000
define                                                                  09156000
  AcbLoc        = @AcbArray-@Q0#,                                       09158000
  AcbDST        = PacbV.(6:10)#,                                        09160000
  FcbDST        = Fcbv.(6:10)#;                                         09162000
MsgStructure;                                                           09164000
double array                                                            09166000
  DiscAddrp(*)=s-1;                                                     09168000
integer                                                                 09170000
  ReplyPort,WriteExtent,ReadExtent,ExtentSize,NumDeletions,I,           09172000
  Timeout,CloseType;                                                    09174000
integer  <<Following 2 integers accessed as an array>>                  09176000
  NoSymbiote:=no'symbiote,Zero:=0;                                      09178000
double pointer                                                          09180000
  ExtentMap;                                                            09182000
double                                                         <<06163>>09182020
  SectorCount;                                                 <<06163>>09182030
integer array                                                           09184000
  Aft(0:3)=q,AcbArray(0:acb'buf'size)=q; <<Must be last q rel declartn>>09186000
AbxDataStructure;                                                       09188000
                                                                        09190000
                                                                        09192000
integer subroutine MASSAGEWAITQUEUE(Queue);                             09194000
value Queue;                                                            09196000
                                                                        09198000
<<Function                                                              09200000
  Deletes and sends "no symbiote" message to all processes in the       09202000
  specified wait queue that are not in extended wait mode.>>            09204000
                                                                        09206000
<<Input>>                                                               09208000
integer                                                                 09210000
    Queue;              <<Address of the desired queue.>>               09212000
                                                                        09214000
<<Output                                                                09216000
    MASSAGEWAITQUEUE      number of entries deleted.>>                  09218000
                                                                        09220000
  begin                                                                 09222000
  if AbMWaitMsg then                                                    09224000
    begin  <<A single msg is in the Acb message area>>                  09226000
    if not AbMExtendWait then                                           09228000
      begin  <<The waiting process should get ccg completion>>          09230000
      ReplyPort:=GETWAITQUEUE(Acb,Queue,Msg,delete'msg);                09232000
      PUTCOMPLMSG(Acb,ReplyPort,NoSymbiote,0,MsgID);           <<02048>>09234000
      MASSAGEWAITQUEUE:=1;                                     <<03036>>09236000
      end;                                                              09238000
    end                                                                 09240000
  else                                                                  09242000
    begin  <<Must use the real wait port>>                              09244000
    FCPORTSEND(Queue,Msg,0,0);  <<Send msg with 0 reply port>>          09246000
    Timeout:=FCPORTSTATUS(Queue,current'timeout);                       09248000
    while (ReplyPort:=FCPORTRECEIVE(Queue,Msg,msg'lengthw)) <> 0 do     09250000
      begin  <<Test if accessor has extended wait>>                     09252000
      if not MsgExtendWait then                                         09254000
        begin  <<Inform accessor of the bad news>>                      09256000
        FCPORTSEND(ReplyPort,NoSymbiote,2);                             09258000
        s2:=s2+1;  <<MASSAGEWAITQUEUE:=MASSAGEWAITQUEUE+1>>             09260000
        end                                                             09262000
      else                                                              09264000
        FCPORTSEND(Queue,Msg,msg'lengthw,ReplyPort,Timeout);            09266000
      Timeout:=FCPORTSTATUS(Queue,current'timeout);                     09268000
      end;                                                              09270000
    end;                                                                09272000
  end;  <<MASSAGEWAITQUEUE>>                                            09274000
logical subroutine DELETEXTENTS;                                        09276000
                                                                        09278000
<<Function                                                              09280000
  If there are no more Writers then spent extents are returned to       09282000
  free space.>>                                                         09284000
                                                                        09286000
<<Input                                                                 09288000
  None.>>                                                               09290000
                                                                        09292000
<<Output                                                                09294000
    None.>>                                                             09296000
                                                                        09298000
  begin                                                                 09300000
  if AbNumWriters = 0 or not AbRead and AbNumWriters = 1 then           09302000
    begin  <<No more Writers, see if can delete one or more extents>>   09304000
    WriteExtent:=GETEXTENTNUM(Fcb,AbWriteBlock);                        09306000
    if (I:=WriteExtent+1) > FcbNumExts then I:=0;                       09308000
    ReadExtent:=GETEXTENTNUM(Fcb,0d); ExtentSize:=FcbExtSize;           09310000
    @ExtentMap:=@FcbExtMap; NumDeletions:=0;                            09312000
    SectorCount := 0D; << init deleted sector cnt. >>          <<06163>>09312010
    if (WriteExtent <> ReadExtent) or (WriteExtent = 0) then            09314000
      while I <> ReadExtent do                                          09316000
        begin  <<Extent by extent scan of space between EOF and SOF>>   09318000
        if I > 0 and ExtentMap(I) <> 0d then                            09320000
          begin                                                         09322000
          tos:=ExtentMap(I); ExtentMap(I):=0d;                          09324000
          NumDeletions:=NumDeletions+1;                                 09326000
          end;                                                          09328000
        if (I:=I+1) > FcbNumExts then I:=0;                             09330000
        end;                                                            09332000
    if NumDeletions <> 0 then                                           09334000
      begin  <<Found one or more extents to delete>>                    09336000
      UPDATELABEL(Acb,Fcb,Flab);  <<Update label before offing extents>>09338000
      do                                                                09340000
        begin  <<Return the extents to free space>>                     09342000
        DISKDEALLOC(ExtentSize,ExtentSize,1,DiscAddrp);                 09344000
        ddel;                                                           09346000
        SectorCount := SectorCount +Double(ExtentSize);        <<06163>>09346100
        end until (NumDeletions:=NumDeletions-1) = 0;                   09348000
        DIRECADJUST(-SectorCount,0,Flacctname,Flgrpname,       <<06163>>09348010
                    FcbMvTabx);  << adjust grp/acct space >>   <<06168>>09348020
      end;                                                              09350000
    end;                                                                09352000
  end;  <<DELETEXTENTS>>                                                09354000
                                                                        09356000
                                                                        09358000
<<Initialize>>                                                          09360000
LOC'ACB(0,AcbLoc,FileNum,%100000);                                      09362000
@Acb:=@AcbArray;                                                        09364000
AbTargetDST:=tos;                                                       09366000
LOCEXTENDACB(AcbLoc,AbTargetDST,0);                                     09368000
AbWakePin:=true;                                                        09370000
                                                                        09372000
if AbCopy then                                                          09374000
  WRITEOF(Acb,Fcb,Flab)                                                 09376000
else                                                                    09378000
  begin  <<File being accessed as a true msg file>>                     09380000
  if ABORTREQUESTS(Acb) = IOcompleted then <<Flush outstanding msgs>>   09382000
    begin  <<An I/O has completed>>                                     09384000
    <<Note - The process must be terminating otherwise FCLOSE           09386000
      would have rejected the close request with an error code          09388000
      of 77.  The kernel will clean up any "in core" ipc messages       09390000
      that may be pending against this file.>>                          09392000
    while (ReplyPort:=GETCOMPLTNMSG(Acb,Msg))                           09394000
    <> 0 do                                                             09396000
      if MsgErrorCode = successful then                                 09398000
        begin                                                           09400000
        if AbRead then                                                  09402000
          begin  <<Give back the record>>                               09404000
          AbNumReadsPend:=AbNumReadsPend-1;                             09406000
          FREEREADER(Acb);                                              09408000
          end                                                           09410000
        else                                                            09412000
          AbVirgin:=0;                                                  09414000
        end;                                                            09416000
    end;                                                                09418000
  if AbRead then                                                        09420000
    begin                                                               09422000
    if AbNumReaders = 1 then                                            09424000
      begin                                                             09426000
      AbExtendRead:=0;                                                  09428000
      MASSAGEWAITQUEUE(AbWriteQueue);                                   09430000
      end;                                                              09432000
    end                                                                 09434000
  else                                                                  09436000
    begin  <<Writer>>                                                   09438000
    if not AbVirgin then                                                09440000
      begin  <<Writer wrote one or more records>>                       09442000
      AbFreeRecords:=AbFreeRecords+1d;                                  09444000
      CloseType:=if AbCloseType = 0 then close'record else              09446000
        xport'close'rec;                                                09448000
      PUTRECORD(Acb,CloseType,0,0,0,no'cctl,AbID);                      09450000
      FREEWRITERS(Acb,0d,0);                                            09452000
      end;                                                              09454000
    if AbNumWriters = 1 then                                            09456000
      AbNumReadsPend:=AbNumReadsPend-MASSAGEWAITQUEUE(AbReadQueue);     09458000
    end;                                                                09460000
  WRITEOF(Acb,Fcb,Flab);  <<Flush buffers to the disc>>                 09462000
  DELETEXTENTS;  <<Free file space>>                                    09464000
  DELETERESOURCES(Acb,(AbShCnt <= 1));                                  09466000
  MAKEMMSTAT(Acb,MMclose,AbFreeRecLSW&lsl(8)+AbID,AbNumRecLSW);         09468000
  end;                                                                  09470000
                                                                        09472000
<<Update the acb>>                                                      09474000
UNLOCEXTENDACB(Acb);                                                    09476000
UNLOC'ACB(AcbLoc,0);  <<Roll back the PACB proper>>                     09478000
end;  <<FCCLOSE>>                                                       09480000
$PAGE "MESSAGE FILE ACCESS - FCCONTROL PROCEDURE."                      09482000
integer procedure FCCONTROL(Function,Parameter);                        09484000
value Function,Parameter;                                               09486000
                                                                        09488000
<<Function                                                              09490000
  Performs all of the control Functions against a Msg file.>>           09492000
                                                                        09494000
<<Input                                                                 09496000
    DB                    Set to the data segment containing the        09498000
                          user's parameter array.                       09500000
    Access control blk    Must be directly above the input parameters,  09502000
                          see ACB definition A in global defines.>>     09504000
  integer                                                               09506000
    Function;           <<Function to be performed.                     09508000
                          0 - Set timeout                               09510000
                          1 - Set/reset extended wait                   09512000
                          2 - Set/reset extended read                   09514000
                          3 - Set/reset non destructive read            09516000
                          4 - Set/reset soft interrupts>>               09518000
  integer pointer                                                       09520000
    Parameter;          <<Address of the user's parameter array.>>      09522000
                                                                        09524000
<<Output                                                                09526000
    FCCONTROL             File error code>>                             09528000
                                                                        09530000
option privileged,uncallable;                                           09532000
                                                                        09534000
begin                                                                   09536000
AaxStructure;  <<Must be the first declaration>>                        09538000
array                                                                   09540000
  ParmArray(0:9)=q;                                                     09542000
double                                                                  09544000
  WriteSegDesc;                                                         09546000
integer                                                                 09548000
  Plabel,ParmAddr,ParmValue,RecSize,ErrorCode=FCCONTROL,                09550000
  WriteCBAddr=WriteSegDesc,WriteCb=WriteSegDesc+1;                      09552000
                                                                        09554000
                                                                        09556000
subroutine GETRAPLABEL;                                                 09558000
                                                                        09560000
<<Function                                                              09562000
  Validates and saves the soft interrupt procedure's trap label.>>      09564000
                                                                        09566000
  begin                                                                 09568000
  Plabel:=CHECKTRAPLABEL(Parameter,DeltaQ);                             09570000
  if <> then                                                            09572000
    ErrorCode:=IllParm                                                  09574000
  else                                                                  09576000
    begin                                                               09578000
    ParmArray:=user'int; ParmArray(1):=file'soft'int;                   09580000
    ParmArray(2):=AaFNum; Parmarray(3):=Plabel;                         09582000
    FCPORTCONTROL(AaReplyPort,soft'int'index,ParmArray);                09584000
    AaSoftIntPlabel:=Plabel;                                            09586000
    FCPORTENABLE(AaReplyPort);                                          09588000
    end;                                                                09590000
  end;  <<GETRAPLABEL>>                                                 09592000
                                                                        09594000
                                                                        09596000
subroutine PROCESSOFTINT;                                               09598000
                                                                        09600000
<<Function                                                              09602000
  Performs processing necessary to arm the soft interrupt.>>            09604000
                                                                        09606000
  begin                                                                 09608000
  if not AaRead and AaWriteCB = 0 then                                  09610000
    begin  <<Writer process without a record buffer>>                   09612000
    RecSize:=(AaRSize+magic'numberb)&lsr(1);                            09614000
    FCREATECB(0,0,ownSeg,RecSize+1,lacbType);                           09616000
    if <> then                                                          09618000
      begin                                                             09620000
      EXCHANGEDB(0);                                                    09622000
      ErrorCode:=memprob;                                               09624000
      end                                                               09626000
    else                                                                09628000
      begin  <<Obtained the record buffer>>                             09630000
      WriteSegDesc:=tos;  <<Save the data seg's location>>              09632000
      FRELCB(0,WriteCB,1);                                              09634000
      EXCHANGEDB(0);                                                    09636000
      AaWriteCB:=WriteCB; AaWriteCBAddr:=WriteCBAddr+1;                 09638000
      GETRAPLABEL;                                                      09640000
      end;                                                              09642000
    end                                                                 09644000
  else                                                                  09646000
    GETRAPLABEL;                                                        09648000
  end;  <<PROCESSOFTINT>>                                               09650000
                                                                        09652000
                                                                        09654000
<<Mainline>>                                                            09656000
ParmValue:=Parameter;                                                   09658000
ParmAddr:=LOCEXTENDACB(acb'loc,AaTargetDST,Parameter);                  09660000
@Acb:=@AaStart;                                                         09662000
                                                                        09664000
case Function of                                                        09666000
  begin                                                                 09668000
  AaTimeout:=ParmValue;        <<0 Set timeout>>                        09670000
                                                                        09672000
  begin                        <<1 Extended wait>>                      09674000
  AaExtendWait:=ParmValue;                                              09676000
  AaJustOpenedWaitDisabled := (if AaJustOpened then 1 else 0); <<04139>>09678000
      << For a file just opened and disabling wait, we have >> <<04139>>09680000
      <<  a special case in CHECKRECSPACE.                  >> <<04139>>09682000
  AaJustOpened:=0;                                                      09684000
  end;                                                                  09686000
                                                                        09688000
  If AaRead then               <<2 Extended read>>                      09690000
    begin                                                               09692000
    if AaNumReadsPend <> 0 then                                         09694000
      FCCONTROL:=mltiaccerr                                             09696000
    else                                                                09698000
      AaExtendRead:=ParmValue;                                          09700000
    end                                                                 09702000
  else                                                                  09704000
    FCCONTROL:=accviol;                                                 09706000
                                                                        09708000
  if AaRead then               <<3 Nondestructive read>>                09710000
    AaNonDestruct:=ParmValue                                            09712000
  else                                                                  09714000
    FCCONTROL:=accviol;                                                 09716000
                                                                        09718000
  begin                        <<4 Soft interrupts>>                    09720000
  push(q,dl); asmb(xch,sub);  <<Form dl-q>>                             09722000
  X:=tos-(AaFNum+1)*aft'entry'size;  <<X:=@Aft0(File)>>                 09724000
  if Aq3(x) <> 0 then                                                   09726000
    ErrorCode:=IOPending                                                09728000
  else                                                                  09730000
    begin                                                               09732000
    if (ParmArray:=Parameter) = 0 then                                  09734000
      begin  <<Turning off soft interrupts>>                            09736000
      AaSoftIntPlabel:=0;                                               09738000
      FCPORTCONTROL(AaReplyPort,soft'int'index,ParmArray);              09740000
      FCPORTDISABLE(AaReplyPort);                                       09742000
      end                                                               09744000
    else                                                                09746000
      PROCESSOFTINT;  <<Putting in new soft int procedure>>             09748000
    end;                                                                09750000
  end;                                                                  09752000
  end;  <<Case>>                                                        09754000
                                                                        09756000
MAKEMMSTAT(Acb,MMcontrol,ErrorAndAaID,                                  09758000
  Function&lsl(12)+ParmValue.(4:12));                                   09760000
UNLOCEXTENDACB(Acb);                                                    09762000
end;  <<FCCONTROL>>                                                     09764000
$PAGE "MESSAGE FILE ACCESS - FCINIT PROCEDURE."                         09766000
integer procedure FCINITACB(Acb,Limit,NumOpenClsRecs,NumBlocks);        09768000
value Acb,Limit,NumOpenClsRecs,NumBlocks;                               09770000
                                                                        09772000
<<Function                                                              09774000
  Initializes the message portion of the ACB for the first opener       09776000
  of the msg file.>>                                                    09778000
                                                                        09780000
<<Input                                                                 09782000
    DB                    Pointing to Pacb data segment.>>              09784000
  integer pointer                                                       09786000
    Acb;                <<Address of the Access Control Block.>>        09788000
  double                                                                09790000
    Limit,              <<Maximum # of records in the file.>>           09792000
    NumOpenClsRecs,     <<Total number of header records.>>             09794000
    NumBlocks;          <<Number of blocks already written.>>           09796000
                                                                        09798000
<<Output                                                                09800000
    FCINITACB             Resultant error code.>>                       09802000
                                                                        09804000
<<Algorithm                                                             09806000
  Clear out the msg portion of the ACB                                  09808000
  Set ID bit map to all ones                                            09810000
  if not in copy mode then                                              09812000
    begin                                                               09814000
    Fill in the buffer addresses                                        09816000
    Get the read and write wait queue ports                             09818000
    Initialize the IPC-specific portions of the ACB                     09820000
    end                                                                 09822000
>>                                                                      09824000
                                                                        09826000
option privileged,uncallable;                                           09828000
                                                                        09830000
begin                                                                   09832000
AbxDataStructure;                                                       09834000
integer                                                                 09836000
  ClearCount,I,FirstBuf,BSize;                                          09838000
                                                                        09840000
                                                                        09842000
subroutine INITEXIT(ErrorCode);                                         09844000
value ErrorCode;                                                        09846000
                                                                        09848000
<<Function                                                              09850000
  Returns from the access method.>>                                     09852000
                                                                        09854000
<<Input>>                                                               09856000
  integer                                                               09858000
    ErrorCode;         <<Operation status.>>                            09860000
                                                                        09862000
<<Output                                                                09864000
  None.>>                                                               09866000
                                                                        09868000
  begin                                                                 09870000
  if (FCINITACB:=ErrorCode) <> successful then                          09872000
    begin                                                               09874000
    if AbReadQueue <> 0 then FCPORTCLOSE(AbReadQueue);                  09876000
    if AbWriteQueue <> 0 then FCPORTCLOSE(AbWriteQueue);                09878000
    end                                                                 09880000
  else                                                                  09882000
    begin  <<Log out the initiation>>                                   09884000
    tos:=trace'group1;                                                  09886000
    tos:=0; TSubGroup:=MMinit;                                          09888000
    tos:=FCGETVERSION;                                                  09890000
    MMSTAT(*,*,*,*);                                                    09892000
    end;                                                                09894000
  asmb(exit 7);                                                         09896000
  end;  <<INITEXIT>>                                                    09898000
<<Initialize>>                                                          09900000
BSize:=AbBSize;                                                         09902000
                                                                        09904000
if not AbCopy then                                                      09906000
  begin  <<File to be accessed using Msg Access>>                       09908000
  <<Clear out the message area>>                                        09910000
  ClearCount:=pacb'msg'size                                             09912000
    +(AbNumBufs+1)*(BSize+buf'prefix'size+1);                           09914000
  tos:=@AbmsgStart; Ps0:=0;                                             09916000
  move Ps0(1):=Ps0,(ClearCount);                                        09918000
                                                                        09920000
  tos:=@AbIDMap; Ps0:=-1;  <<Set ID bit map to all ones>>               09922000
  move Ps0(1):=Ps0,(maxIDindex');                                       09924000
                                                                        09926000
  <<Place the buffer addresses into the ACB>>                           09928000
  I:=-1; tos:=@AbFirstBuf;                                              09930000
  FirstBuf:=S0+AbNumBufs+1+buf'prefix'size;                             09932000
  while (I:=I+1) <= AbNumBufs do Ps0(I):=FirstBuf+I*AbBufSize;          09934000
                                                                        09936000
  <<Allocate the read and write wait queues>>                           09938000
  if (AbReadQueue:=FCPORTOPEN(no'secure)) = 0 then INITEXIT(memprob);   09940000
  if (AbWriteQueue:=FCPORTOPEN(no'secure))=0 then INITEXIT(memprob);    09942000
                                                                        09944000
  <<Initialize the simple stuff>>                                       09946000
  AbFullRecSizew:=(Bsize-block'overheadw)/AbBlkFact;                    09948000
  AbNumOpenClsRec:=NumOpenClsRecs;                                      09950000
  AbNumWriteBuf:=AbNumBufs;                                             09952000
  AbNumReadBuf:=1;                                                      09954000
  AbWriteBlock:=if AbWrite then 0d else NumBlocks;                      09956000
  AbReadAddr:=FirstBuf;                                                 09958000
  AbReadHeader:=FirstBuf+BSize-1;                                       09960000
  if (AbNumRecords:=AbNumRecords+NumOpenClsRecs) = 0d then              09962000
    begin  <<File is empty>>                                            09964000
    AbWriteHeader:=FirstBuf+BSize-1;                                    09966000
    AbWriteAddr:=FirstBuf;                                              09968000
    AbFreeRecords:=Limit;                                               09970000
    end                                                                 09972000
  else  <<Nonempty, note that # free words updated in FILLBUFFERS>>     09974000
    AbFreeRecords:=Limit-(NumBlocks+1d)*dbl(AbBlkFact);                 09976000
  end;                                                                  09978000
INITEXIT(successful);                                                   09980000
end;  <<FCINITACB>>                                                     09982000
$PAGE "MESSAGE FILE ACCESS - FOPEN PROCEDURE."                          09984000
integer procedure FCOPEN(Acb,LacbV);                                    09986000
value Acb,LacbV;                                                        09988000
                                                                        09990000
<<Function                                                              09992000
  Performs local initialization (Lacb) for a msg file open.>>           09994000
                                                                        09996000
<<Input                                                                 09998000
  DB                      Set to the real pacb's data segment.>>        10000000
  integer pointer                                                       10002000
    Acb;                <<Address of the Access Control Block.>>        10004000
  integer                                                               10006000
    LacbV;              <<Vector table word of the lacb.>>              10008000
                                                                        10010000
<<Output                                                                10012000
    FCOPEN                Resultant error number.>>                     10014000
                                                                        10016000
<<Algorithm                                                             10018000
  If not in copy mode then                                              10020000
    begin                                                               10022000
    Get local reply port                                                10024000
    If writer then                                                      10026000
      begin                                                             10028000
      If no ID numbers left or no room for open/close records then      10030000
        reject the open (no virtual memory)                             10032000
      If no wait writer then allocate record buffer control block       10034000
      end                                                               10036000
    Initialize the remainder of the Lacb variables                      10038000
    end                                                                 10040000
>>                                                                      10042000
                                                                        10044000
option privileged,uncallable;                                           10046000
                                                                        10048000
begin                                                                   10050000
array                                                                   10052000
  Lacbx(0:lacbx'size)=q;  <<Must be at q+1>>                            10054000
equate                                                                  10056000
  lacb'q'loc    = 1;                                                    10058000
define                                                                  10062000
  dstn          = (6:10)#,                                              10064000
  vta           = &lsr(10)&lsl(2)+5#;                                   10066000
AbxDataStructure;                                                       10068000
double                                                                  10070000
  WriteSegDesc;                                                         10072000
integer                                                                 10074000
  WriteCBAddr=WriteSegDesc,WriteCB=WriteSegDesc+1,RecSize,I,AcbDst;     10076000
                                                                        10078000
                                                                        10080000
subroutine OPENEXIT(ErrorCode);                                         10082000
value ErrorCode;                                                        10084000
                                                                        10086000
<<Function                                                              10088000
  Returns from the access method.>>                                     10090000
                                                                        10092000
<<Input>>                                                               10094000
  integer                                                               10096000
    ErrorCode;         <<Operation status.>>                            10098000
                                                                        10100000
<<Output                                                                10102000
  None.>>                                                               10104000
                                                                        10106000
  begin                                                                 10108000
  if (FCOPEN:=AbError:=ErrorCode) <> successful then                    10110000
    DELETERESOURCES(Acb,(AbShCnts <= 1));                               10112000
  MAKEMMSTAT(Acb,MMopen,ErrorAndAbID,AbNumRecLSW);                      10114000
  asmb(exit 2);                                                         10116000
  end;  <<OPENEXIT>>                                                    10118000
subroutine UPDATELACB;                                                  10120000
                                                                        10122000
<<Function                                                              10124000
  Moves the configured local array to the real lacb.>>                  10126000
                                                                        10128000
  begin                                                                 10130000
  <<Get the lacb's address>>                                            10132000
  LOCK'CB(0,0,lacb'q'loc,Lacbv.dstn, LacbV vta);                        10134000
  tos:=tos+lacbx'loc;                                                   10136000
  asmb(dxch);                                                           10138000
                                                                        10140000
  <<Update the lacb>>                                                   10142000
  tos:=lacbx'size;                                                      10144000
  asmb(mds 5);                                                          10146000
  del;                                                                  10148000
  UNLOCK'CB(0,Lacbv.dstn,LacbV vta);                                    10150000
  end;  <<UPDATELACB>>                                                  10152000
                                                                        10154000
                                                                        10156000
if not AbCopy then                                                      10158000
  begin                                                                 10160000
  <<Initialize>>                                                        10162000
  RecSize:=(AbRSize+magic'numberb)&lsr(1);                              10164000
  if AbShCnts = 0 then                                                  10166000
    begin  <<Not opened with multiaccess>>                              10168000
    AbShCnts:=1;                                                        10170000
    if AbRead then AbShCntIn:=1;                                        10172000
    end;                                                                10174000
                                                                        10176000
  <<Clear out the Lacb portions of the ACB>>                            10178000
  I:=-1;                                                                10180000
  while (I:=I+1) < lacbx'size do Lacbx(I):=0;                           10182000
                                                                        10184000
  <<Get reply port>>                                                    10186000
  if (LxReplyPort:=FCPORTOPEN) = 0 then OPENEXIT(memprob);              10188000
                                                                        10190000
  if not AbRead then                                                    10192000
    begin  <<Writer>>                                                   10194000
    LxVirgin:=1;                                                        10196000
    if (LxID:=GETID(AbIDMap)) = 0 then OPENEXIT(navaildev);             10198000
    if AbNoWait then                                                    10200000
      begin  <<Allocate record buffer for the writer>>                  10202000
      AcbDst:=EXCHANGEDB(0);                                            10204000
      FCREATECB(0,0,ownSeg,RecSize+1,lacbType);                         10206000
      if <> then                                                        10208000
        begin                                                           10210000
        EXCHANGEDB(AcbDst);                                             10212000
        OPENEXIT(memprob);                                              10214000
        end;                                                            10216000
      WriteSegDesc:=tos;  <<Save the data seg's location>>              10218000
      FRELCB(0,WriteCB,1);                                              10220000
      EXCHANGEDB(AcbDst);                                               10222000
      LxWriteCB:=WriteCB; LxWriteCBAddr:=WriteCBAddr+1;                 10224000
      end;                                                              10226000
    end                                                                 10228000
  else                                                                  10230000
    LxID:=0;  <<Reader>>                                                10232000
                                                                        10234000
  <<Initialize remainder of the Lxcb>>                                  10236000
  LxJustOpened:=1;                                                      10238000
  UPDATELACB;                                                           10240000
  end;                                                                  10242000
OPENEXIT(successful);                                                   10244000
end;  <<FCOPEN>>                                                        10246000
$PAGE "MESSAGE FILE ACCESS - FCREAD PROCEDURE."                         10248000
procedure FCREAD(Function,Addr,Tcount);                                 10250000
value Function,Addr,Tcount;                                             10252000
                                                                        10254000
<<Function                                                              10256000
  Initiates and/or completes an FREAD for a message                     10258000
  file.>>                                                               10260000
                                                                        10262000
<<Input                                                                 10264000
    DB                    Set to the data segment containing the        10266000
                          user's buffer.                                10268000
    Access control blk    Must be directly above the input parameters,  10270000
                          see ACB definition A in global defines.>>     10272000
  integer                                                               10274000
    Function,           <<Function to be performed                      10276000
                          0 - initiate a read (complete it if wait and  10278000
                              soft interrupts)                          10280000
                          1 - complete a read>>                         10282000
    Addr,               <<Address of the user's buffer area.>>          10284000
    Tcount;             <<User's tcount parameter.>>                    10286000
                                                                        10288000
                                                                        10290000
<<Output                                                                10292000
    Function              Resultant condition code.                     10294000
    Addr                  <>0, Pin of process to wake.                  10296000
    Acb                   Various fields are updated.  Most             10298000
                          importantly AaError and AaTlog.>>             10300000
                                                                        10302000
<<Algorithm                                                             10304000
                                                                        10306000
  Wait read                                                             10308000
  ---------                                                             10310000
  If not reading open/close records then flush them from head of        10312000
  the file.                                                             10314000
  If (# active records - # pending read reqs) is > 0 then               10316000
    get the record (GETRECORD)                                          10318000
  else                                                                  10320000
    begin                                                               10322000
    If writer opened or just opened or extended wait then               10324000
      begin  <empty file, must wait for the record>                     10326000
      Long wait                                                         10328000
      Get message from reply port                                       10330000
      If message = successful then                                      10332000
        get the record using GETRECORD                                  10334000
      else If message = Timeout then                                    10336000
        return timeout status                                           10338000
      else  <no writer>                                                 10340000
        return EOF                                                      10342000
      end                                                               10344000
    else                                                                10346000
      return EOF                                                        10348000
    end                                                                 10350000
                                                                        10352000
  Initiate nowait/soft interrupt Read                                   10354000
  --------------------                                                  10356000
  If not reading open/close records then flush them from head of        10358000
  the file.                                                             10360000
  If (# active records - # pending read reqs) is > 0 then               10362000
    Send successful message to own reply port                           10364000
  else                                                                  10366000
    begin                                                               10368000
    If writer opened or just opened or extended wait then               10370000
      Send message to wait queue                                        10372000
    else  <No writer>                                                   10374000
      Send EOF msg to own reply port                                    10376000
    end                                                                 10378000
                                                                        10380000
  Complete nowait Read                                                  10382000
  --------------------                                                  10384000
  Same as wait read after long wait statement                           10386000
>>                                                                      10388000
                                                                        10390000
option privileged,uncallable;                                           10392000
                                                                        10394000
begin                                                                   10396000
AaxStructure;  <<Must be first declaration>>                            10398000
MsgStructure;                                                           10400000
logical                                                                 10402000
  ByteTlog;                                                             10404000
integer                                                                 10406000
  Target,LastDataWord,FillWord,FillLength,UserLengthb,                  10408000
  Address,ConditionCode=Function,HeaderXferb:=0,DataXferb:=0;           10410000
logical                                                                 10412000
  WaitForCompletion:=true;                                              10414000
                                                                        10416000
                                                                        10418000
subroutine READEXIT(ErrorCode);                                         10420000
value ErrorCode;                                                        10422000
                                                                        10424000
<<Function                                                              10426000
  Returns from the access procedure.>>                                  10428000
                                                                        10430000
<<Input>>                                                               10432000
  integer                                                               10434000
    ErrorCode;         <<Operation status.>>                            10436000
                                                                        10438000
<<Output                                                                10440000
  None.>>                                                               10442000
                                                                        10444000
  begin                                                                 10446000
  if WaitForCompletion then                                             10448000
    begin                                                               10450000
    if ErrorCode = no'symbiote then                                     10452000
      begin  <<Return EOF status>>                                      10454000
      ErrorCode:=successful;                                            10456000
      ConditionCode:=ccg                                                10458000
      end                                                               10460000
    else if ErrorCode = successful then                                 10462000
      ConditionCode:=cce                                                10464000
    else                                                                10466000
      ConditionCode:=ccl;                                               10468000
    AaError:=ErrorCode;                                                 10470000
    MAKEMMSTAT(Acb,MMread'compltn,ErrorAndReadID,AaNumRecLSW);          10472000
    end                                                                 10474000
  else                                                                  10476000
    begin  <<No wait initiation>>                                       10478000
    if ErrorCode <> successful then PUTMYCOMPLTNMSG(Acb,ErrorCode,0);   10480000
    ConditionCode:=cce;                                                 10482000
    end;                                                                10484000
  AaJustOpened:=0;                                                      10486000
  UNLOCEXTENDACB(Acb);                                                  10488000
  asmb(exit 1);                                                         10490000
  end;  <<READEXIT>>                                                    10492000
subroutine TRACEREADINIT;                                               10494000
  begin                                                                 10496000
  MAKEMMSTAT(Acb,MMread'init,AaFreeRecLSW,AaNumRecLSW);                 10498000
  end;  <<TRACEREADINIT>>                                               10500000
                                                                        10502000
                                                                        10504000
subroutine CHECKREADERROR;                                              10506000
                                                                        10508000
<<Function                                                              10510000
  Checks that a previous irrecoverable read error has not occurred.>>   10512000
                                                                        10514000
  begin                                                                 10516000
  if AaReadError <> successful then READEXIT(AaReadError);              10518000
  end;  <<CHECKREADERROR>>                                              10520000
                                                                        10522000
                                                                        10524000
subroutine CHECKRECFORMAT;                                              10526000
                                                                        10528000
<<Function                                                              10530000
  Insures that the current record has a reasonable format.>>            10532000
                                                                        10534000
  begin                                                                 10536000
  if AaRecLengthb > AaRSize or AaHeader > max'header'type or   <<06075>>10538000
  AaHeader = data'record and AaRecLengthb = record'delim then  <<06075>>10539000
    begin  <<Fail this read and all future reads>>                      10540000
    AaReadError:=badvarblk;                                             10542000
    READEXIT(badvarblk);                                                10544000
    end;                                                                10546000
  end;  <<CHECKRECFORMAT>>                                              10548000
                                                                        10550000
                                                                        10552000
subroutine ANALYZELENGTH;                                               10554000
  begin                                                                 10556000
  <<Analyze Tcount parameter>>                                          10558000
  tos:=Tcount;                                                          10560000
  if < then                                                             10562000
    begin  <<Count in bytes>>                                           10564000
    ByteTlog:=true;                                                     10566000
    tos:=-tos;  <<Form positive bytes>>                                 10568000
    end                                                                 10570000
  else                                                                  10572000
    begin  <<Count in words>>                                           10574000
    ByteTlog:=false;                                                    10576000
    tos:=tos&lsl(1);                                                    10578000
    end;                                                                10580000
  UserLengthb:=tos;  <<Save positive byte count>>                       10582000
  if UserLengthb > AaRSize then UserLengthb:=AaRSize;                   10584000
  end;  <<ANALYZELENGTH>>                                               10586000
                                                                        10588000
                                                                        10590000
subroutine GETRECORD;                                                   10592000
                                                                        10594000
<<Function                                                              10596000
  Obtains the next record from the input buffer.>>                      10598000
                                                                        10600000
<<Algorithm                                                             10602000
  If at end of current block then index into next block                 10604000
  If extended read then                                                 10606000
    move record prefix and data to the target area                      10608000
  else                                                                  10610000
    move only data to target area                                       10612000
  If odd number of bytes then merge last byte into user's buffer        10614000
  If fixed length then pad remainder of user's area                     10616000
  If a destructive read and have exhausted the block then               10618000
    issue an anticipatory read of the next block                        10620000
>>                                                                      10622000
                                                                        10624000
  begin                                                                 10626000
  <<Check if at end of current block>>                                  10628000
  if AaHeader = header'delim then                                       10630000
    begin  <<At end, index to the next block>>                          10632000
    if (tos:=INDEXRECORD(Acb,weight)) <> successful then READEXIT(*);   10634000
    del;                                                                10636000
    end;                                                                10638000
  CHECKRECFORMAT;                                                       10640000
  ANALYZELENGTH;                                                        10642000
                                                                        10644000
  tos:=AaTargetDST; tos:=Target;  <<Destination address for moves>>     10646000
                                                                        10648000
  <<If reader has extended read, then give him the record header>>      10650000
  if AaExtendRead then                                                  10652000
    begin  <<Move the record header to user target area>>               10654000
    tos:=@AaHeader;                                                     10656000
    tos:=(HeaderXferb:=if UserLengthb > header'sizeb then header'sizeb  10658000
      else UserLengthb)&lsr(1);                                         10660000
    asmb(mtds 2);                                                       10662000
    UserLengthb:=UserLengthb-header'sizeb;                              10664000
    end;                                                                10666000
                                                                        10668000
  <<Move the data portion to the reader's target area>>                 10670000
  if AaHeader = data'record and UserLengthb > 0 then                    10672000
    begin                                                               10674000
    DataXferb:=if AaRecLengthb < UserLengthb then AaRecLengthb          10676000
    else UserLengthb;                                                   10678000
    tos:=AaPacbDST; <<Move the data from the buffer to the user area>>  10680000
    tos:=AaReadAddr+1;                                                  10682000
    tos:=DataXferb&lsr(1);                                              10684000
    asmb(mds 1);                                                        10686000
    if log(DataXferb) then                                              10688000
      begin  <<Must transfer the odd byte of the message>>              10690000
      tos:=@LastDataWord;  <<Get the last word of the record>>          10692000
      asmb(cab,cab); tos:=1; asmb(mfds 4);                              10694000
      if AaFixed and UserLengthb > DataXferb+1 then                     10696000
        begin  <<Right byte must be fill character>>                    10698000
        LastDataWord.(8:8):=if AaAscii then " " else 0;                 10700000
        FILL(LastDataWord,2,Ds1);                                       10702000
        DataXferb:=DataXferb+1;                                         10704000
        end                                                             10706000
      else                                                              10708000
        FILL(LastDataWord,1,Ds1);  <<Right byte from user area>>        10710000
      tos:=tos+1;  <<Increment destination address>>                    10712000
      end                                                               10714000
    else                                                                10716000
      ddel;  <<Delete remnants from the previous move>>                 10718000
    end;                                                                10720000
                                                                        10722000
  <<If fixed length format, fill the remainder of user buffer>>         10724000
  if AaFixed and (FillLength:=UserLengthb-DataXferb) > 0 then           10726000
    begin  <<Pad the fixed-length user target area>>                    10728000
    FillWord:=if AaAscii then "  " else 0;                              10730000
    FILL(FillWord,FillLength,Ds1);                                      10732000
    DataXferb:=UserLengthb;                                             10734000
    end;                                                                10736000
  ddel;  <<Delete target address>>                                      10738000
                                                                        10740000
  <<Post process>>                                                      10742000
  tos:=DataXferb+HeaderXferb;                                           10744000
  if not ByteTlog then tos:=(tos+1)&lsr(1);                             10746000
  AaTlog:=tos;                                                          10748000
  if AaHeaderCrash then AaError:=systemcrash;                           10750000
  if AaNonDestruct then FREEREADER(ACB);<<Maybe possible to  >><<06358>>10751000
                                        <<free another reader>><<06358>>10751100
  AaNonDestruct:=0;                                                     10752000
  if = then INDEXRECORD(Acb,no'weight);  <<Reader wants record deleted>>10754000
  end;  <<GETRECORD>>                                                   10756000
                                                                        10758000
                                                                        10760000
subroutine FLUSHRECORDS;                                                10762000
                                                                        10764000
<<Function                                                              10766000
  Flushes leading open/close records until either the file is           10768000
  exhausted or a data record is encountered.>>                          10770000
                                                                        10772000
  begin                                                                 10774000
  while AaHeader <> data'record and AaNumRecords <> 0d do               10776000
    begin                                                               10778000
    CHECKRECFORMAT;                                                     10780000
    if (tos:=INDEXRECORD(Acb,weight)) <> successful then READEXIT(*);   10782000
    del;                                                                10784000
    if AaHeaderCrash then READEXIT(systemcrash);                        10786000
    end;                                                                10788000
  end;  <<FLUSHRECORDS>>                                                10790000
                                                                        10792000
                                                                        10794000
logical subroutine WAITABLE;                                            10796000
                                                                        10798000
<<Function                                                              10800000
  Determine if the reader has the moxie to wait on a writerless         10802000
  file.>>                                                               10804000
                                                                        10806000
  begin                                                                 10808000
  if (AaNumWriters <> 0) or AaExtendWait or AaJustOpened then           10810000
    begin                                                               10812000
    WAITABLE:=true;                                                     10814000
    AaNumReadsPend:=AaNumReadsPend+1;                                   10816000
    end;                                                                10818000
  end;  <<WAITABLE>>                                                    10820000
                                                                        10822000
                                                                        10824000
subroutine PROCESSCOMPLETEDREAD;                                        10826000
                                                                        10828000
<<Function                                                              10830000
  Performs post processing on ready reads.  Used by all no wait         10832000
  reads and all impeded reads.  The routine performs the data           10834000
  movement.>>                                                           10836000
                                                                        10838000
  begin                                                                 10840000
<<Target := AbTarget; <<restore target & tcount in case>>      <<06284>>10841000
<<Tcount := AbTcount; <<of IOWAIT without optional parms>>     <<06284>>10841100
  GETCOMPLTNMSG(Acb,Msg);                                               10842000
  if < then                                                             10844000
    begin                                                               10846000
    AaNumReadsPend:=AaNumReadsPend-1;                                   10848000
    READEXIT(softimeout);                                               10850000
    end;                                                                10852000
  if MsgErrorCode <> successful then READEXIT(MsgErrorCode);            10854000
  AaNumReadsPend:=AaNumReadsPend-1;                                     10856000
  if not AaExtendRead then FLUSHRECORDS;                                10858000
  CHECKREADERROR;                                                       10860000
  Tcount:=MsgTlog;                                                      10862000
  end;  <<PROCESSCOMPLETEDREAD>>                                        10864000
                                                                        10866000
                                                                        10868000
subroutine REQINITIALIZE;                                               10870000
                                                                        10872000
<<Function                                                              10874000
  Performs one time preprocessing for the request.>>                    10876000
                                                                        10878000
  begin                                                                 10880000
  TRACEREADINIT;                                                        10882000
  CHECKREADERROR;                                                       10884000
  AbTarget := Target;  <<save target for nowait return>>       <<06243>>10885000
  AbTcount := Tcount;  <<save tcount for nowait return>>       <<06243>>10885100
  if not AaExtendRead then FLUSHRECORDS;                                10886000
  end;  <<REQINITIALIZE>>                                               10888000
                                                                        10890000
                                                                        10892000
subroutine INITIALIZE;                                                  10894000
                                                                        10896000
<<Function                                                              10898000
  Initializes local data.>>                                             10900000
                                                                        10902000
  begin                                                                 10904000
  Address:=Addr; Addr:=0;                                               10906000
  AaError:=successful; AaTlog:=0;                                       10908000
  Target:=LOCEXTENDACB(acb'loc,AaTargetDST,Address);                    10910000
  @Acb:=@AaStart;                                                       10912000
  if AaBufNotFilled then FILLBUFFERS(Acb);                              10914000
  GETRECORDETAILS(Acb);                                                 10916000
  end;  <<INITIALIZE>>                                                  10918000
                                                                        10920000
                                                                        10922000
<<Mainline>>                                                            10924000
INITIALIZE;                                                             10926000
                                                                        10928000
<<Execute the request>>                                                 10930000
case Function of                                                        10932000
  begin                                                                 10934000
  begin  <<** Initiate read>>                                           10936000
  if AaWait and AaSoftIntPlabel = 0 then                                10938000
    begin  <<Initiate and complete a read>>                             10940000
    REQINITIALIZE;                                                      10942000
    if CHECKFORECORDS(Acb) > 0D then                                    10944000
      GETRECORD                                                         10946000
    else if WAITABLE then                                               10948000
      begin  <<No record present, wait for an FWRITE>>                  10950000
      LONGWAIT(Acb,AaReadQueue,0,0,Tcount);                             10952000
      GETRECORDETAILS(Acb);                                             10954000
      PROCESSCOMPLETEDREAD;                                             10956000
      GETRECORD;                                                        10958000
      end                                                               10960000
    else                                                                10962000
      READEXIT(no'symbiote);                                            10964000
    end                                                                 10966000
  else                                                                  10968000
    begin  <<Initiate no-wait read>>                                    10970000
    REQINITIALIZE;                                                      10972000
    WaitForCompletion:=false;                                           10974000
    if CHECKFORECORDS(Acb) > 0D then                                    10976000
      begin  <<Record present, allocate it>>                            10978000
      AaNumReadsPend:=AaNumReadsPend+1;                                 10980000
      PUTMYCOMPLTNMSG(Acb,successful,tcount);                           10982000
      end                                                               10984000
    else if WAITABLE then                                               10986000
      begin  <<No record present, get into end of the wait queue>>      10988000
      if AaError = successful then                                      10990000
        begin                                                           10992000
        PUTWAITQUEUE(Acb,0,0,Tcount);                                   10994000
        FCPREPAFT(AaFNum,                                               10996000
          if AaSoftIntPlabel = 0 then AaReplyPort else soft'int'pend);  10998000
        end;                                                            11000000
      end                                                               11002000
    else                                                                11004000
      READEXIT(no'symbiote);                                            11006000
    end;                                                                11008000
  end;                                                                  11010000
                                                                        11012000
  begin                  <<** Complete no-wait read>>                   11014000
  PROCESSCOMPLETEDREAD;                                                 11016000
  GETRECORD;                                                            11018000
  end;                                                                  11020000
  end;  <<case>>                                                        11022000
                                                                        11024000
READEXIT(AaError);                                                      11026000
end;  <<FCREAD>>                                                        11028000
$PAGE "MESSAGE FILE ACCESS - FCWRITE PROCEDURE."                        11030000
procedure FCWRITE(Function,Addr,Tcount);                                11032000
value Function,Addr,Tcount;                                             11034000
                                                                        11036000
<<Function                                                              11038000
  Initiates and/or completes an FWRITE for a message                    11040000
  file.>>                                                               11042000
                                                                        11044000
<<Input                                                                 11046000
    DB                    Set to the data segment containing the        11048000
                          user's buffer.                                11050000
    Access control blk    Must be directly above the input parameters,  11052000
                          see ACB definition A in global defines.>>     11054000
  integer                                                               11056000
    Function,           <<Function to be performed                      11058000
                          0 - initiate a write (complete it if wait and 11060000
                             soft interrupts not enabled                11062000
                          1 - complete a write>>                        11064000
    Addr,               <<Address of the user's buffer area.>>          11066000
    Tcount;             <<User's tcount parameter.>>                    11068000
                                                                        11070000
<<Output                                                                11072000
    Function              Resultant condition code.                     11074000
    Addr                  <>0, Pin of process to awaken.                11076000
    Acb                   Various fields are updated.  Most             11078000
                          importantly AaError and AaTlog.>>             11080000
                                                                        11082000
<<Algorithm                                                             11084000
                                                                        11086000
  Wait and nowait Initiation                                            11088000
  --------------------------                                            11090000
  If enough free space then                                             11092000
    put the record                                                      11094000
  else                                                                  11096000
    begin                                                               11098000
    If reader opened or just opened or extended wait then               11100000
      begin <transfer will be done by symbiotic process>                11102000
      If no'wait then                                                   11104000
        begin                                                           11106000
        move data into user's record buffer <Record xferred by reader>  11108000
        Send no wait message to wait queue                              11110000
        end                                                             11112000
      else                                                              11114000
        begin                                                           11116000
        Long wait  <Record will be transferred by the reader>           11118000
        Get the reply message parameters                                11120000
        If message = Ready then                                         11122000
          Return successful                                             11124000
        else If message = Timeout then                                  11126000
          Return timeout status                                         11128000
        else <no reader>                                                11130000
          Return EOF                                                    11132000
        end                                                             11134000
      end                                                               11136000
    else                                                                11138000
      Return EOF                                                        11140000
                                                                        11142000
  Complete nowait Write                                                 11144000
  ---------------------                                                 11146000
  Process the same as wait write after "Long wait" statement            11148000
>>                                                                      11150000
                                                                        11152000
option privileged,uncallable;                                           11154000
                                                                        11156000
begin                                                                   11158000
AaxStructure;  <<Must be the first declaration>>                        11160000
MsgStructure;                                                           11162000
integer                                                                 11164000
  Target,TotalRecLenw,DataLengthb,Tlog,Address,                         11166000
  ConditionCode=Function;                                               11168000
logical                                                                 11170000
  Embed:=false,JustOpened:=false,WaitForCompletion:=true;               11172000
                                                                        11174000
                                                                        11176000
subroutine WRITEXIT(ErrorCode);                                         11178000
value ErrorCode;                                                        11180000
                                                                        11182000
<<Function                                                              11184000
  Returns from the access procedure.>>                                  11186000
                                                                        11188000
<<Input>>                                                               11190000
  integer                                                               11192000
    ErrorCode;          <<Operation status.>>                           11194000
                                                                        11196000
<<Output                                                                11198000
  None.>>                                                               11200000
                                                                        11202000
  begin                                                                 11204000
  if WaitForCompletion then                                             11206000
    begin                                                               11208000
    if ErrorCode = no'symbiote then                                     11210000
      begin  <<Return EOF status>>                                      11212000
      ErrorCode:=successful;                                            11214000
      ConditionCode:=ccg;                                               11216000
      end                                                               11218000
    else if ErrorCode = successful then                                 11220000
      begin                                                             11222000
      ConditionCode:=cce;                                               11224000
      AaVirgin:=0;                                                      11226000
      end                                                               11228000
    else                                                                11230000
      ConditionCode:=ccl;                                               11232000
    AaError:=ErrorCode;                                                 11234000
    MAKEMMSTAT(Acb,MMwrite'compltn,ErrorAndAaID,AaFreeRecLSW);          11236000
    end                                                                 11238000
  else                                                                  11240000
    begin  <<no wait initiation>>                                       11242000
    if ErrorCode <> successful then PUTMYCOMPLTNMSG(Acb,ErrorCode,0);   11244000
    ConditionCode:=cce;                                                 11246000
    end;                                                                11248000
  UNLOCEXTENDACB(Acb);                                                  11250000
  asmb(exit 1);                                                         11252000
  end;  <<WRITEXIT>>                                                    11254000
subroutine CHECKWRITERROR;                                              11256000
  begin                                                                 11258000
  if AaWriteError <> successful then WRITEXIT(AaWriteError);            11260000
  end;  <<CHECKWRITERROR>>                                              11262000
                                                                        11264000
                                                                        11266000
subroutine WRITERECORD;                                                 11268000
<<Writes record to the file.>>                                          11270000
  begin                                                                 11272000
  Aaerror:=PUTRECORD(Acb,data'record,AaTargetDST,Target,DataLengthb,    11274000
  AaControlByte,AaID);                                                  11276000
  if AaError = successful then AaTlog:=Tlog;                            11278000
  end;  <<WRITERECORD>>                                                 11280000
                                                                        11282000
                                                                        11284000
logical subroutine WAITABLE;                                            11286000
<<Determines if a writer has the necessary moxie to wait on a           11288000
  full file.>>                                                          11290000
  begin                                                                 11292000
  if (AaNumReaders <> 0) or AaExtendWait or JustOpened then             11294000
    begin                                                               11296000
    WAITABLE:=true;                                                     11298000
    AaWaitWriters:=true;                                                11300000
    end;                                                                11302000
  end;  <<WAITABLE>>                                                    11304000
                                                                        11306000
                                                                        11308000
subroutine PROCESSCOMPLETEDWRITE;                                       11310000
<<Performs the post processing for all no wait writes and all           11312000
  impeded writes.  Note that the data has already been moved            11314000
  by the symbiotic accessor.>>                                          11316000
  begin                                                                 11318000
  GETCOMPLTNMSG(Acb,Msg);                                               11320000
  if < then WRITEXIT(softimeout);                                       11322000
  Aaerror:=MsgErrorCode; AaTlog:=MsgTlog;                               11324000
  end;  <<PROCESSCOMPLETEDWRITE>>                                       11326000
                                                                        11328000
                                                                        11330000
subroutine REQINITIALIZE;                                               11332000
<<Performs one time initialization for the request.>>                   11334000
  begin                                                                 11336000
  AaJustOpened:=0;                                                      11338000
  if <> then JustOpened:=true;                                          11340000
                                                                        11342000
  <<Analyze Tcount parameter>>                                          11344000
  tos:=Tcount;                                                          11346000
  if < then                                                             11348000
    begin  <<Count in bytes>>                                           11350000
    AaByteTlog:=1;                                                      11352000
    tos:=-tos;  <<Form positive bytes>>                                 11354000
    end                                                                 11356000
  else                                                                  11358000
    begin  <<Count in words>>                                           11360000
    AaByteTlog:=0;                                                      11362000
    tos:=tos&lsl(1);                                                    11364000
    end;                                                                11366000
  DataLengthb:=tos;  <<Save positive byte count>>                       11368000
                                                                        11370000
  MAKEMMSTAT(Acb,MMwrite'init,AaNumRecLSW&lsl(8)+AaID,                  11372000
    AaFreeRecLSW);                                                      11374000
  if DataLengthb > AaRSize then WRITEXIT(badtcount);                    11376000
  CHECKWRITERROR;                                                       11378000
                                                                        11380000
  if AaControl then                                                     11382000
    begin  <<Carriage control file>>                                    11384000
    Embed:=1;                                                           11386000
    AaControlByte:=AaCtl;                                               11388000
    end                                                                 11390000
  else                                                                  11392000
    AaControlByte:=no'cctl;                                             11394000
  tos:=DataLengthb+int(Embed);                                          11396000
  if not AaByteTlog then tos:=(tos+1)&lsr(1);                           11398000
  Tlog:=tos;                                                            11400000
  TotalRecLenw:=                                                        11402000
    (magic'numberb+DataLengthb+header'sizeb+int(Embed))&lsr(1);         11404000
  end;  <<REQINITIALIZE>>                                               11406000
                                                                        11408000
                                                                        11410000
<<Mainline>>                                                            11412000
AaError:=successful; AaTlog:=0;                                         11414000
Address:=Addr; Addr:=0;                                                 11416000
Target:=LOCEXTENDACB(acb'loc,AaTargetDST,Address);                      11418000
@Acb:=@AaStart;                                                         11420000
if AaBufNotFilled then FILLBUFFERS(Acb);                                11422000
                                                                        11424000
<<Execute the request>>                                                 11426000
case Function of                                                        11428000
  begin                                                                 11430000
  begin  <<** Write initiation>>                                        11432000
  if AaWait and AaSoftIntPlabel = 0 then                                11434000
    begin  <<Initiate and complete write>>                              11436000
    REQINITIALIZE;                                                      11438000
    if not AaWaitWriters                                                11440000
    and CHECKRECSPACE(Acb,JustOpened,totalRecLenw) then                 11442000
      begin  <<Write the record>>                                       11444000
      if AaVirgin then                                                  11446000
        PUTRECORD(Acb,open'record,0,0,0,no'cctl,AaID);                  11448000
      WRITERECORD;                                                      11450000
      end                                                               11452000
    else if WAITABLE then                                               11454000
      begin  <<No room for the record, but writer can wait>>            11456000
      LONGWAIT(Acb,AaWriteQueue,AaTargetDST,Target,DataLengthb);        11458000
      PROCESSCOMPLETEDWRITE;                                            11460000
      end                                                               11462000
    else                                                                11464000
      WRITEXIT(no'symbiote);                                            11466000
    end                                                                 11468000
  else                                                                  11470000
    begin  <<No wait write initiation>>                                 11472000
    REQINITIALIZE;                                                      11474000
    WaitForCompletion:=false;                                           11476000
    if not AaWaitWriters                                                11478000
    and CHECKRECSPACE(Acb,JustOpened,totalRecLenw) then                 11480000
      begin  <<Write the record>>                                       11482000
      if AaVirgin then                                                  11484000
        PUTRECORD(Acb,open'record,0,0,0,no'cctl,AaID);                  11486000
      WRITERECORD;                                                      11488000
      if AaError = successful then                                      11490000
        PUTMYCOMPLTNMSG(Acb,successful,Tlog);                           11492000
      end                                                               11494000
    else if WAITABLE then                                               11496000
      begin  <<No room for the record, but can queue the request>>      11498000
      tos:=AaWriteCBDST;  <<Move the data to writer's record buffer>>   11500000
      tos:=AaWriteCBAddr;                                               11502000
      tos:=AaTargetDST;                                                 11504000
      tos:=Target;                                                      11506000
      tos:=(DataLengthb+1)&lsr(1);                                      11508000
      asmb(mds 5);                                                      11510000
      PUTWAITQUEUE(Acb,AaWriteCBDST,AaWriteCBAddr,DataLengthb);         11512000
      FCPREPAFT(AaFNum,                                                 11514000
        if AaSoftIntPlabel = 0 then AaReplyPort else soft'int'pend);    11516000
      end                                                               11518000
    else                                                                11520000
      WRITEXIT(no'symbiote);                                            11522000
    end;                                                                11524000
  end;                                                                  11526000
                                                                        11528000
  PROCESSCOMPLETEDWRITE;  <<** No wait write completion>>               11530000
  end;  <<case>>                                                        11532000
                                                                        11534000
WRITEXIT(AaError);                                                      11536000
end;  <<FCWRITE>>                                                       11538000
$PAGE "MESSAGE FILE ACCESS - FCWRITEOF PROCEDURE."                      11540000
integer procedure FCWRITEOF(Dummy1,Dummy2);                             11542000
value Dummy1,Dummy2;                                                    11544000
                                                                        11546000
<<Function                                                              11548000
  Checkpoints the disc file.>>                                          11550000
                                                                        11552000
<<Input                                                                 11554000
    DB                    Set to the data segment containing the        11556000
                          user's parameter array.                       11558000
    Access control blk    Must be directly above the input parameters,  11560000
                          see ACB definition A in global defines.>>     11562000
    integer                                                             11564000
      Dummy1,Dummy2;    <<Dummy parameters necessary to properly        11566000
                          locate the acb.>>                             11568000
                                                                        11570000
<<Output                                                                11572000
    FCWRITEOF             Resultant file system error code.>>           11574000
<<Algorithm                                                             11576000
  Issue abort request to the wait port                                  11578000
  If local port not empty then return false                             11580000
>>                                                                      11582000
                                                                        11584000
option privileged,uncallable;                                           11586000
                                                                        11588000
begin                                                                   11590000
AaxStructure;                                                           11592000
                                                                        11594000
                                                                        11596000
LOCEXTENDACB(acb'loc,AaTargetDST,0);                                    11598000
@Acb:=@AaStart;                                                         11600000
FCWRITEOF:=WRITEOF(Acb);                                                11602000
UNLOCEXTENDACB(Acb);                                                    11604000
end;  <<FCWRITEOF>>                                                     11606000
$PAGE "VERSION"                                                         11608000
double procedure FCGETVERSION;                                          11610000
                                                                        11612000
<<Function                                                              11614000
  Returns ipc version and update number.                                11616000
  Note - This procedure should be the last in the listing so            11618000
         that it will be the first in the segment, hence easy to        11620000
         display with debug.>>                                          11622000
                                                                        11624000
<<Input                                                                 11626000
  None.>>                                                               11628000
                                                                        11630000
<<Output                                                                11632000
    FCGETVERSION          Most significant word  - Version number       11634000
                          Least significant word - Update number>>      11636000
                                                                        11638000
begin                                                                   11640000
integer                                                                 11642000
  ReturnVersion=FCGETVERSION,ReturnUpdate=FCGETVERSION+1;               11644000
array                                                                   11646000
  VersionUpdate(0:1)=pb:=Version,Update;                                11648000
                                                                        11650000
ReturnVersion:=Version; ReturnUpdate:=Update;                           11652000
end;  <<FCGETVERSION>>                                                  11654000
$PAGE "OUTER BLOCK."                                                    11656000
$CONTROL SEGMENT=OUTERBLOCK                                             11658000
end.                                                                    11660000
