$CONTROL   LIST                                                         00010000
$CONTROL   SOURCE                                                       00012000
$CONTROL   WARN                                                         00014000
$CONTROL   MAP                                                          00016000
$CONTROL   CODE                                                         00018000
$CONTROL   LINES= 60                                                    00020000
$CONTROL USLINIT                                                        00022000
$CONTROL SEGMENT= SOFTIO                                                00024000
<<$CONTROL ADDR>>                                                       00026000
$CONTROL MAIN= CIPER    << MPE MODULE 61 -- SOFTIO >>                   00028000
$CONTROL USLINIT                                                        00030000
<<$CONTROL INNERLIST>>                                                  00032000
<<$CONTROL UNCALLABLE>>                                                 00034000
<<$CONTROL SUBPROGRAM>>                                                 00036000
<<$CONTROL PRIVILEGED>>                                                 00038000
$CONTROL ERRORS= 100                                                    00040000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1982. ",            & 00042000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00044000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00046000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00048000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00050000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00052000
                                                                        00054000
$SET X1 = ON                                                            00056000
              << HP3000 cpu type:                            >>         00058000
              <<   ON = HPIB 30/33/40/44/64                  >>         00060000
              <<   OFF = II/III                              >>         00062000
                                                                        00064000
                                                                        00068000
$SET X7 = OFF                                                  <<04422>>00070000
              << Special code for internal logging           >>         00072000
              <<   ON = Include code                         >>         00074000
              <<   OFF = Don't include code                  >>         00076000
                                                                        00078000
                                                                        00082000
$SET X9 = OFF                                                  <<04422>>00084000
              << Special code to aid in debugging:           >>         00086000
              <<   ON = Include code                         >>         00088000
              <<   OFF = Don't include code                  >>         00090000
                                                                        00092000
BEGIN                                                                   00094000
                                                                        00096000
COMMENT                                                        <<04434>>00098000
$PAGE "OVERVIEW OF THE SOFTIO MODULE"                          <<04434>>00100000
                                                               <<04434>>00102000
              OVERVIEW OF THE SOFTIO MODULE                    <<04434>>00104000
                                                               <<04434>>00106000
  The SOFTIO module (MPE module 61) is the first phase of the  <<04434>>00108000
CIPER protocol implementation for the HP3000 computer family.  <<04434>>00110000
In addition to SOFTIO, changes have been made to SPOOLING,     <<04434>>00112000
ALLOCATE, and HARDRES to accomodate the new protocol.  Even-   <<04434>>00114000
tually, changes should be made to FILEIO to allow 'hot' users  <<04434>>00116000
the same recovery features now afforded by SPOOLING.           <<04434>>00118000
                                                               <<04434>>00120000
  All of the procedures in SOFTIO execute between the file     <<04434>>00122000
system and the I/O system.  To accomplish this, the ATTACHIO   <<04434>>00124000
procedure in HARDRES has been split into two procedures, one   <<04434>>00126000
still named ATTACHIO, the other P'ATTACHIO.  ATTACHIO is now   <<04434>>00128000
a stub which determines if the device requested is a CIPER     <<04434>>00130000
device, serial disc, or a normal device, and then calls the    <<04434>>00132000
appropriate device handler (e.g. SDISCIO, B08'LOGICAL'DVR, or  <<04434>>00134000
P'ATTACHIO).  P'ATTACHIO (which stands for Physical ATTACHIO)  <<04434>>00136000
contains the bulk of the old ATTACHIO's code.  It performs the <<04434>>00138000
task of getting an IOQ, linking that IOQ to the device's DIT,  <<04434>>00140000
etc.  When SDISCIO and CIPER are ready to do real I/O, they    <<04434>>00142000
call P'ATTACHIO.                                               <<04434>>00144000
                                                               <<04434>>00146000
  B08'LOGICAL'DVR is the entry point into the CIPER subsystem. <<04434>>00148000
All other procedures in SOFTIO perform specialized functions   <<04434>>00150000
for B08'LOGICAL'DVR, and at this time are not called by any    <<04434>>00152000
other modules of MPE.  Procedures which begin with the CPR'    <<04434>>00154000
designator are generic CIPER routines which can be used with   <<04434>>00156000
a logical driver for any future CIPER device.  Procedures      <<04434>>00158000
which begin with a B08' designator have been tailored to       <<04434>>00160000
handle the specific record and status formats of the 2608S     <<04434>>00162000
(which was originally called the 2608B, hence the B08').       <<04434>>00164000
These could be used for other future CIPER devices - the amount<<04434>>00166000
of modification required will depend on how closely those de-  <<04434>>00168000
vices match the 2608S in terms of record formats and command/  <<04434>>00170000
status messages.  As much as was possible in Phase I, the data <<04434>>00172000
structures were designed to be very flexible and upward com-   <<04434>>00174000
patible.                                                       <<04434>>00176000
                                                               <<04434>>00178000
  SOFTIO uses an extra data segment (one per device in Phase I)<<04434>>00180000
to buffer incoming and outgoing data.  Control structures are  <<04434>>00182000
in place to provide multiple devices per data segment, as well <<04434>>00184000
as flexibility on a device by device basis.  A memory manage-  <<04434>>00186000
ment scheme is implemented which allows dynamic allocation of  <<04434>>00188000
regions of the data segment, which provides a way for various  <<04434>>00190000
device handlers and the CIPER levels to obtain memory areas    <<04434>>00192000
independently of other sections.  In the Phase I implementa-   <<04434>>00194000
tion, the CIPER data segment (CDS) gets initialized during the <<04434>>00196000
first request to a given device after the system has been      <<04434>>00198000
started up.  Typically this will be an FOPEN request, but it   <<04434>>00200000
does not have to be.                                           <<04434>>00202000
                                                               <<04434>>00204000
  SOFTIO will move data from user requests (Fwrite, etc.) and  <<04434>>00206000
translate function code, P1, and P2 parameters into device     <<04434>>00208000
escape sequences, and buffer all of that up into what are      <<04434>>00210000
called record buffer areas.  When a buffer area becomes full,  <<04434>>00212000
the record is transmitted to the peripheral following the nor- <<04434>>00214000
mal CIPER protocol.  A user request can span multiple records  <<04434>>00216000
if necessary, and certain requests can cause a record to be    <<04434>>00218000
transmitted even if it contains less than the maximum amount   <<04434>>00220000
of data.  The record size is device dependent, and is estab-   <<04434>>00222000
lished during initialization, when the peripheral reports its  <<04434>>00224000
maximum record size.                                           <<04434>>00226000
                                                               <<04434>>00228000
  The original design called for most of SOFTIO to execute as  <<04434>>00230000
its own process.  There would be a single process for all CIPER<<04434>>00232000
peripherals on a system.  It was tenatively named CIPERIOPROC, <<04434>>00234000
and would be created by INITIAL and awoken by PROGEN, at which <<04434>>00236000
time it would initialize the CDS and link all CIPER peripherals<<04434>>00238000
to a single CDS.  The process would allow better control of the<<04434>>00240000
peripheral, as error conditions could be detected as soon as   <<04434>>00242000
they occurred, rather than later on when (if?) a program       <<04434>>00244000
happened to make a request of the peripheral.  It also meant   <<04434>>00246000
that a caller would not get impeded by SOFTIO if the peripheral<<04434>>00248000
was unable to complete an I/O request.  However, due to several<<04434>>00250000
constraints (shortage of PCB entries and lack of time, to name <<04434>>00252000
just a few) the separate process has not been implemented yet. <<04434>>00254000
As a result, SOFTIO runs on the caller's stack, which has two  <<04434>>00256000
ramifications:  1) the device is only monitored when a calling <<04434>>00258000
request causes a real I/O transaction to take place, and       <<04434>>00260000
2) a larger portion of the available stack is used up, which   <<04434>>00262000
means that programs which were right up against the limit may  <<04434>>00264000
not execute when doing I/O to a 'hot' CIPER device.            <<04434>>00266000
                                                               <<04434>>00268000
  Another important part of the original design which was not  <<04434>>00270000
implemented in Phase I (due to lack of time) is the logical    <<04434>>00272000
IOQ (LIOQ) and communication queue (COMQ) mechanisms.  LIOQs   <<04434>>00274000
are an extension to the IOQ mechanism, similar to the disc     <<04434>>00276000
request table.  The LIOQs would be located in the CIPER data   <<04434>>00278000
segment (so no bank zero memory is needed) and would be re-    <<04434>>00280000
turned to calling programs which had specified no-wait I/O.    <<04434>>00282000
SOFTIO could use these LIOQs without impacting the shortage of <<04434>>00284000
real IOQs.  Certain kernal procedures which manipulate IOQs    <<04434>>00286000
will have to be modified to recognize the LIOQ before they can <<04434>>00288000
be used.  The communication queue mechanism was to be used     <<04434>>00290000
internally by SOFTIO to expand the calling/return parameters   <<04434>>00292000
passed both intra-level and inter-level.  Since most of SOFTIO <<04434>>00294000
executes split-stack, all parameters must be passed by value,  <<04434>>00296000
which reduces the amount of information that can be returned   <<04434>>00298000
by a procedure.  Communication queue elements of variable      <<04434>>00300000
length could be passed back and forth to overcome the 'pass by <<04434>>00302000
value' restrictions.  The procedures which create and mani-    <<04434>>00304000
pulate the LIOQ and COMQ entries have been written, but are    <<04434>>00306000
not called upon by any other procedures yet.                   <<04434>>00308000
                                                               <<04434>>00310000
$PAGE "HOW SOFTIO (CIPER) FITS INTO MPE"                       <<04434>>00312000
           +------------------+      +------------------+      <<04434>>00314000
           | user application |  or  |   CIPERIOPROC    |      <<04434>>00316000
           +------------------+      +------------------+      <<04434>>00318000
                     |                      |                  <<04434>>00320000
                     |  +-------------------+                  <<04434>>00322000
                     |  |                            LDTX      <<04434>>00324000
           +------------------+                    +-------+   <<04434>>00326000
           |   file system    |                    |       |   <<04434>>00328000
           +------------------+             +-----<|       |   <<04434>>00330000
 LEVEL 7             |                      |      |       |   <<04434>>00332000
             +-------+-------+              |      +-------+   <<04434>>00334000
      'cold' |               | 'hot'        |                  <<04434>>00336000
     +--------------+        |              |                  <<04434>>00338000
     |    spooler   |        |              |                  <<04434>>00340000
     +--------------+        |              |                  <<04434>>00342000
             |               |              |         CDS      <<04434>>00344000
             +-------+-------+              |      +-------+   <<04434>>00346000
                     |                      +----->|       |   <<04434>>00348000
           +-------------------+                   |       |   <<04434>>00350000
           |   attachio stub   |                   |       |   <<04434>>00352000
           +-------------------+                   |       |   <<04434>>00354000
                |    |    |                        |       |   <<04434>>00356000
   serial disc  |    |    |  CIPER                 |       |   <<04434>>00358000
       +--------+    |    +----------+             |       |   <<04434>>00360000
       |             |               |             |       |   <<04434>>00362000
+-------------+      |      +----------------+     |       |   <<04434>>00364000
|  sdiscio    |      |      | logical driver |-----|       |   <<04434>>00366000
+-------------+      |      +----------------+     |       |   <<04434>>00368000
       |             |               |             |       |   <<04434>>00370000
------ | ----------- | ------------- | ---------   |       |   <<04434>>00372000
       |             |               |             |       |   <<04434>>00374000
       |             |      +----------------+     |       |   <<04434>>00376000
LEVELS |       other |      |   networking   |     |       |   <<04434>>00378000
 6-5-  |             |      |  levels 3-4-5  |-----|       |   <<04434>>00380000
 4-3   |             |      +----------------+     |       |   <<04434>>00382000
       |             |               |             |       |   <<04434>>00384000
       |             |               |   +---------|       |   <<04434>>00386000
       +--------+    |    +----------+   |         +-------+   <<04434>>00388000
                |    |    |              |                     <<04434>>00390000
           +-------------------+         |            DIT      <<04434>>00392000
           |    p'attachio     |         |         +-------+   <<04434>>00394000
           +-------------------+         |         |       |   <<04434>>00396000
                     |                   | +-------|       |   <<04434>>00398000
-------------------- | ---------------   | |       |       |   <<04434>>00400000
                     |                   | |       +-------+   <<04434>>00402000
 LEVELS 2-1          |                   ^ ^                   <<04434>>00404000
     +-------------+-+-----------+-------------+               <<04434>>00406000
     |             |             |             |               <<04434>>00408000
+---------+   +---------+   +---------+   +---------+          <<04434>>00410000
|   MTS   |   |   MIO   |   |  HP-IB  |   |  other  |          <<04434>>00412000
|  phys.  |   |  phys.  |   |  phys.  |   |  phys.  |          <<04434>>00414000
| driver  |   | driver  |   | driver  |   | drivers |          <<04434>>00416000
+---------+   +---------+   +---------+   +---------+          <<04434>>00418000
$PAGE "ORGANIZATION OF SOFTIO PROCEDURES"                      <<04434>>00420000
                                                               <<04434>>00422000
  The SOFTIO module currently compiles into a single code      <<04434>>00424000
segment, also named SOFTIO.  As the module increases in size   <<04434>>00426000
and complexity, and after the CST expansion is completed, it   <<04434>>00428000
would be a good idea to split the module into two or more code <<04434>>00430000
segments (SOFTIO1, SOFTIO2, etc.).  A recommendation about how <<04434>>00432000
to segment the module will be given later, after a brief de-   <<04434>>00434000
scription about how the module is organized now.               <<04434>>00436000
                                                               <<04434>>00438000
  SOFTIO can be broken into fifteen major groups of pro-       <<04434>>00440000
cedures whose functions are related.  This monologue will de-  <<04434>>00442000
scribe things from the front of the listing to the back, which <<04434>>00444000
is in desending SST number order.  The major groups are:       <<04434>>00446000
                                                               <<04434>>00448000
    1.  Utility procedures                                     <<04434>>00450000
    2.  CDS integrity checking                                 <<04434>>00452000
    3.  CDS memory management                                  <<04434>>00454000
    4.  CDS initialization                                     <<04434>>00456000
    5.  Control Table and Control Block management             <<04434>>00458000
    6.  LIOQ and COMQ management                               <<04434>>00460000
    7.  CIPER Level 4 (transport end-to-end control)           <<04434>>00462000
    8.  CIPER Level 6 (presentation)                           <<04434>>00464000
    9.  Record buffer area allocation/release                  <<04434>>00466000
   10.  Device status processors                               <<04434>>00468000
   11.  Record transmission/reception control                  <<04434>>00470000
   12.  Function code executors                                <<04434>>00472000
   13.  Debugging and analysis tools                           <<04434>>00474000
   14.  Logical driver miscellaneous                           <<04434>>00476000
   15.  CIPER entry point (B08'LOGICAL'DVR)                    <<04434>>00478000
                                                               <<04434>>00480000
Groups 1 through 6 can be used by all levels of CIPER.  Groups <<04434>>00482000
7 and 8 are specific CIPER levels, which are currently imple-  <<04434>>00484000
mented by a single procedure each.  Groups 9 through 15 com-   <<04434>>00486000
prise CIPER Level 7, the logical driver.  Level 7 contains the <<04434>>00488000
largest percentage of code that is tailored for the 2608S.     <<04434>>00490000
The other groups contain the general purpose building blocks   <<04434>>00492000
that can be used to construct a logical driver for nearly any  <<04434>>00494000
future CIPER device.                                           <<04434>>00496000
                                                               <<04434>>00498000
                                                               <<04434>>00500000
                                                               <<04434>>00502000
GROUP 1 -- Utility procedures                                  <<04434>>00504000
                                                               <<04434>>00506000
  This group consists of only two procedures:  B08'ascii and   <<04434>>00508000
Cpr'genmsg.  B08'ascii performs the same function as the ASCII <<04434>>00510000
intrinsic, but can be called split-stack.  Cpr'genmsg is the   <<04434>>00512000
interface to IOMESSAGE, which expects to have DB at SYSDB when <<04434>>00514000
called.                                                        <<04434>>00516000
                                                               <<04434>>00518000
                                                               <<04434>>00520000
                                                               <<04434>>00522000
GROUP 2 -- CDS integrity checking                              <<04434>>00524000
                                                               <<04434>>00526000
  This group consists of five procedures, as outlined below:   <<04434>>00528000
                                                               <<04434>>00530000
Cpr'assertion, Cpr'limit'error, Cpr'coding'error, and          <<04434>>00532000
Cpr'internal'error were originally stubs that called debug.    <<04434>>00534000
At various places in the code, certain integrity and logic     <<04434>>00536000
checks were made.  If any violations were found, one of the    <<04434>>00538000
above four procedures would be called, which then caused DEBUG <<04434>>00540000
to be called so stack and CDS could be examined.  Now the four <<04434>>00542000
procedures call Cpr'shutdown to lock out the device because    <<04434>>00544000
of the integrity error.                                        <<04434>>00546000
                                                               <<04434>>00548000
Cpr'shutdown will mark a bit in the appropriate LDTX entry     <<04434>>00550000
that causes the CIPER ldev to be locked out (all further calls <<04434>>00552000
are rejected) until the system is warmstarted.  A console      <<04434>>00554000
message is issued warning the operator, but unfortunately, no  <<04434>>00556000
message is issued to the calling process (it just gets a bad   <<04434>>00558000
ATTACHIO return).                                              <<04434>>00560000
                                                               <<04434>>00562000
                                                               <<04434>>00564000
                                                               <<04434>>00566000
GROUP 3 -- CDS memory management                               <<04434>>00568000
                                                               <<04434>>00570000
  This group allows an area of the CDS to be allocated and     <<04434>>00572000
optionally initialized to a certain value.  Special preambles  <<04434>>00574000
and postambles are added to allow integrity checking of the    <<04434>>00576000
area.  One of the procedures provides a locking/unlocking      <<04434>>00578000
mechanism for specific types of CDS areas.                     <<04434>>00580000
                                                               <<04434>>00582000
Cpr'get'CDS'area, Cpr'get'2ndary'CDS'area, and Cpr'rel'CDS'area<<04434>>00584000
allow allocation and release of areas of the CDS.  The differ- <<04434>>00586000
ence between a 'normal' area and a 'secondary' area is where   <<04434>>00588000
in the CDS the search for an available space begins.  A secon- <<04434>>00590000
dary area is searched for from the high order address, and is  <<04434>>00592000
typically allocated for a short time only.  Allocating from    <<04434>>00594000
the upper end of the CDS helps prevent fragmentation.  All     <<04434>>00596000
permanent data structures (which most are) are allocated from  <<04434>>00598000
the low end of the CDS.  Cpr'rel'CDS'area does try to recombine<<04434>>00600000
adjacent free areas, but does no other garbage collection at   <<04434>>00602000
this time.                                                     <<04434>>00604000
                                                               <<04434>>00606000
Cpr'lock'CDS'area and Cpr'unlock'CDS'area (same procedure, just<<04434>>00608000
different entry points) provide the hooks for CDS area locking <<04434>>00610000
and unlocking.  This procedure determines the type of area     <<04434>>00612000
from information in the area preamble and performs the appro-  <<04434>>00614000
priate action to lock/unlock the area.  Currently, the only    <<04434>>00616000
lock implemented is for the CTM, which is a pdisable (to lock) <<04434>>00618000
and a penable (to unlock).                                     <<04434>>00620000
                                                               <<04434>>00622000
Cpr'size'of'CDS'area will return the size, in words, of the    <<04434>>00624000
specified area.  The size of the preamble and postamble is not <<04434>>00626000
included in the returned value.                                <<04434>>00628000
                                                               <<04434>>00630000
                                                               <<04434>>00632000
                                                               <<04434>>00634000
GROUP 4 -- CDS initialization                                  <<04434>>00636000
                                                               <<04434>>00638000
  This group of procedures gets called only once per device,   <<04434>>00640000
after the system has been started up.  Their purpose is to     <<04434>>00642000
allocate an extra data segment, initialize the memory manage-  <<04434>>00644000
ment information, set up the skeleton of some of the level     <<04434>>00646000
dependent data structures, and update the appropriate LDTX     <<04434>>00648000
entry to point to the new CDS.  The procedures in this group   <<04434>>00650000
include:                                                       <<04434>>00652000
                                                               <<04434>>00654000
  Cpr'init'sha -- initializes the segment header area (SHA)    <<04434>>00656000
                                                               <<04434>>00658000
  Cpr'init'cntl'of'CDS'area -- initializes the memory manager  <<04434>>00660000
                                                               <<04434>>00662000
  Cpr'init'ctm -- initializes the control table map (CTM)      <<04434>>00664000
                                                               <<04434>>00666000
  Cpr'init'lioq -- initializes the area set aside for LIOQs    <<04434>>00668000
                                                               <<04434>>00670000
  Cpr'init'CDS -- calls the above procedures to initialize.    <<04434>>00672000
                                                               <<04434>>00674000
  Cpr'get'CDS -- allocates an extra data segment for the CDS   <<04434>>00676000
                                                               <<04434>>00678000
  Cpr'get'CTMI -- gets a CTM entry for the current ldev        <<04434>>00680000
                                                               <<04434>>00682000
  Cpr'init'CB -- Builds skeleton of control block for a given  <<04434>>00684000
                 level of a given ldev                         <<04434>>00686000
                                                               <<04434>>00688000
  Cpr'init'CT -- Builds skeleton of control table for a given  <<04434>>00690000
                 ldev                                          <<04434>>00692000
                                                               <<04434>>00694000
  Cpr'cond'chg'ldtx -- updates the appropriate LDTX entry after<<04434>>00696000
                       initialization is complete              <<04434>>00698000
                                                               <<04434>>00700000
  Cpr'init'CDS'for -- calls the above procedures to get a new  <<04434>>00702000
                      CDS built for a given ldev               <<04434>>00704000
                                                               <<04434>>00706000
  Cpr'init'comq -- initializes the communication queue mechan- <<04434>>00708000
                   ism.                                        <<04434>>00710000
                                                               <<04434>>00712000
  Cpr'init'CBI -- allocates and initializes to zero a variable <<04434>>00714000
                  length Control Block Information area (CBI). <<04434>>00716000
                                                               <<04434>>00718000
  Cpr'init'CBIX -- allocates and initializes to zero a variable<<04434>>00720000
                   length Control Block Information area eXten-<<04434>>00722000
                   sion (CBIX).                                <<04434>>00724000
                                                               <<04434>>00726000
  B08'initialize -- determines sizes of all variable length    <<04434>>00728000
                    peripheral status messages and calculates  <<04434>>00730000
                    size of CBIX required.  Allocates and init-<<04434>>00732000
                    ializes the Level 7 CBIX.                  <<04434>>00734000
                                                               <<04434>>00736000
                                                               <<04434>>00738000
                                                               <<04434>>00740000
GROUP 5 -- Control Table (CT) and Control Block (CB) management<<04434>>00742000
                                                               <<04434>>00744000
  This group contains three procedures that manage the access  <<04434>>00746000
to the control tables (one per ldev) and control blocks (one   <<04434>>00748000
per level per ldev).  These procedures insure that only one    <<04434>>00750000
caller is active on a given ldev at one time, and trigger the  <<04434>>00752000
initialization the first time a device is accessed after system<<04434>>00754000
startup.  The procedures are:                                  <<04434>>00756000
                                                               <<04434>>00758000
  Cpr'get'CT'of -- Checks for the presence of a control table  <<04434>>00760000
                   for the specified ldev.  If none exists,    <<04434>>00762000
                   calls the initialization routines.  Performs<<04434>>00764000
                   an integrity check, sets DB to the base of  <<04434>>00766000
                   the CDS, and returns the pointer to the CT. <<04434>>00768000
                                                               <<04434>>00770000
  Cpr'CB'of -- Returns the pointer to the requested control    <<04434>>00772000
               block of a given ldev.                          <<04434>>00774000
                                                               <<04434>>00776000
  Cpr'rel'CT -- Cleans up information in the specified control <<04434>>00778000
                table, returns DB to wherever it was when      <<04434>>00780000
                SOFTIO was called, and gets ready to return to <<04434>>00782000
                the calling user.                              <<04434>>00784000
                                                               <<04434>>00786000
                                                               <<04434>>00788000
                                                               <<04434>>00790000
GROUP 6 -- LIOQ and COMQ management                            <<04434>>00792000
                                                               <<04434>>00794000
  Originally, each level of CIPER/3000 was going to have three <<04434>>00796000
communication queues: request/responce from the level above,   <<04434>>00798000
request/responce to procedures on the same level, and request/ <<04434>>00800000
responce to the next level below.  The LIOQ, which is a special<<04434>>00802000
type of COMQ, was reserved for Level 7 to communicate with     <<04434>>00804000
the file system or spooler.  The sixteen procedures in this    <<04434>>00806000
group have been designed to manage the COMQ mechanism for the  <<04434>>00808000
procedures that wish to use it as a utility.                   <<04434>>00810000
                                                               <<04434>>00812000
  T'link'son'up, T'link'son'side, and T'link'son'down will add <<04434>>00814000
queue elements to a specified comq.  T'delink'son'up,          <<04434>>00816000
T'delink'son'side, and T'delink'son'down will remove queue     <<04434>>00818000
elements from a specified comq.                                <<04434>>00820000
                                                               <<04434>>00822000
  Cpr'get'qh'of retrieves the head element of a specified comq.<<04434>>00824000
The head element is required when adding or deleting a queue   <<04434>>00826000
element to the queue.                                          <<04434>>00828000
                                                               <<04434>>00830000
  Cpr'get'qe and Cpr'rel'qe are responsible for allocating/    <<04434>>00832000
releasing individual queue elements as they are required for   <<04434>>00834000
addition into a particular comq.                               <<04434>>00836000
                                                               <<04434>>00838000
  Cpr'cq'add'son and Cpr'cq'del'son call on the above linking  <<04434>>00840000
routines to add a queue element to a comq.  The comq is a tree <<04434>>00842000
structure where certain relationships are maintained (e.g. a   <<04434>>00844000
single request from a level above could spawn several requests <<04434>>00846000
to a level below).                                             <<04434>>00848000
                                                               <<04434>>00850000
  Cpr'request'transmit, Cpr'request'receive,                   <<04434>>00852000
Cpr'responce'transmit, and Cpr'responce'receive are the four   <<04434>>00854000
procedures of the group that provide the caller's interface to <<04434>>00856000
the comq mechanism.  They are called when a procedure wishes   <<04434>>00858000
to send a message (comq element) to either the level above,    <<04434>>00860000
the level below, or to another procedure on the same level.    <<04434>>00862000
                                                               <<04434>>00864000
                                                               <<04434>>00866000
                                                               <<04434>>00868000
GROUP 7 -- CIPER Level 4 (transport end-to-end control)        <<04434>>00870000
                                                               <<04434>>00872000
  Currently Level 4 exists as the single procedure             <<04434>>00874000
B08'network'protocol.  Its function is to segment Level 7 re-  <<04434>>00876000
cords into one or more packets, the size of which are dependent<<04434>>00878000
upon the type of transport service in use.  For example, the   <<04434>>00880000
Multipoint Terminal System (MTS) can have its associated INP   <<04434>>00882000
interface configured with a variable sized line buffer.  If    <<04434>>00884000
that buffer is smaller than the record size used by the peri-  <<04434>>00886000
pheral, then records must be split apart to accomodate the     <<04434>>00888000
limits of the physical link.  The maximum packet size the      <<04434>>00890000
transport service can accept is reported to Level 4 during     <<04434>>00892000
initialization of the CDS.                                     <<04434>>00894000
                                                               <<04434>>00896000
  Another function of Level 4 is to retransmit packets if nec- <<04434>>00898000
necessary (if the transport service incorrectly transmits one).<<04434>>00900000
Level 4 insures that no packets have been lost and/or dupli-   <<04434>>00902000
cated by checking an incrementing packet number contained in   <<04434>>00904000
a packet header.                                               <<04434>>00906000
                                                               <<04434>>00908000
  If more complex transport services are ever used, such as    <<04434>>00910000
Ethernet, X.25, etc. the Level 4 implementation may become more<<04434>>00912000
complex.  All of the necessary hooks should be in place to     <<04434>>00914000
accomodate a more complex Level 4 protocol.                    <<04434>>00916000
                                                               <<04434>>00918000
                                                               <<04434>>00920000
                                                               <<04434>>00922000
GROUP 8 -- CIPER Level 6 (presentation)                        <<04434>>00924000
                                                               <<04434>>00926000
  Level 6 also consists of a single procedure.  Its purpose is <<04434>>00928000
to translate system request codes (function, P1, and P2) into  <<04434>>00930000
device recognizable escape sequences.  These are merged with   <<04434>>00932000
the caller's data (if any) as that data is moved from the      <<04434>>00934000
caller's stack or extra data segment into a record buffer area <<04434>>00936000
of the CDS.                                                    <<04434>>00938000
                                                               <<04434>>00940000
  The procedure, Cpr'xlate, also attempts to keep the next     <<04434>>00942000
available byte of the record buffer area positioned on a word  <<04434>>00944000
boundary.  This prevents an extra move of the incoming data,   <<04434>>00946000
which would otherwise be required to absorb the odd byte (the  <<04434>>00948000
mfds and mtds instructions only work on word boundaries).      <<04434>>00950000
Cpr'xlate performs this task by padding escape sequences with  <<04434>>00952000
ASCII blanks when possible (some sequences cannot be padded)   <<04434>>00954000
and necessary.                                                 <<04434>>00956000
                                                               <<04434>>00958000
  The original design goals included the option of making      <<04434>>00960000
Cpr'xlate a user callable intrinsic (with perhaps an interface <<04434>>00962000
procedure in-between).  This would provide users with a        <<04434>>00964000
facility to convert function codes into escape sequences for   <<04434>>00966000
use as they saw fit.  As of now, however, Cpr'xlate is only    <<04434>>00968000
used by SOFTIO.                                                <<04434>>00970000
                                                               <<04434>>00972000
                                                               <<04434>>00974000
                                                               <<04434>>00976000
GROUP 9 -- Record buffer area allocation/release               <<04434>>00978000
                                                               <<04434>>00980000
  The logical driver keeps five record buffer areas in the CDS.<<04434>>00982000
One is dedicated to buffering sequential output data, such as  <<04434>>00984000
fwrite and fdevicecontrol calls would pass in.  One is a de-   <<04434>>00986000
dicated input buffer, used to obtain clear-to-send indications <<04434>>00988000
and other status reports from the peripheral.  The other three <<04434>>00990000
record buffer areas are kept in a linked free-list.  A buffer  <<04434>>00992000
area can be allocated for sending asynchronous command records <<04434>>00994000
by calling the procedure B08'get'buffer.  When finished with   <<04434>>00996000
the buffer area, it can be returned to the free-list by calling<<04434>>00998000
B08'release'buffer.  In the case of allocating a buffer area,  <<04434>>01000000
if no buffer area is available from the free-list, the caller  <<04434>>01002000
has the option of specifying whether one of the dedicated buf- <<04434>>01004000
fer areas should be overwritten, or no buffer should be re-    <<04434>>01006000
turned.                                                        <<04434>>01008000
                                                               <<04434>>01010000
                                                               <<04434>>01012000
                                                               <<04434>>01014000
GROUP 10 -- Device status processors                           <<04434>>01016000
                                                               <<04434>>01018000
  Five procedures are responsible for evaluating the four types<<04434>>01020000
of status presently defined by CIPER.  One procedure,          <<04434>>01022000
B08'process'status, determines what type of status has been    <<04434>>01024000
received and calls the appropriate processor procedure.  Each  <<04434>>01026000
processor procedure will move the information from the speci-  <<04434>>01028000
fied record buffer area (where it was received from the periph-<<04434>>01030000
pheral) to a status 'tank' reserved for that type of status.   <<04434>>01032000
Record headers and other unnecessary information is removed    <<04434>>01034000
from the status report as it is moved.  In the case of some    <<04434>>01036000
types of status (particularly the Device Status report), the   <<04434>>01038000
processor procedure will evaluate the contents of the status.  <<04434>>01040000
                                                               <<04434>>01042000
  The four processor procedures are:                           <<04434>>01044000
                                                               <<04434>>01046000
B08'device'status -- processes the Device Status report, which <<04434>>01048000
                     indicates the state of the peripheral,    <<04434>>01050000
                     such as on-line/off-line, power-fail, etc.<<04434>>01052000
                                                               <<04434>>01054000
B08'job'report -- processes the Job Report, which is a summary <<04434>>01056000
                  of job related information.  Included are a  <<04434>>01058000
                  count of sheets printed during the job, etc. <<04434>>01060000
                                                               <<04434>>01062000
B08'rcv'rdy -- processes the Receive Ready report, which is    <<04434>>01064000
               CIPER's 'clear to send' command.  This reports  <<04434>>01066000
               the number of record buffer areas in the peri-  <<04434>>01068000
               pheral which are available for reception of     <<04434>>01070000
               data/command records.                           <<04434>>01072000
                                                               <<04434>>01074000
B08'env'status -- processes the Environmental Status report,   <<04434>>01076000
                  which provides information about the job     <<04434>>01078000
                  stream that can be used for error recovery.  <<04434>>01080000
                                                               <<04434>>01082000
                                                               <<04434>>01084000
                                                               <<04434>>01086000
GROUP 11 -- Record transmission/reception control              <<04434>>01088000
                                                               <<04434>>01090000
  The three procedures in this group maintain control over the <<04434>>01092000
information that goes into the record header of each record.   <<04434>>01094000
B08'build'header places information such as the record opcode, <<04434>>01096000
data'type, start of block and end of block indicators, and     <<04434>>01098000
record header length into each record header as the record     <<04434>>01100000
constructed.  B08'send'record transmits completed records to   <<04434>>01102000
the peripheral, maintaining an incrementing record sequence    <<04434>>01104000
number for error checking by the peripheral.  B08'force'record <<04434>>01106000
is a second entry point to this procedure that bypasses the    <<04434>>01108000
normal protocol, and may only be called when sending a Device  <<04434>>01110000
Clear command to the peripheral.  B08'get'record will attempt  <<04434>>01112000
to receive a record for the calling procedure.  The caller may <<04434>>01114000
specify a particular type of record to look for, or may accept <<04434>>01116000
the first record received.  In either case, B08'get'record     <<04434>>01118000
checks the record sequence number on the incoming record to    <<04434>>01120000
insure that no records have been lost or duplicated, either    <<04434>>01122000
due to the transport service or an error in the peripheral.    <<04434>>01124000
                                                               <<04434>>01126000
                                                               <<04434>>01128000
                                                               <<04434>>01130000
GROUP 12 -- Function code executors                            <<04434>>01132000
                                                               <<04434>>01134000
  This group consists of the following procedures:             <<04434>>01136000
                                                               <<04434>>01138000
B08'read'data -- currently does nothing                        <<04434>>01140000
                                                               <<04434>>01142000
B08'write'data -- builds Write Data records, appends caller's  <<04434>>01144000
                  data if any.  Sends records if/when full.    <<04434>>01146000
                                                               <<04434>>01148000
B08'configure -- sends the Configure record                    <<04434>>01150000
                                                               <<04434>>01152000
B08'device'clear -- performs a device clear sequence to syn-   <<04434>>01154000
                    chronize the protocol between host and per-<<04434>>01156000
                    ipheral.                                   <<04434>>01158000
                                                               <<04434>>01160000
B08'return'job'report -- returns Job Report information from   <<04434>>01162000
                         status tank in CDS.  Can optionally   <<04434>>01164000
                         request new copy of Job Report from   <<04434>>01166000
                         the peripheral.                       <<04434>>01168000
                                                               <<04434>>01170000
B08'end'job -- sends the End of Job record, clears up all job  <<04434>>01172000
               related information in the CDS, and optionally  <<04434>>01174000
               returns the contents of the received Job Report <<04434>>01176000
               to the caller.                                  <<04434>>01178000
                                                               <<04434>>01180000
B08'start'job -- sends the Start of Job record, and sets up    <<04434>>01182000
                 the default access mode (FEATURE or TRANSPAR- <<04434>>01184000
                 ENT) as defined by the device subtype.        <<04434>>01186000
                                                               <<04434>>01188000
B08'buf'device'status -- returns the contents of the Device    <<04434>>01190000
                         Status to the caller.  Can optionally <<04434>>01192000
                         request a new copy from the peripher- <<04434>>01194000
                         al.                                   <<04434>>01196000
                                                               <<04434>>01198000
B08'buffered'env'status -- returns the contents of the last    <<04434>>01200000
                           Environmental Status report to the  <<04434>>01202000
                           caller.  Can optionally request a   <<04434>>01204000
                           new copy from the peripheral.       <<04434>>01206000
                                                               <<04434>>01208000
B08'available'status -- returns a bit mask to the caller to    <<04434>>01210000
                        inform what types of peripheral status <<04434>>01212000
                        reports have been received since the   <<04434>>01214000
                        last time they were read by the caller.<<04434>>01216000
                                                               <<04434>>01218000
B08'device'close -- bufferes a conditional top of form command,<<04434>>01220000
                    makes sure all pending records are sent,   <<04434>>01222000
                    ends the current job, if any, and cleans   <<04434>>01224000
                    up certain information in the CDS.         <<04434>>01226000
                                                               <<04434>>01228000
B08'file'open -- buffers a conditional top of form escape se-  <<04434>>01230000
                 quence.  If this is the first fopen request   <<04434>>01232000
                 (i.e. allocating device for 'hot' user or     <<04434>>01234000
                 spooler), then TOF request sent to peripheral.<<04434>>01236000
                                                               <<04434>>01238000
B08'end'block -- causes the end of block bit in the current    <<04434>>01240000
                 Write Data record header to be set, then the  <<04434>>01242000
                 record is transmitted to the peripheral.      <<04434>>01244000
                                                               <<04434>>01246000
B08'start'block -- causes a new record to be started with the  <<04434>>01248000
                   start of block bit set in the record header.<<04434>>01250000
                   In addition, a double word block label is   <<04434>>01252000
                   placed in the record immediately after the  <<04434>>01254000
                   record header.                              <<04434>>01256000
                                                               <<04434>>01258000
B08'silent'run -- constructs a Silent Run record and transmits <<04434>>01260000
                  that record to the peripheral.  This places  <<04434>>01262000
                  the peripheral in the silent run recovery    <<04434>>01264000
                  mode, which allows the peripheral to recover <<04434>>01266000
                  from various errors without having to reprint<<04434>>01268000
                  large parts of the job.                      <<04434>>01270000
                                                               <<04434>>01272000
B08'control'mask -- constructs a Configure record with a data  <<04434>>01274000
                    type of Control Mask, then sends that re-  <<04434>>01276000
                    cord to the peripheral.  The control mask  <<04434>>01278000
                    allows the system discretion about which   <<04434>>01280000
                    escape sequences and ASCII control codes   <<04434>>01282000
                    the peripheral will execute.               <<04434>>01284000
                                                               <<04434>>01286000
B08'set'ext'mode -- allows the caller to override the default  <<04434>>01288000
                    access option set up a start of job.       <<04434>>01290000
                                                               <<04434>>01292000
B08'set'status'types -- sets a mask kept in the Level 7 CBI    <<04434>>01294000
                        which determines the types of status   <<04434>>01296000
                        reports the caller is interested in    <<04434>>01298000
                        knowing about.  If the caller enables  <<04434>>01300000
                        a particular type of status, and during<<04434>>01302000
                        the course of time one of those status <<04434>>01304000
                        reports is received from the peripher- <<04434>>01306000
                        al, the caller will be informed by a   <<04434>>01308000
                        %41 ATTACHIO return (instead of the    <<04434>>01310000
                        normal %1).                            <<04434>>01312000
                                                               <<04434>>01314000
B08'flush'out'buffers -- causes any pending records to be sent <<04434>>01316000
                         to the device, even if they are not   <<04434>>01318000
                         filled to the maximum size.           <<04434>>01320000
                                                               <<04434>>01322000
B08'erase'buffers -- causes any pending records to be scrapped <<04434>>01324000
                     so they will never be sent to the periph- <<04434>>01326000
                     eral.                                     <<04434>>01328000
                                                               <<04434>>01330000
                                                               <<04434>>01332000
                                                               <<04434>>01334000
Each of the procedures in this group performs the work for a   <<04434>>01336000
particular MPE function code.  One of the function executors,  <<04434>>01338000
B08'write'data, is used for a variety of MPE function codes.   <<04434>>01340000
This is possible due to the fact that many of the function     <<04434>>01342000
codes supported by B08'logical'dvr are merely translated into  <<04434>>01344000
device escape sequences which can be buffered in a Write Data  <<04434>>01346000
record.                                                        <<04434>>01348000
                                                               <<04434>>01350000
                                                               <<04434>>01352000
                                                               <<04434>>01354000
GROUP 13 -- Debugging and analysis tools                       <<04434>>01356000
                                                               <<04434>>01358000
  Several procedures in the SOFTIO module are used only to     <<04434>>01360000
make debugging more convenient, or to perform certain types of <<04434>>01362000
performance analysis.  These procedures are not compiled unless<<04434>>01364000
one or both of the compiler flags X7 and X9 are set ON.        <<04434>>01366000
                                                               <<04434>>01368000
  Compiler flag X7 controls the inclusion of several procedures<<04434>>01370000
and related code that implements an internal logging facility. <<04434>>01372000
This facility can be used to log information to a set of extra <<04434>>01374000
data segments which are arranged in a two-way linked list.  New<<04434>>01376000
data segments are allocated as the one in use becomes full.    <<04434>>01378000
Currently, the only thing logged is the calling parameters to  <<04434>>01380000
B08'logical'dvr, which includes the completion status and ex-  <<04434>>01382000
cution time in milliseconds.  The procedures included are:     <<04434>>01384000
                                                               <<04434>>01386000
B08'init'log'dst -- initializes the logging facility the first <<04434>>01388000
                    time a log entry is written.               <<04434>>01390000
                                                               <<04434>>01392000
B08'enable'logging -- enables an individual event or optionally<<04434>>01394000
                      all events defined to be logged.         <<04434>>01396000
                                                               <<04434>>01398000
B08'disable'logging -- disables an individual event or option- <<04434>>01400000
                       ally all events defined from being log- <<04434>>01402000
                       ged.                                    <<04434>>01404000
                                                               <<04434>>01406000
  Compiler flag X9 controls the inclusion of several procedures<<04434>>01408000
and related code that facilitates debugging and testing.  When <<04434>>01410000
X9 is set ON, three function executor procedures are included, <<04434>>01412000
as well as code in B08'logical'dvr to call the executors when  <<04434>>01414000
the logical driver is called with certain normally invalid     <<04434>>01416000
function codes.  The procedures are:                           <<04434>>01418000
                                                               <<04434>>01420000
B08'debug'softkeys -- transmits escape sequences to $STDLIST   <<04434>>01422000
                      which, if $STDLIST is an HP2647 or HP2626<<04434>>01424000
                      terminal, will load the softkeys with    <<04434>>01426000
                      debug commands to display the Level 7    <<04434>>01428000
                      CBI, certain record buffer areas, and the<<04434>>01430000
                      calling parameters to B08'logical'dvr.   <<04434>>01432000
                                                               <<04434>>01434000
Cpr'test'shutdown -- used to invoke a shutdown while nested    <<04434>>01436000
                     procedure calls are on the stack.         <<04434>>01438000
                                                               <<04434>>01440000
B08'set'rec'length -- alters the value used to indicate the    <<04434>>01442000
                      maximum size of record accepted by the   <<04434>>01444000
                      peripheral.                              <<04434>>01446000
                                                               <<04434>>01448000
                                                               <<04434>>01450000
                                                               <<04434>>01452000
GROUP 14 -- Logical driver miscellaneous                       <<04434>>01454000
                                                               <<04434>>01456000
  This group contains procedures which just don't fit into any <<04434>>01458000
other group.  These procedures are not in one spot in the      <<04434>>01460000
module, but rather are scattered about.  In front to back order<<04434>>01462000
they are:                                                      <<04434>>01464000
                                                               <<04434>>01466000
B08'hash'function'code -- uses a PB array to hash the disjoint <<04434>>01468000
                          set of MPE function codes supported  <<04434>>01470000
                          by SOFTIO into a contiguous set that <<04434>>01472000
                          can be used to make case statement   <<04434>>01474000
                          selections.                          <<04434>>01476000
                                                               <<04434>>01478000
B08'clean'comp'status -- Clears the composite status area at   <<04434>>01480000
                         the start of certain calls to the     <<04434>>01482000
                         logical driver.  The only time the    <<04434>>01484000
                         composite status area is not cleared  <<04434>>01486000
                         is when the caller is asking what     <<04434>>01488000
                         types of status is available, or when <<04434>>01490000
                         requesting certain types of status.   <<04434>>01492000
                                                               <<04434>>01494000
                                                               <<04434>>01496000
                                                               <<04434>>01498000
GROUP 15 -- CIPER entry point (B08'logical'dvr)                <<04434>>01500000
                                                               <<04434>>01502000
  The entry point to the entire CIPER subsystem is the pro-    <<04434>>01504000
cedure B08'logical'dvr.  Its task is to get DB changed to the  <<04434>>01506000
CDS (and get a CDS initialized the first time called), evalu-  <<04434>>01508000
ate the calling parameters, call the appropriate function      <<04434>>01510000
executor, set up the return status (including an IOQ if no-    <<04434>>01512000
wait IO had been specified), release the CDS and change DB     <<04434>>01514000
back to where it was when called, and return to ATTACHIO.      <<04434>>01516000
                                                               <<04434>>01518000
                                                               <<04434>>01520000
                                                               <<04434>>01522000
$PAGE "NOTES ON RESEGMENTING SOFTIO"                           <<04434>>01524000
             A NOTE ABOUT RESEGMENTING SOFTIO                  <<04434>>01526000
                                                               <<04434>>01528000
  As promised earlier, there are a couple of points to be con- <<04434>>01530000
sidered before spliting SOFTIO into multiple code segments.  A <<04434>>01532000
brief monologue on that subject is now appropriate.            <<04434>>01534000
                                                               <<04434>>01536000
  First, SOFTIO is a very large tree structure, rather than a  <<04434>>01538000
multiple parallel path type of structure (such as the file     <<04434>>01540000
system, with many user callable entry points).  As such, there <<04434>>01542000
is no clear breaking point for segmentation that will reduce   <<04434>>01544000
the number of PCALs to an external SST.  About the only break  <<04434>>01546000
that will accomplish the task of reducing external PCALs is to <<04434>>01548000
move all of the CDS initialization to a separate code segment. <<04434>>01550000
Also, the CDS integrity trap procedures (Group 2) could be     <<04434>>01552000
moved.  This would account for over 1700 decimal words of code <<04434>>01554000
(probably more as initialization became more complex), which   <<04434>>01556000
is roughly 21% of the code space.                              <<04434>>01558000
                                                               <<04434>>01560000
  Second, the current shutdown mechanism depends upon the fact <<04434>>01562000
that all of SOFTIO's code is in a single code segment.  This   <<04434>>01564000
is because it walks back down the stack, looking for the CST   <<04434>>01566000
number in the stack marker to change, so it can tell when the  <<04434>>01568000
ATTACHIO stack marker has been found.  A more refined shutdown <<04434>>01570000
mechanism will have to be implemented (hopefully it will be    <<04434>>01572000
for other reasons as well) before SOFTIO can be split into     <<04434>>01574000
more than one code segment.                                    <<04434>>01576000
                                                               <<04434>>01578000
;                                                              <<04434>>01580000
$PAGE "MPE TABLE ACCESS: GENERAL ABBREVIATIONS"                         01582000
COMMENT                                                                 01584000
                                                                        01586000
buf             := buffer                                               01588000
dev             := device                                               01590000
dflt            := default                                              01592000
ent             := entry                                                01594000
indx            := index                                                01596000
ldev            := logical device                                       01598000
lvl             := level                                                01600000
sd              := serial disc                                          01602000
tbl             := table                                                01604000
vol             := volume                                               01606000
                                                                        01608000
;                                                                       01610000
                                                                        01612000
$INCLUDE INCLGLBL                                                       01614000
                                                                        01616000
$PAGE "MPE TABLE ACCES:  LPDT"                                          01618000
  << The following definitions are for the logical/physical >>          01620000
  << device table, referred to as the LPDT.                 >>          01622000
                                                                        01624000
  equate                                                                01626000
                                                                        01628000
    lpdt'dst                      = %15  << = #13 >>                    01630000
   ,lpdt'sir                      = %11  << = # 9 >>                    01632000
                                                                        01634000
   ,size'of'lpdt'entry            = 2                                   01636000
   ,size'of'lpdt0'entry           = 2                                   01638000
                                                                        01640000
  ;                                                                     01642000
                                                                        01644000
                                                                        01646000
  equate                                                                01648000
                                                                        01650000
    lpdt'size                     = 2                                   01652000
      << size of each lpdt entry >>                                     01654000
                                                                        01656000
  ;                                                                     01658000
                                                                        01660000
                                                                        01662000
  define                                                                01664000
                                                                        01666000
    lpdt'device'subtype           = (12: 4) #                           01668000
                                                                        01670000
  ;                                                                     01672000
                                                                        01674000
$INCLUDE INCLLDT                                                        01676000
                                                                        01678000
$INCLUDE INCLLDTX                                                       01680000
                                                                        01682000
$PAGE "MPE TABLE ACCESS: CIPER CONTROL DATA SEGMENT (CIPER CDS)"        01684000
equate                                                                  01686000
        << Control Data Segment (cds) >>                                01688000
       cds'area'size          = -2                                      01690000
      ,cds'area'type          = -1                                      01692000
                                                                        01694000
      ,cds'area'offset        = -cds'area'size                          01696000
      ,cds'area'overhead      = 1 + cds'area'offset                     01698000
;                                                                       01700000
define                                                                  01702000
       cds'area'suptype       = cds'area'type).(0:8 #                   01704000
      ,cds'area'subtype       = cds'area'type).(8:8 #                   01706000
;                                                                       01708000
equate                                                                  01710000
        << Segment Header Area (sha) >>                                 01712000
       sha'segment'offset     = cds'area'offset                         01714000
      ,sha'type'def           = [8/1,8/0]                               01716000
      ,sha'free'space'tbl'ptr = 0                                       01718000
      ,sha'cds'dst'num        = 1 + sha'free'space'tbl'ptr              01720000
      ,sha'max'seg'size       = 1 + sha'cds'dst'num                     01722000
      ,sha'seg'size           = 1 + sha'max'seg'size                    01724000
      ,sha'ctm'ptr            = 1 + sha'seg'size                        01726000
      ,sha'lioq'list'ptr      = 1 + sha'ctm'ptr                         01728000
      ,sha'size               = 1 + sha'lioq'list'ptr                   01730000
                                                                        01732000
        << Control Table Map (ctm) >>                                   01734000
          << entry 0 >>                                                 01736000
      ,ctm'type'def           = [8/2,8/0]                               01738000
      ,ctm0'ent'cnt           = 0                                       01740000
      ,ctm0'ctm'size          = 1 + ctm0'ent'cnt                        01742000
      ,ctm0'ent'inuse'cnt     = 1 + ctm0'ctm'size                       01744000
      ,ctm0'size              = 1 + ctm0'ent'inuse'cnt                  01746000
        <<currently ctm0'size < ctm'ent'size>>                          01748000
          << entries one to ctm(ctm0'ent'cnt) >>                        01750000
      ,ctm'ct'ptr             = 0                                       01752000
      ,ctm'ldev               = 1 + ctm'ct'ptr                          01754000
      ,ctm'ent'size           = 1 + ctm'ldev                            01756000
;                                                                       01758000
equate                                                                  01760000
        << Control Table (ct) >>                                        01762000
       ct'suptype'def         = [8/3,8/0]                               01764000
      ,ct'sir                 = 0                                       01766000
      ,ct'sir'save            = 1 + ct'sir                              01768000
      ,ct'cds'dst'num         = 1 + ct'sir'save                         01770000
      ,ct'ctmi                = 1 + ct'cds'dst'num                      01772000
      ,ct'msw'callers'db      = 1 + ct'ctmi                             01774000
      ,ct'lsw'callers'db      = 1 + ct'msw'callers'db                   01776000
      ,ct'd'callers'db        =     ct'msw'callers'db/2                 01778000
      ,ct'callers'stk         = 1 + ct'lsw'callers'db                   01780000
      ,ct'callers'stk'db      = 1 + ct'callers'stk                      01782000
      ,ct'lvl'cnt             = 1 + ct'callers'stk'db                   01784000
      ,ct'lvl'active          = 1 + ct'lvl'cnt                          01786000
           << if = 0 then ciper is quiesced,                            01788000
              if = -1 then ciper not initialized.>>                     01790000
      ,ct'lvl'active'ptr      = 1 + ct'lvl'active                       01792000
      ,ct'vdt'ptr             = 1 + ct'lvl'active'ptr                   01794000
      ,ct'size'min            = 1 + ct'vdt'ptr                          01796000
                                                                        01798000
      ,ct'lvln'cb'ptr         =     ct'vdt'ptr                          01800000
                                                                        01802000
      ,ct'lvl1'cb'ptr         = 1 + ct'lvln'cb'ptr                      01804000
      ,ct'lvl2'cb'ptr         = 1 + ct'lvl1'cb'ptr                      01806000
      ,ct'lvl3'cb'ptr         = 1 + ct'lvl2'cb'ptr                      01808000
      ,ct'lvl4'cb'ptr         = 1 + ct'lvl3'cb'ptr                      01810000
      ,ct'lvl5'cb'ptr         = 1 + ct'lvl4'cb'ptr                      01812000
      ,ct'lvl6'cb'ptr         = 1 + ct'lvl5'cb'ptr                      01814000
      ,ct'lvl7'cb'ptr         = 1 + ct'lvl6'cb'ptr                      01816000
;                                                                       01818000
define                                                                  01820000
       ct'size                = ct(ct'lvl'cnt) + ct'size'min #          01822000
;                                                                       01824000
equate                                                                  01826000
        << Control Block (cb) >>                                        01828000
       cb'suptype'def         = [8/4,8/0]                               01830000
      ,cb'plabel              = 0                                       01832000
      ,cb'qh'ptr              = 1 + cb'plabel                           01834000
      ,cb'info'ptr            = 1 + cb'qh'ptr                           01836000
      ,cb'cbi'ptr             =     cb'info'ptr                         01838000
      ,cb'size                = 1 + cb'info'ptr                         01840000
;                                                                       01842000
equate                                                                  01844000
        << Queue Header (qh) >>                                         01846000
       qh'suptype'def         = [8/5,8/0]                               01848000
      ,qh'free'list'ptr       = 0                                       01850000
      ,qh'head'request'qe'ptr = 1 + qh'free'list'ptr                    01852000
      ,qh'tail'request'qe'ptr = 1 + qh'head'request'qe'ptr              01854000
      ,qh'head'response'qe'ptr= 1 + qh'tail'request'qe'ptr              01856000
      ,qh'tail'response'qe'ptr= 1 + qh'head'response'qe'ptr             01858000
      ,qh'qe'size             = 1 + qh'tail'response'qe'ptr             01860000
      ,qh'inuse'cnt           = 1 + qh'qe'size                          01862000
      ,qh'free'cnt            = 1 + qh'inuse'cnt                        01864000
      ,qh'max'inuse'cnt       = 1 + qh'free'cnt                         01866000
      ,qh'size                = 1 + qh'max'inuse'cnt                    01868000
;                                                                       01870000
equate                                                                  01872000
        << Queue Element (or Entry) (qe) >>                             01874000
       qe'suptype'def         = [8/6,8/0]                               01876000
      ,qe'flags               = 0                                       01878000
           <<comq relational (family) links>>                           01880000
      ,qe'father'ptr          = 1 + qe'flags                            01882000
      ,qe'lioq'indx           =     qe'father'ptr                       01884000
      ,qe'head'brother'ptr    = 1 + qe'father'ptr                       01886000
      ,qe'tail'brother'ptr    = 1 + qe'head'brother'ptr                 01888000
      ,qe'head'son'ptr        = 1 + qe'tail'brother'ptr                 01890000
      ,qe'tail'son'ptr        = 1 + qe'head'son'ptr                     01892000
           <<comq sequential (queue) links>>                            01894000
      ,qe'qh'ptr              = 1 + qe'tail'son'ptr                     01896000
      ,qe'head'qe'ptr         = 1 + qe'qh'ptr                           01898000
      ,qe'tail'qe'ptr         = 1 + qe'head'qe'ptr                      01900000
      ,qe'next'free'ptr       =     qe'tail'qe'ptr                      01902000
      ,qe'size'min            = 1 + qe'tail'qe'ptr                      01904000
;                                                                       01906000
define                                                                  01908000
       qe'abort               = qe'flags).(0:1 #                        01910000
      ,qe'abort'process       = qe'flags).(1:1 #                        01912000
      ,qe'CIP'request         = qe'flags).(2:1 #                        01914000
      ,qe'origin              = qe'flags).(3:2 #                        01916000
      ,qe'father'is'lioq'indx = qe'flags).(5:1 #                        01918000
      ,qe'is'lioq'indx        = qe'flags).(6:1 #                        01920000
      ,qe'is'free             = qe'flags).(7:1 #                        01922000
;                                                                       01924000
equate                                                                  01926000
       qe'origin'father       = +1                                      01928000
      ,qe'origin'brother      = -1                                      01930000
      ,qe'origin'same'level   =  0                                      01932000
;                                                                       01934000
equate                                                                  01936000
        << Queue Element Information (qei) >>                           01938000
       qei'suptype'def        = [8/7,8/0]                               01940000
      ,qei'internal'func'code = 0                                       01942000
; <<need further definitions here>>                                     01944000
equate                                                                  01946000
        << Queue Element information for the lioq (qe'lioq) >>          01948000
       qe'lioq'ldev           =     qe'size'min                         01950000
      ,qe'lioq'qmisc          = 1 + qe'lioq'ldev                        01952000
      ,qe'lioq'dstx           = 1 + qe'lioq'qmisc                       01954000
      ,qe'lioq'addr           = 1 + qe'lioq'dstx                        01956000
      ,qe'lioq'fnct           = 1 + qe'lioq'addr                        01958000
      ,qe'lioq'cnt            = 1 + qe'lioq'fnct                        01960000
      ,qe'lioq'p1             = 1 + qe'lioq'cnt                         01962000
      ,qe'lioq'p2             = 1 + qe'lioq'p1                          01964000
      ,qe'lioq'flags          = 1 + qe'lioq'p2                          01966000
      ,qe'lioq'size'min       = 1 + qe'lioq'flags                       01968000
;                                                                       01970000
equate                                                                  01972000
        << Control Block Information (cbi) >>                           01974000
       cbi'suptype'def        = [8/8,8/0]                               01976000
;                                                                       01978000
equate                                                                  01980000
        << Control Block Information eXtension (cbix) >>                01982000
       cbix'suptype'def       = [8/9,8/0]                               01984000
;                                                                       01986000
equate                                                                  01988000
        << general cds area management declarations>>                   01990000
       nul'dseg               = -1                                      01992000
;                                                                       01994000
define                                                                  01996000
       nul'db                 = -1D#                                    01998000
;                                                                       02000000
                                                                        02002000
  <<ciper data segment management overview>>                            02004000
$PAGE "CIPER DATA SEGMENT (CDS) MANAGEMENT OVERVIEW"                    02006000
COMMENT                                                                 02008000
                     |                                                  02010000
                     V                                                  02012000
             @ct:=cpr'get'ct'of(ldev) +                                 02014000
                     |                                                  02016000
 (no cdda dseg)<-----+----->(cdda dseg)                                 02018000
cpr'init'cdda'for(ldev) +     |                                         02020000
  cpr'get'cdda(ldev) +        |                                         02022000
    getdataseg                |    +-------------------------------     02024000
  (set DB to cdda dseg)       |    | ciper'engine                       02026000
    cpr'init'cds +            |    |                                    02028000
      cpr'init'sha +          |    |   @ct:=cpr'get'ct'of(ldev) +       02030000
        cpr'init'cds'area +   |    |                                    02032000
      cpr'init'cntl'of'cds'area +| |     @cb:=cpr'cb'of(ct, level) *    02034000
      cpr'init'ctm +          |    |   cpr'rel'ct(ct) +                 02036000
      cpr'init'lioq +         |    |                                    02038000
       [cpr'init'lioq'es]     |    +-------------------------------     02040000
  cpr'get'ctmi +              |    |  ptr:=cpr'get'cds'area +           02042000
  cpr'init'ct +               |    |  ptr:=cpr'get'2ndary'cds'area      02044000
    cpr'init'cb +             |    |    ptr:=cpr'init'cds'area +        02046000
      cpr'init'queues         |    |  ptr:=cpr'rel'cds'area +           02048000
        cpr'init'qh           |    |                                    02050000
                              |    |size:=cpr'size'of'cds'area(ptr) +   02052000
          cpr'init'qe'es      |    |  cpr'lock'cds'area +               02054000
          cpr'enq'init'cmd    |    |  cpr'unlock'cds'area +             02056000
  (set DB to callers dseg)    |    +-------------------------------     02058000
  cpr'cond'chg'ldtx +         |                                         02060000
  (set DB to cdda dseg)  (set DB to cdda dseg)                          02062000
        |                     |                                         02064000
        +----------+----------+                                         02066000
                   |                                                    02068000
                                                                        02070000
'.' := outline done                                                     02072000
':' := code written                                                     02074000
'+' := code verified, needs work on documentation                       02076000
'*' := code verified, documentation up to date                          02078000
-----------------------------------+-------------------------------     02080000
@cbi:=cpr'init'cbi(cb, size) +     |  cpr'internal'error +              02082000
@cbix:=cpr'init'cbix(cbi, size)    |  cpr'coding'error +                02084000
                                   |  cpr'interference +                02086000
;                                                                       02088000
                                                                        02090000
$PAGE "CIPER DATA SEGMENT (CDS) COMMUNICATION QUEUE (COMQ) OVERVIEW"    02092000
COMMENT                                                                 02094000
                                                                        02096000
   cpr'get'comq                               cpr'rel'comq              02098000
                                                                        02100000
                                                                        02102000
cpr'request'transmit                      cpr'response'receive          02104000
                                                                        02106000
                                                                        02108000
                            (Level n)                                   02110000
----------------------------------------------------------------        02112000
                           (Level n-1)                                  02114000
                                                                        02116000
                                                                        02118000
cpr'request'receive                       cpr'response'transmit         02120000
                     (request -> response)                              02122000
                     (  common handling  )                              02124000
                     (      routines     )                              02126000
;                                                                       02128000
                                                                        02130000
  <<2608B Specific declarations>>                                       02132000
$PAGE "2608B SPECIFIC DECLARATIONS"                                     02134000
equate                                                                  02136000
       B08'initial'dseg'size = 8192                                     02138000
      ,B08'maximum'dseg'size = 8192                                     02140000
      ,B08'num'ctm'ents      = 1                                        02142000
      ,B08'num'lioq'ents     = 0                                        02144000
      ,B08'ct'lvl'cnt        = 7                                        02146000
;                                                                       02148000
                                                                        02150000
  <<logical driver global declarations>>                                02152000
$PAGE "SUPPORTED CIPER DEVICE TYPES/SUBTYPES"                           02154000
  << The following subtypes are supported by the current >>             02156000
  << CIPER implementation.                               >>             02158000
                                                                        02160000
                                                                        02162000
  << For CIPER printer devices (type = 32): >>                          02164000
                                                                        02166000
  equate                                                                02168000
                                                                        02170000
    feature'access'subtype        = 9                                   02172000
      << Ldevs with this subtype default to feature access >>           02174000
      << mode, where escape sequences and control codes in >>           02176000
      << the user's data stream are interpreted.           >>           02178000
                                                                        02180000
   ,transparent'access'subtype    = 13                                  02182000
      << Ldevs with this subtype default to 'transparency' >>           02184000
      << mode, which means that any escape sequences or    >>           02186000
      << control codes in the user's data are printed by   >>           02188000
      << the device.                                       >>           02190000
                                                                        02192000
  ;                                                                     02194000
                                                                        02196000
$PAGE "ATTACHIO 'FLAGS' PARAMETER FIELD DEFINITIONS"                    02198000
                                                                        02200000
  define                                                                02202000
                                                                        02204000
    control'spec                  = ( 0: 4) #                           02206000
      << Control and specification >>                                   02208000
                                                                        02210000
   ,premption                     = ( 7: 2) #                           02212000
      << Preemption: 1 = soft, 2 = hard >>                              02214000
                                                                        02216000
   ,special'request               = (10: 1) #                           02218000
      << Device defined special request >>                              02220000
                                                                        02222000
   ,diagnostic'request            = (11: 1) #                           02224000
      << request made by diagnostician >>                               02226000
                                                                        02228000
   ,system'buffers                = (12: 1) #                           02230000
      << If set, address is really system buffer index >>               02232000
                                                                        02234000
   ,request'type                  = (13: 3) #                           02236000
      << request type of flags parameter >>                             02238000
                                                                        02240000
   ,impede'bit                    = (13: 1) #                           02242000
      << If set, caller not to be impeded until IOQ becomes >>          02244000
      << available.                                         >>          02246000
                                                                        02248000
   ,wake'bit                      = (14: 1) #                           02250000
      << In request types 0, 2, 4, and 6 this bit specifies >>          02252000
      << that the caller is to be woken upon completion of  >>          02254000
      << the request.                                       >>          02256000
                                                                        02258000
  ;                                                                     02260000
                                                                        02262000
                                                                        02264000
                                                                        02266000
$PAGE "MPE FILE SYSTEM FUNCTION CODES SUPPORTED BY CIPER"               02268000
  << The following list includes all function codes that   >>           02270000
  << cause specific actions by the CIPER logical driver.   >>           02272000
  << There are two possible actions for any function codes >>           02274000
  << not in this list:                                     >>           02276000
  <<                                                       >>           02278000
  << a. If the function code is in the range of 0 - 127,   >>           02280000
  <<    the logical driver will return an invalid'request  >>           02282000
  <<    completion status.                                 >>           02284000
  <<                                                       >>           02286000
  << b. If the function code is in the range of 128 - 192, >>           02288000
  <<    the logical driver will ignor the request and re-  >>           02290000
  <<    turn a successful completion status.  The count    >>           02292000
  <<    specified by ATTACHIO will be echoed back.  This   >>           02294000
  <<    allows files/programs designed for other intelle-  >>           02296000
  <<    gent devices to be output to a CIPER device with-  >>           02298000
  <<    out file system errors.                            >>           02300000
                                                                        02302000
  equate                                                                02304000
                                                                        02306000
    read                          = 0                                   02308000
      << read data from device >>                                       02310000
                                                                        02312000
   ,write                         = 1                                   02314000
      << write data to device >>                                        02316000
                                                                        02318000
   ,file'open                     = 2                                   02320000
      << file open/device allocation >>                                 02322000
                                                                        02324000
   ,file'close                    = 3                                   02326000
      << file close >>                                                  02328000
                                                                        02330000
   ,device'close                  = 4                                   02332000
      << device deallocation >>                                         02334000
                                                                        02336000
   ,device'status'immediate       = 15                                  02338000
      << gets immediate device status >>                                02340000
                                                                        02342000
   ,vfu'download                  = 64                                  02344000
      << downloads user vfu definition >>                               02346000
                                                                        02348000
   ,set'left'margin               = 65                                  02350000
      << sets programmable left margin >>                               02352000
                                                                        02354000
   ,device'status'buffered        = 71                                  02356000
      << gets buffered device status >>                                 02358000
                                                                        02360000
   ,self'test                     = 73                                  02362000
      << initiates device self test >>                                  02364000
                                                                        02366000
   ,char'set'select               = 128                                 02368000
      << select character set >>                                        02370000
                                                                        02372000
   ,phys'page'len                 = 133                                 02374000
      << define physical page length >>                                 02376000
                                                                        02378000
   ,page'control                  = 140                                 02380000
      << page control >>                                                02382000
                                                                        02384000
   ,clear'environment             = 141                                 02386000
      << clears device environment to default state >>                  02388000
                                                                        02390000
   ,start'job                     = 142                                 02392000
      << starts user job on device >>                                   02394000
                                                                        02396000
   ,load'default'environment      = 143                                 02398000
      << loads default environment into device >>                       02400000
                                                                        02402000
   ,end'job                       = 145                                 02404000
      << completes user job on device >>                                02406000
                                                                        02408000
   ,extended'cap'mode             = 146                                 02410000
      << Enables/disables extended features access by user >>           02412000
                                                                        02414000
   ,start'of'block                = 147                                 02416000
      << Starts new data block with block number >>                     02418000
                                                                        02420000
   ,end'of'block                  = 148                                 02422000
      << Terminates current user data block >>                          02424000
                                                                        02426000
   ,job'report'buffered           = 179                        <<04422>>02428000
      << Requests last copy of job report obtained from >>     <<04422>>02430000
      << the device.                                    >>     <<04422>>02432000
                                                               <<04422>>02434000
   ,env'status'immediate          = 180                                 02436000
      << Reads a fresh copy of the environmental status     >>          02438000
      << from the device.                                   >>          02440000
                                                                        02442000
   ,device'status'composite       = 181                                 02444000
      << requests return of composite device status info >>             02446000
                                                                        02448000
   ,send'any'pending'records      = 182                                 02450000
      << Forces any pending output record buffers to be     >>          02452000
      << sent to the device, even if they are not yet full. >>          02454000
                                                                        02456000
   ,erase'buffers                 = 183                                 02458000
      << Causes any pending input or output record buffers  >>          02460000
      << to be purged and initialized.  Used when caller    >>          02462000
      << has overwhelming urge to clean up.                 >>          02464000
                                                                        02466000
   ,set'control'mask              = 185                                 02468000
      << downloads control mask to peripheral >>                        02470000
                                                                        02472000
   ,job'report'immediate          = 186                        <<04422>>02474000
      << Returns end of job information to caller >>                    02476000
                                                                        02478000
   ,read'avail'status'types       = 187                                 02480000
      << Returns bit mask indicating types of status avail- >>          02482000
      << able to caller                                     >>          02484000
                                                                        02486000
   ,set'avail'status'types        = 188                                 02488000
      << Sets mask defining which types of peripheral status >>         02490000
      << reports are desired by the caller.                  >>         02492000
                                                                        02494000
   ,device'clear                  = 189                                 02496000
      << perform device clear >>                                        02498000
                                                                        02500000
   ,load'silent'run               = 190                                 02502000
      << downloads silent run block >>                                  02504000
                                                                        02506000
   ,environmental'status          = 191                                 02508000
      << reads environmental status block from device >>                02510000
                                                                        02512000
  ;                                                                     02514000
                                                                        02516000
                                                                        02518000
$PAGE "CIPER INTERNAL (LEVEL 7 TO LEVEL 4) FUNCTION CODES"              02520000
  << The following list defines the currently supported    >>           02522000
  << function codes that are used by the logical driver    >>           02524000
  << (Level 7) when making requests of the transport con-  >>           02526000
  << trol (Level 4).                                       >>           02528000
                                                                        02530000
  equate                                                                02532000
                                                                        02534000
    transport'read                = 0                                   02536000
      << reads record from device >>                                    02538000
                                                                        02540000
   ,transport'write               = 1                                   02542000
      << writes a record to the device >>                               02544000
                                                                        02546000
   ,transport'open                = 2                                   02548000
      << opens (allocates) certain transport services for us >>         02550000
                                                                        02552000
   ,transport'close               = 3                                   02554000
      << equivalent to an fclose (typically a nop) >>                   02556000
                                                                        02558000
   ,transport'deallocate          = 4                                   02560000
      << disconnects the transport service from this user. >>           02562000
                                                                        02564000
   ,transport'initialize          = 5                                   02566000
      << initializes transport service >>                               02568000
                                                                        02570000
   ,transport'status              = 6                                   02572000
      << requests internal status from transport service >>             02574000
                                                                        02576000
  ;                                                                     02578000
                                                                        02580000
                                                                        02582000
$PAGE "CIPER INTER-LEVEL RETURN STATUS FIELD DEFINITIONS"               02584000
  << CIPER will (in the future) use a slightly modified    >>           02586000
  << form of return status than does ATTACHIO and          >>           02588000
  << P'ATTACHIO.  These are internal only, and will be     >>           02590000
  << converted to the normal ATTACHIO format before the    >>           02592000
  << logical driver exits.                                 >>           02594000
                                                                        02596000
  define                                                                02598000
                                                                        02600000
    level'number                  = ( 0: 4) #                           02602000
      << CIPER (ISO) level number generating the error >>               02604000
                                                                        02606000
   ,sub'level'number              = ( 4: 2) #                           02608000
      << CIPER sub level (allows for internal expansion) >>             02610000
      << Currently reserved - set to zero                >>             02612000
                                                                        02614000
   ,type'of'error                 = ( 6: 2) #                           02616000
      << Indicates severity of error - defined as follows: >>           02618000
      <<   0 ::= No error (successful completion)          >>           02620000
      <<   1 ::= Warning (unusual event occurred)          >>           02622000
      <<   2 ::= Error occurred but recovery took place    >>           02624000
      <<   3 ::= Error irrecoverable at this level         >>           02626000
                                                                        02628000
   ,error'code                    = ( 8: 8) #                           02630000
      << Specific error number.  One (1) ALWAYS means suc- >>           02632000
      << cessful completion.                               >>           02634000
                                                                        02636000
  ;                                                                     02638000
                                                                        02640000
                                                                        02642000
$PAGE "CIPER INTERNAL RETURN STATUS CODES (BY LEVEL)"                   02644000
  equate                                                                02646000
                                                                        02648000
    no'errors                     = 1                                   02650000
      << good completion >>                                             02652000
                                                                        02654000
   ,fatal'error                   = %314                                02656000
      << error fatal to b08'logical'dvr >>                              02658000
                                                                        02660000
   ,invalid'function              = 4                                   02662000
      << function code not supported by this logical driver >>          02664000
                                                                        02666000
   ,invalid'request               = 4                                   02668000
      << request not valid for this device >>                           02670000
                                                                        02672000
   ,wrong'creator                 = %304                                02674000
      << creator bit of record header not correct >>                    02676000
                                                                        02678000
   ,record'sequence'error         = %304                                02680000
      << record received out of sequence >>                             02682000
                                                                        02684000
   ,record'active'error           = %314                                02686000
      << attempted to start new record while previous >>                02688000
      << record still not completely sent.            >>                02690000
                                                                        02692000
   ,no'error                      = no'errors                           02694000
      << indicates no error in status processor >>                      02696000
                                                                        02698000
   ,packet'sequence'error         = %304                                02700000
      << indicates packet sequence error in level 4 >>                  02702000
                                                                        02704000
   ,illegal'function'sequence     = %314                                02706000
      << indicates a read or write call to level 4 before   >>          02708000
      <<     initializing >>                                            02710000
                                                                        02712000
   ,illegal'func'cd               = %314                                02714000
      << indicates an undefined function code passed to >>              02716000
      << Level 4                                        >>              02718000
                                                                        02720000
   ,pf'error                      = %213                                02722000
       << indicates an power fail status on last status >>              02724000
                                                                        02726000
   ,error'so'read'status          = %243                                02728000
      << Some device error has been detected in the device >>           02730000
      << status information, so the caller should read the >>           02732000
      << composite status information to determine the na- >>           02734000
      << ture of the error.                                >>           02736000
                                                                        02738000
  ;                                                                     02740000
$PAGE "MPE RETURN STATUS CODE DEFINITIONS"                              02742000
  << MPE currently uses the following definitions for   >>              02744000
  << driver return status.  Not all codes are returned  >>              02746000
  << by any given driver.                               >>              02748000
                                                                        02750000
  equate                                                                02752000
                                                                        02754000
    system'powerfail              = %63                                 02756000
                                                                        02758000
  ;                                                                     02760000
                                                                        02762000
                                                                        02764000
$PAGE "CIPER EXTERNAL RETURN STATUS FIELD DEFINITIONS"                  02766000
  << CIPER accepts from P'ATTACHIO and returns to ATTACHIO >>           02768000
  << completion status in the following format:            >>           02770000
                                                                        02772000
  define                                                                02774000
                                                                        02776000
    pcb'number                    = ( 0: 8) #                           02778000
      << Process control block number of process issuing >>             02780000
      << current request.                                >>             02782000
                                                                        02784000
   ,overall                       = ( 8: 8) #                           02786000
      << concatenation of qualifier and general status,  >>             02788000
      << as defined below:                               >>             02790000
                                                                        02792000
   ,qualifier                     = ( 8: 5) #                           02794000
      << qualification upon general status indication >>                02796000
                                                                        02798000
   ,general                       = (13: 3) #                           02800000
      << General completion status, with the following de- >>           02802000
      << fined values:                                     >>           02804000
      <<   0 ::= pending completion                        >>           02806000
      <<   1 ::= successful                                >>           02808000
      <<   2 ::= end of file                               >>           02810000
      <<   3 ::= unusual condition                         >>           02812000
      <<   4 ::= catastrophic error                        >>           02814000
                                                                        02816000
  ;                                                                     02818000
                                                                        02820000
                                                                        02822000
$PAGE "CIPER EXTERNAL GENERAL RETURN STATUS CODES"                      02824000
  << CIPER will return the following codes in the general  >>           02826000
  << status field of the return status:                    >>           02828000
                                                                        02830000
  equate                                                                02832000
                                                                        02834000
    pending                       = 0                                   02836000
      << Request has not yet completed >>                               02838000
                                                                        02840000
   ,successful                    = 1                                   02842000
      << Requested function completed without errors >>                 02844000
                                                                        02846000
   ,end'of'file                   = 2                                   02848000
      << End of file encountered while servicing request >>             02850000
                                                                        02852000
   ,unusual'condition             = 3                                   02854000
      << Abnormal completion, not necessaraly bad >>                    02856000
                                                                        02858000
   ,catastrophic                  = 4                                   02860000
      << Non-recoverable error occurred somewhere >>                    02862000
                                                                        02864000
  ;                                                                     02866000
                                                                        02868000
                                                                        02870000
                                                                        02872000
$PAGE "CIPER LOGICAL DRIVER RECORD TYPES"                               02874000
                                                                        02876000
  equate                                                                02878000
                                                                        02880000
                                                                        02882000
    << Record types sent from peripheral to host >>                     02884000
                                                                        02886000
    dont'care                     = -1                                  02888000
      << used in cpr'get'record to indicate a don't care >>             02890000
      << condition in the expected record type parameter. >>            02892000
                                                                        02894000
   ,lgl'receive'ready             = 0                                   02896000
      << reports device's ability to accept records >>                  02898000
                                                                        02900000
   ,lgl'clear'response            = 1                                   02902000
      << device response to logical device clear >>                     02904000
                                                                        02906000
   ,lgl'status'report             = 2                                   02908000
      << device response to status request >>                           02910000
                                                                        02912000
   ,lgl'esb'report                = 3                                   02914000
      << Environmental status block report >>                           02916000
                                                                        02918000
   ,lgl'job'report                = 11                                  02920000
      << device response to job end >>                                  02922000
                                                                        02924000
   ,lgl'read'response             = 17                                  02926000
      << device response to data request >>                             02928000
                                                                        02930000
                                                                        02932000
                                                                        02934000
                                                                        02936000
    << Record types sent from host to peripheral: >>                    02938000
                                                                        02940000
   ,lgl'device'clear              = 1                                   02942000
      << resets communication protocol at logical level >>              02944000
                                                                        02946000
   ,lgl'report'status             = 2                                   02948000
      << requests device status report >>                               02950000
                                                                        02952000
   ,lgl'report'esb                = 3                                   02954000
      << Requests the last generated environmental status >>            02956000
      << block, even if the device is not at a checkpoint >>            02958000
                                                                        02960000
   ,lgl'configuration             = 8                                   02962000
      << sends configuration information to device >>                   02964000
                                                                        02966000
   ,lgl'start'job                 = 9                                   02968000
      << starts user job at device >>                                   02970000
                                                                        02972000
   ,lgl'end'job                   = 10                                  02974000
      << completes user job and generates job status >>                 02976000
                                                                        02978000
   ,lgl'report'job'status         = 11                                  02980000
      << Requests job status report while job is still >>               02982000
      << active on device.                             >>               02984000
                                                                        02986000
   ,lgl'silent'run                = 12                                  02988000
      << Places device in the silent run recovery mode >>               02990000
                                                                        02992000
   ,lgl'write                     = 16                                  02994000
      << sends data to the device >>                                    02996000
                                                                        02998000
   ,lgl'read                      = 17                                  03000000
      << requests data from the device >>                               03002000
                                                                        03004000
  ;                                                                     03006000
                                                                        03008000
                                                                        03010000
                                                                        03012000
$PAGE "CIPER LOGICAL DRIVER CONTROL BLOCK INFORMATION (CBI)"            03014000
  << The CIPER logical driver uses the control block infor- >>          03016000
  << mation area (cbi) as an array of global information    >>          03018000
  << that may be used by any of the procedures that make up >>          03020000
  << the driver.  Each procedure will reference the cbi via >>          03022000
  << a pointer variable known as CB'INFO.  The cbi is allo- >>          03024000
  << cated in the CIPER data segment during initialization. >>          03026000
                                                                        03028000
  << Any variables which are listed as pointers actually    >>          03030000
  << contain a CBIX relative address.  The CBIX is an area  >>          03032000
  << of the CIPER data segment allocated during initializa- >>          03034000
  << tion where record buffers and status holding areas are >>          03036000
  << located.  The CBIX is pointed to by the variable       >>          03038000
  << CDS'AREA'BASE, which contains the CIPER data segment   >>          03040000
  << relative address of the base of the CBIX.              >>          03042000
                                                                        03044000
                                                                        03046000
  equate                                                                03048000
                                                                        03050000
    cds'area'base                 = 0                                   03052000
      << address of cds area block >>                                   03054000
                                                                        03056000
   ,initialized                   = 1 + cds'area'base                   03058000
      << flags successful initialization of cds area >>                 03060000
                                                                        03062000
   ,job'active                    = 1 + initialized                     03064000
      << indicates whether job is active on device >>                   03066000
                                                                        03068000
   ,free'buff'list                = 1 + job'active                      03070000
      << head of free-list of record buffer areas >>                    03072000
                                                                        03074000
   ,o'r'base                      = 1 + free'buff'list                  03076000
      << pointer to base of output record buffer area >>                03078000
                                                                        03080000
   ,i'r'base                      = 1 + o'r'base                        03082000
      << pointer to base of input record buffer area >>                 03084000
                                                                        03086000
   ,dev'status'base               = 1 + i'r'base                        03088000
      << address of base of device status area >>                       03090000
                                                                        03092000
   ,composite'status'base         = 1 + dev'status'base                 03094000
      << address of the composite device status area >>                 03096000
                                                                        03098000
   ,env'status'base               = 1 + composite'status'base           03100000
      << address of base of environmental status area >>                03102000
                                                                        03104000
   ,job'report'base               = 1 + env'status'base                 03106000
      << address of base of job report area >>                          03108000
                                                                        03110000
   ,expanded'features             = 1 + job'report'base                 03112000
      << flag for compatibility mode/expanded features >>               03114000
                                                                        03116000
   ,input'sequence'count          = 1 + expanded'features               03118000
      << used to validate incoming records - set to zero  >>            03120000
                                                                        03122000
      << at completion of device clear command            >>            03124000
   ,output'sequence'count         = 1 + input'sequence'count            03126000
                                                                        03128000
      << used to generate record numbers on outbound re-  >>            03130000
      << cords - set to zero at completion of device clear >>           03132000
                                                                        03134000
   ,receive'ready'count           = 1 + output'sequence'count           03136000
      << count of available peripheral buffers >>                       03138000
                                                                        03140000
   ,xlate'flags                   = 1 + receive'ready'count             03142000
      << storage array for function code translator >>                  03144000
                                                                        03146000
   ,sequence'1'buffer             = 2 + xlate'flags                     03148000
      << buffer array for leading escape sequence(s) >>                 03150000
                                                                        03152000
   ,o'r'data'type                 = 1 + sequence'1'buffer               03154000
      << data type of current request(s) >>                             03156000
                                                                        03158000
   ,i'r'data'type                 = 1 + o'r'data'type                   03160000
      << data type of current request(s) >>                             03162000
                                                                        03164000
   ,file'open'count               = 1 + i'r'data'type                   03166000
      << number of outstanding file'opens against device >>             03168000
                                                                        03170000
   ,device'allocated              = 1 + file'open'count                 03172000
      << set to true whenever a caller has allocated the de- >>         03174000
      << vice with at least one fopen call.  Set to false    >>         03176000
      << whenever a device close call is made.               >>         03178000
                                                                        03180000
   ,logical'device                = 1 + device'allocated                03182000
      << logical device that this cb'info is for >>                     03184000
                                                                        03186000
   ,ciper'dst                     = 1 + logical'device                  03188000
      << contains dst number of the dst containing this area >>         03190000
                                                                        03192000
   ,out'recs'overwritten          = 1 + ciper'dst                       03194000
      << counts number of times Device Clear command has to >>          03196000
      << overwrite pending data in output record buffer area >>         03198000
                                                                        03200000
   ,in'recs'overwritten           = 1 + out'recs'overwritten            03202000
      << counts number of times Clear Response has to over- >>          03204000
      << write pending data in the input record buffer area >>          03206000
                                                                        03208000
   ,device'buffer'size            = 1 + in'recs'overwritten             03210000
      << size (in bytes) of peripheral record length >>                 03212000
                                                                        03214000
   ,device'env'status'size        = 1 + device'buffer'size              03216000
      << size (in bytes) of peripheral's maximum length >>              03218000
      << environmental status report                    >>              03220000
                                                                        03222000
   ,product'number                = 1 + device'env'status'size          03224000
      << array to contain ASCII encoded product number >>               03226000
      << returned in Clear Response                    >>               03228000
                                                                        03230000
   ,storage'requirements          = 1 + product'number                  03232000
      << tallies up space needed in permanent cds area >>               03234000
                                                                        03236000
   ,temp'area                     = 1 + storage'requirements            03238000
      << points to base of temporary cds area >>                        03240000
                                                                        03242000
   ,ct'ptr                        = 1 + temp'area                       03244000
      << contains address of control table >>                           03246000
                                                                        03248000
   ,packet'header'size            = 1 + ct'ptr                          03250000
      << contains size of packet header (in words) >>                   03252000
                                                                        03254000
   ,packet'trailer'size           = 1 + packet'header'size              03256000
      << contains size of packet trailer (in words) >>                  03258000
                                                                        03260000
   ,packet'size                   = 1 + packet'trailer'size             03262000
      << Length (in bytes) of largest packet allowed by >>              03264000
      << current configuration of physical level        >>              03266000
                                                                        03268000
   ,dev'clr'count                 = 1 + packet'size                     03270000
      << tally of how many recursions of the device'clear >>            03272000
      << procedure we are making.  If the count exceeds a >>            03274000
      << preset value (currently 3) then there is something >>          03276000
      << serious enough to prevent the clear from complet-  >>          03278000
      << properly.                                          >>          03280000
                                                                        03282000
   ,dev'clr'in'progress           = 1 + dev'clr'count                   03284000
      << Set to true during a device clear sequence to in- >>           03286000
      << hibit record number sequence checking.            >>           03288000
                                                                        03290000
   ,sr'enable                     = 1 + dev'clr'in'progress             03292000
      << used for configuration of status reporting >>                  03294000
                                                                        03296000
   ,esb'frequency                 = 1 + sr'enable                       03298000
      << sets number of checkpoint occurances between en- >>            03300000
      << vironmental status reports sent.                 >>            03302000
                                                                        03304000
   ,logging'dst                   = 1 + esb'frequency                   03306000
      << contains dst number of current logging data segment >>         03308000
                                                                        03310000
   ,logging'buffer                = 1 + logging'dst                     03312000
      << pointer to buffer used in performance logging >>               03314000
                                                                        03316000
   ,event'map                     = 1 + logging'buffer                  03318000
      << bit map that indicates which events are enabled for >>         03320000
      << logging to take place.  If bit 0 is set, logging    >>         03322000
      << suspended temporarily.                              >>         03324000
                                                                        03326000
   ,status'enabled                = 1 + event'map                       03328000
      << bit map of status types whose receipt can cause >>             03330000
      << a special return status to caller.              >>             03332000
                                                                        03334000
   ,status'received               = 1 + status'enabled                  03336000
      << bit map of status types which have been received >>            03338000
                                                                        03340000
   ,status'reported               = 1 + status'received                 03342000
      << bit map of status types whose receipt has been >>              03344000
      << reported to caller via special return code     >>              03346000
                                                                        03348000
   ,default'access'mode           = 1 + status'reported                 03350000
      << determines the access mode granted after every  >>             03352000
      << job start or allocation fopen.                  >>             03354000
                                                                        03356000
   ,comp'stat'available           = 1 + default'access'mode             03358000
      << Flag to indicate whether or not any information is >>          03360000
      << contained in the composite device status area.     >>          03362000
                                                                        03364000
   ,cb'info'size                  = 1 + comp'stat'available             03366000
      << total size required for cb'info area >>                        03368000
                                                                        03370000
  ;                                                                     03372000
                                                                        03374000
$PAGE                                                                   03376000
  << DEFINITIONS OF CB'INFO SUBPARAMETERS >>                            03378000
                                                                        03380000
  << Bit maps for status'enabled, status'received, and >>               03382000
  << status'reported words:                            >>               03384000
                                                                        03386000
  define                                                                03388000
                                                                        03390000
    dev'stat'bit                  = (14: 1) #                           03392000
      << Device status report >>                                        03394000
                                                                        03396000
   ,env'stat'bit                  = (15: 1) #                           03398000
      << Environmental status report >>                                 03400000
                                                                        03402000
  ;                                                                     03404000
                                                                        03406000
                                                                        03408000
$PAGE "CIPER RECORD BUFFER CONTROL INFORMATION"                         03410000
  << The following information is a part of each buffer     >>          03412000
  << area allocated within the CIPER data segment.  This is >>          03414000
  << referred to as the control portion, and maintains such >>          03416000
  << things as how much data is currently in the buffer,    >>          03418000
  << where the next available byte is, the maximum size of  >>          03420000
  << the record, etc.                                       >>          03422000
                                                                        03424000
                                                                        03426000
  equate                                                                03428000
                                                                        03430000
    length                        = -1                                  03432000
      << length of buffer area (used for all areas) >>                  03434000
                                                                        03436000
   ,forward'link                  = 1 + length                          03438000
      << link to next buffer in queue (nil if none) >>                  03440000
                                                                        03442000
   ,allocated                     = 1 + forward'link                    03444000
      << true if buffer not in free-list >>                             03446000
                                                                        03448000
   ,active                        = 1 + allocated                       03450000
      << record in use (dirty) flag >>                                  03452000
                                                                        03454000
   ,ready                         = 1 + active                          03456000
      << set true when buffer ready for transmission >>                 03458000
                                                                        03460000
   ,start                         = 1 + ready                           03462000
      << starting address of record >>                                  03464000
                                                                        03466000
   ,current'position              = 1 + start                           03468000
      << address of next available word >>                              03470000
                                                                        03472000
   ,current'length                = 1 + current'position                03474000
      << length (in bytes) of record >>                                 03476000
                                                                        03478000
   ,maximum'size                  = 1 + current'length                  03480000
      << maximum allowable length of record >>                          03482000
                                                                        03484000
   ,record'overhead               = maximum'size - length + 1           03486000
      << total space required for record control information >>         03488000
                                                                        03490000
  ;                                                                     03492000
                                                                        03494000
                                                                        03496000
$PAGE "CIPER RECORD HEADER DEFINITIONS"                                 03498000
  << Each record buffer area has space reserved for the     >>          03500000
  << record header.  The parameter bytes are optional for   >>          03502000
  << some records.                                          >>          03504000
                                                                        03506000
                                                                        03508000
  equate                                                                03510000
                                                                        03512000
    rec'head'length               = 4                                   03514000
      << current size of record header (in bytes) >>                    03516000
                                                                        03518000
  ;                                                                     03520000
                                                                        03522000
  define                                                                03524000
                                                                        03526000
    header'length                 = 0).(0:8 #                           03528000
      << length field of record header >>                               03530000
                                                                        03532000
   ,header'sequence'number        = 0).(8:8 #                           03534000
      << sequence number field of record header >>                      03536000
                                                                        03538000
   ,header'opcode                 = 1).(0:8 #                           03540000
      << operation code (defines type of record) >>                     03542000
                                                                        03544000
   ,header'creator                = 1).(8:1 #                           03546000
      << creator field (0=host/1=device) >>                             03548000
                                                                        03550000
   ,sob'flag                      = 1).(9:1 #                           03552000
      << Start of block flag, if set block label to follow >>           03554000
                                                                        03556000
   ,eob'flag                      = 1).(10:1 #                          03558000
      << End of block >>                                                03560000
                                                                        03562000
   ,type'of'data                  = 1).(11:5 #                          03564000
      << type of data contained in record (qualification  >>            03566000
      << of the opcode)                                   >>            03568000
                                                                        03570000
   ,parm'byte'1                   = 2).(0:8 #                           03572000
      << first parameter byte >>                                        03574000
                                                                        03576000
   ,parm'byte'2                   = 2).(8:8 #                           03578000
      << parameter byte two >>                                          03580000
                                                                        03582000
   ,parm'byte'3                   = 3).(0:8 #                           03584000
      << parameter byte three >>                                        03586000
                                                                        03588000
   ,parm'byte'4                   = 3).(8:8 #                           03590000
      << parameter byte four >>                                         03592000
                                                                        03594000
   ,parm'byte'5                   = 4).(0:8 #                           03596000
      << parameter byte five >>                                         03598000
                                                                        03600000
   ,parm'byte'6                   = 4).(8:8 #                           03602000
      << parameter byte six >>                                          03604000
                                                                        03606000
  ;                                                                     03608000
$PAGE "CIPER 'READ' RECORD DEFINITIONS"                                 03610000
  << The type of read becomes the first parameter byte of   >>          03612000
  << a read request record.  The types of data that can be  >>          03614000
  << requested is shown.                                    >>          03616000
                                                                        03618000
                                                                        03620000
  << ALLOWABLE TYPES OF READS >>                                        03622000
                                                                        03624000
  equate                                                                03626000
                                                                        03628000
    one'record'immediately        = 0                                   03630000
      << read one record immediately; may be null response >>           03632000
                                                                        03634000
   ,one'when'available            = 1                                   03636000
      << read one record when available >>                              03638000
                                                                        03640000
   ,one'continuation'record       = 2                                   03642000
      << read one continuation record when available >>                 03644000
                                                                        03646000
   ,read'continuously             = 3                                   03648000
      << read records continuously, as available >>                     03650000
                                                                        03652000
  ;                                                                     03654000
                                                                        03656000
                                                                        03658000
  << ALLOWABLE "READ" DATA TYPES >>                                     03660000
                                                                        03662000
  equate                                                                03664000
                                                                        03666000
    user'escape'seq'response      = 1                                   03668000
      << response to user's escape sequence command >>                  03670000
                                                                        03672000
   ,host'escape'seq'response      = 2                                   03674000
      << response to host's escape sequence command >>                  03676000
                                                                        03678000
   ,keyboard'input                = 8                                   03680000
      << data input from device keyboard >>                             03682000
                                                                        03684000
  ;                                                                     03686000
                                                                        03688000
                                                                        03690000
$PAGE "CIPER 'WRITE' RECORD DEFINITIONS"                                03692000
  << The following types of write data records are current- >>          03694000
  << ly defined by CIPER.  This information is included in  >>          03696000
  << the type of data field of the record header.           >>          03698000
                                                                        03700000
                                                                        03702000
  equate                                                                03704000
                                                                        03706000
    user'data'with'mask           = 0                                   03708000
      << user data with control mask invoked >>                         03710000
                                                                        03712000
   ,user'data'without'mask        = 1                                   03714000
      << user data without control mask invoked >>                      03716000
                                                                        03718000
   ,host'data                     = 2                                   03720000
      << host data (no control mask ever) >>                            03722000
                                                                        03724000
   ,display'panel'data            = 8                                   03726000
      << data for display panel (if any) >>                             03728000
                                                                        03730000
  ;                                                                     03732000
                                                                        03734000
                                                                        03736000
  << "WRITE" block label information >>                                 03738000
                                                                        03740000
  equate                                                                03742000
                                                                        03744000
    block'label'length            = 6                                   03746000
      << Block labels are six bytes long, in the following >>           03748000
      << format:                                           >>           03750000
      <<    byte 0 - Block label length                    >>           03752000
      <<    byte 1 - Reserved                              >>           03754000
      <<    bytes 2-5 Double word block number             >>           03756000
                                                                        03758000
                                                                        03760000
  ;                                                                     03762000
                                                                        03764000
                                                                        03766000
$PAGE "CIPER 'CONFIGURATION' RECORD DATA TYPE DEFINITIONS"              03768000
  << CIPER currently has two types of configuration data:   >>          03770000
  << the status mask, which indicates when, if, and what    >>          03772000
  << type(s) of status to report, and the control mask,     >>          03774000
  << which defines which set of ASCII control codes and es- >>          03776000
  << cape sequences the device should act upon.             >>          03778000
                                                                        03780000
                                                                        03782000
  equate                                                                03784000
                                                                        03786000
    status'mask                   = 0                                   03788000
      << Configures reporting of certain status types, >>               03790000
      << such as device status or environmental status >>               03792000
                                                                        03794000
   ,control'mask                  = 1                                   03796000
      << mask for control code/escape sequence processing >>            03798000
                                                                        03800000
  ;                                                                     03802000
                                                                        03804000
                                                                        03806000
  << Universal equate for logical record types which have >>            03808000
  << no particular data type(s):                          >>            03810000
                                                                        03812000
  equate                                                                03814000
                                                                        03816000
    no'data'type'used             = 0                                   03818000
                                                                        03820000
  ;                                                                     03822000
                                                                        03824000
                                                                        03826000
                                                                        03828000
                                                                        03830000
$PAGE "CIPER ENVIRONMENTAL STATUS DEFINITIONS"                          03832000
  << The following definitions are the major elements of    >>          03834000
  << the fixed portion of an environmental status report.   >>          03836000
  << The device dependent portion can be of arbitrary       >>          03838000
  << length and content, so no definition of that portion   >>          03840000
  << is given.                                              >>          03842000
                                                                        03844000
  << The most recent copy of environmental status is saved  >>          03846000
  << in the CIPER data segment, where the user program/     >>          03848000
  << spooler can retrieve it via a function 191 request.    >>          03850000
                                                                        03852000
                                                                        03854000
  equate  << single word indexes >>                                     03856000
                                                                        03858000
    block'number                  = 0                                   03860000
      << user data block number >>                                      03862000
                                                                        03864000
   ,byte'offset                   = 2                                   03866000
      << byte offset within data block >>                               03868000
                                                                        03870000
   ,checkpoint'number             = 4                                   03872000
      << device checkpoint identifier >>                                03874000
                                                                        03876000
   ,last'non'recov'checkpoint     = 6                                   03878000
      << previous checkpoint ahead of which no recovery >>              03880000
      << can be performed with this status information  >>              03882000
                                                                        03884000
   ,esb'format'number             = 8                                   03886000
      << identifies the specific format of device depen- >>             03888000
      << dent area, which follows this field             >>             03890000
                                                                        03892000
   ,device'dep'status             = 9                                   03894000
      << device dependent status portion >>                             03896000
                                                                        03898000
  ;                                                                     03900000
                                                                        03902000
  equate  << double word indexes >>                                     03904000
                                                                        03906000
    d'block'number                = 0                                   03908000
   ,d'byte'offset                 = 1                                   03910000
   ,d'checkpoint'number           = 2                                   03912000
   ,d'last'non'recov'checkpoint   = 3                                   03914000
                                                                        03916000
  ;                                                                     03918000
                                                                        03920000
                                                                        03922000
                                                                        03924000
  equate                                                                03926000
                                                                        03928000
    env'status'overhead           = 1                                   03930000
      << total space required for env status control info >>            03932000
                                                                        03934000
  ;                                                                     03936000
                                                                        03938000
                                                                        03940000
                                                                        03942000
$PAGE "CIPER DEVICE STATUS DEFINITIONS"                                 03944000
  << Device status indicates the state of the peripheral.   >>          03946000
  << It may be specifically requested from the device, or   >>          03948000
  << the device may be configured to send a status report   >>          03950000
  << if any of the information contained in the report has  >>          03952000
  << changed.  The device ALWAYS reports a powerfail.       >>          03954000
                                                                        03956000
  << The most recent copy of device status will be saved in >>          03958000
  << the CIPER data segment.  The user program/spooler can  >>          03960000
  << retrieve the information with either a device status   >>          03962000
  << function request.                                      >>          03964000
                                                                        03966000
  << Reception of a status report may cause console mes-    >>          03968000
  << sages to be generated.                                 >>          03970000
                                                                        03972000
                                                                        03974000
                                                                        03976000
  define                                                                03978000
                                                                        03980000
    peripheral'status             = 0).(0:8 #                           03982000
      << peripheral status byte - reflects current status >>            03984000
                                                                        03986000
   ,peripheral'errors             = 0).(8:8 #                           03988000
      << peripheral error occurance - cleared when read >>              03990000
                                                                        03992000
   ,self'test'code                = 1 #                                 03994000
      << contains self test information >>                              03996000
                                                                        03998000
   ,ciper'protocol'errors         = 2 #                                 04000000
      << device clears after reporting >>                               04002000
                                                                        04004000
    << status byte expansions: >>                                       04006000
                                                                        04008000
    << peripheral status: >>                                            04010000
   ,on'line                       = 0).(0:1 #                           04012000
   ,paper'out                     = 0).(1:1 #                           04014000
   ,paper'jam                     = 0).(2:1 #                           04016000
   ,platen'open                   = 0).(3:1 #                           04018000
   ,ribbon'error                  = 0).(4:1 #                           04020000
   ,self'test'failed              = 0).(6:1 #                           04022000
                                                                        04024000
    << peripheral errors: >>                                            04026000
   ,possible'data'loss            = 0).(14:1 #                          04028000
   ,power'fail                    = 0).(15:1 #                          04030000
                                                                        04032000
    << CIPER protocol errors: >>                                        04034000
   ,illegal'header'length         = 2).(0:1 #                           04036000
   ,recv'record'numbering'error   = 2).(1:1 #                           04038000
   ,illegal'creator'bit           = 2).(2:1 #                           04040000
   ,undefined'record'opcode       = 2).(3:1 #                           04042000
   ,bad'data'type                 = 2).(4:1 #                           04044000
   ,bad'esb'format'number         = 2).(5:1 #                           04046000
   ,illegal'block'label'len       = 2).(7:1 #                           04048000
   ,transport'error               = 2).(8:1 #                           04050000
   ,data'overrun                  = 2).(9:1 #                           04052000
  ;                                                                     04054000
                                                                        04056000
                                                                        04058000
  equate                                                                04060000
                                                                        04062000
    device'status'length          = 6                                   04064000
      << length of information (in bytes) >>                            04066000
                                                                        04068000
   ,device'status'size            = device'status'length + 1            04070000
      << total space required for device status (in words) >>           04072000
      << Leaves enough room for two copies (old and new) >>             04074000
      << required for comparisons.                       >>             04076000
                                                                        04078000
   ,comp'status'length            = (device'status'length+1)/2          04080000
      << length, in words, of composite status information >>           04082000
                                                                        04084000
   ,comp'status'size              = comp'status'length + 1              04086000
      << size, in words, of area required for the composite >>          04088000
      << device status information.                         >>          04090000
                                                                        04092000
  ;                                                                     04094000
                                                                        04096000
                                                                        04098000
$PAGE "CIPER JOB REPORT DEFINITIONS"                                    04100000
  << The job report will be returned at the end of a job,   >>          04102000
  << or when specifically requested via the return job re-  >>          04104000
  << port command.                                          >>          04106000
                                                                        04108000
                                                                        04110000
                                                                        04112000
  equate                                                                04114000
                                                                        04116000
    job'end'errors                = 0                                   04118000
      << Flags for certain error conditions present at end >>           04120000
      << of job                                            >>           04122000
                                                                        04124000
   ,physical'page'count           = 1                                   04126000
      << Double word count of physical pages printed during >>          04128000
      << job                                                >>          04130000
                                                                        04132000
  ;                                                                     04134000
                                                                        04136000
                                                                        04138000
  equate                                                                04140000
                                                                        04142000
    job'report'length             = 6                                   04144000
      << length of information (in bytes) >>                            04146000
                                                                        04148000
   ,job'report'size               = ((job'report'length+1)/2)+1         04150000
      << total space required for job report >>                         04152000
      << Takes into account odd sized report lengths >>                 04154000
                                                                        04156000
  ;                                                                     04158000
                                                                        04160000
                                                                        04162000
$PAGE "CIPER MISCELLANEOUS INFORMATION"                                 04164000
  << PRODUCT IDENTIFICATION AREA INFORMATION >>                         04166000
                                                                        04168000
  equate                                                                04170000
                                                                        04172000
    product'id'length             = 7                                   04174000
      << length (in bytes) of product identification info >>            04176000
                                                                        04178000
   ,product'id'size               = (product'id'length+1)/2 + 1         04180000
      << size (in words) of area reserved for product id >>             04182000
                                                                        04184000
  ;                                                                     04186000
                                                                        04188000
                                                                        04190000
                                                                        04192000
                                                                        04194000
                                                                        04196000
  << MISCELLANEOUS INFORMATION >>                                       04198000
                                                                        04200000
  define                                                                04202000
                                                                        04204000
    in'use                        = true #                              04206000
      << indicates record buffer area is not clean >>                   04208000
                                                                        04210000
   ,free                          = false #                             04212000
      << indicates record buffer area has no record >>                  04214000
                                                                        04216000
  ;                                                                     04218000
                                                                        04220000
                                                                        04222000
  << DEFINITIONS FOR SINGLE BIT EXTRACTIONS >>                          04224000
                                                                        04226000
  define                                                                04228000
                                                                        04230000
    bit'0                         = ( 0: 1) #                           04232000
   ,bit'1                         = ( 1: 1) #                           04234000
   ,bit'2                         = ( 2: 1) #                           04236000
   ,bit'3                         = ( 3: 1) #                           04238000
   ,bit'4                         = ( 4: 1) #                           04240000
   ,bit'5                         = ( 5: 1) #                           04242000
   ,bit'6                         = ( 6: 1) #                           04244000
   ,bit'7                         = ( 7: 1) #                           04246000
   ,bit'8                         = ( 8: 1) #                           04248000
   ,bit'9                         = ( 9: 1) #                           04250000
   ,bit'10                        = (10: 1) #                           04252000
   ,bit'11                        = (11: 1) #                           04254000
   ,bit'12                        = (12: 1) #                           04256000
   ,bit'13                        = (13: 1) #                           04258000
   ,bit'14                        = (14: 1) #                           04260000
   ,bit'15                        = (15: 1) #                           04262000
                                                                        04264000
  ;                                                                     04266000
                                                                        04268000
                                                                        04270000
  equate                                                                04272000
                                                                        04274000
    host                          = 0                                   04276000
      << indicates host is originator of this record >>                 04278000
                                                                        04280000
   ,device                        = 1                                   04282000
      << indicates device is originator of this record >>               04284000
                                                                        04286000
   ,blocked                       = 1                                   04288000
      << indicates blocked I/O request >>                               04290000
                                                                        04292000
   ,xlator'buff'size              = 50                                  04294000
      << size of translator escape sequence buffer(s) >>                04296000
                                                                        04298000
   ,set'bit                       = 1                                   04300000
      << Sets a single bit >>                                           04302000
                                                                        04304000
   ,clear'bit                     = 0                                   04306000
      << Clear a single bit >>                                          04308000
                                                                        04310000
   ,no'overwrite                  = 0                                   04312000
      << Used when calling get'buffer:  indicates that if >>            04314000
      << no record buffer area is available from the free >>            04316000
      << list, then return a nil pointer.                 >>            04318000
                                                                        04320000
   ,output'overwrite              = 1                                   04322000
      << Used when calling get'buffer:  indicates that if >>            04324000
      << no record buffer area is available from the free >>            04326000
      << list, then return the dedicated output buffer.   >>            04328000
                                                                        04330000
   ,input'overwrite               = 2                                   04332000
      << Used when calling get'buffer:  indicates that if >>            04334000
      << no record buffer area is available from the free >>            04336000
      << list, then return the dedicated input buffer.    >>            04338000
                                                                        04340000
                                                                        04342000
  << Calling parameters used when calling the procedures   >>           04344000
  << b08'buf'device'status and b08'buffered'env'status:    >>           04346000
                                                                        04348000
   ,buffered                      = 0                                   04350000
      << Get the copy currently in the appropriate status   >>          04352000
      << area.                                              >>          04354000
                                                                        04356000
   ,immediate                     = 1                                   04358000
      << Get a fresh copy directly from the device          >>          04360000
                                                                        04362000
   ,composite                     = 2                                   04364000
      << Get the composite device status                    >>          04366000
                                                                        04368000
  ;                                                                     04370000
                                                                        04372000
                                                                        04374000
  << TEMPORARY !!! DEFINITIONS FOR EXTERNALS >>                         04376000
                                                                        04378000
  define                                                                04380000
                                                                        04382000
    absdbflag                     = (0:1) #                             04384000
   ,xdsdstfield                   = (1:10) #                            04386000
                                                                        04388000
  ;                                                                     04390000
                                                                        04392000
                                                                        04394000
$PAGE "CIPER INTERNAL LOGGING DEFINITIONS"                              04396000
                                                                        04398000
  << General logging constants >>                                       04400000
                                                                        04402000
  equate                                                                04404000
                                                                        04406000
    head'entry'length             = 7                                   04408000
      << Size (in words) of logging dst head entry >>                   04410000
                                                                        04412000
   ,log'data'length               = 38                                  04414000
      << Allow 38 words of data per log record >>                       04416000
                                                                        04418000
  ;                                                                     04420000
                                                                        04422000
                                                                        04424000
                                                                        04426000
  equate                                                                04428000
                                                                        04430000
  << First section of logging buffer is reserved for the >>             04432000
  << logging dst head entry.  This entry controls the use >>            04434000
  << of the dst, and is written to and saved in the dst  >>             04436000
  << when the dst becomes full and/or logging is completed >>           04438000
                                                                        04440000
    he'length                     = -head'entry'length                  04442000
      << length of head entry in logging buffer >>                      04444000
                                                                        04446000
   ,he'type                       = 1 + he'length                       04448000
      << head entry type >>                                             04450000
                                                                        04452000
   ,he'ldev                       = 1 + he'type                         04454000
      << backward reference to ldev associated with log >>              04456000
                                                                        04458000
   ,he'next'word                  = 1 + he'ldev                         04460000
      << next available word in current logging dst >>                  04462000
                                                                        04464000
   ,he'last'word                  = 1 + he'next'word                    04466000
      << last word of current logging dst >>                            04468000
                                                                        04470000
   ,he'previous'dst               = 1 + he'last'word                    04472000
      << link to previous dst used for logging >>                       04474000
                                                                        04476000
   ,he'next'dst                   = 1 + he'previous'dst                 04478000
      << link to next dst used for logging >>                           04480000
                                                                        04482000
                                                                        04484000
  << The rest of the logging buffer is for entry use, with >>           04486000
  << the first two words having special meaning:           >>           04488000
                                                                        04490000
   ,log'entry'length              = 1 + he'next'dst                     04492000
      << inclusive length of log entry data (in words) >>               04494000
                                                                        04496000
   ,log'entry'type                = 1 + log'entry'length                04498000
      << type of log entry -- used by analysis program >>               04500000
                                                                        04502000
   ,log'entry'data                = 1 + log'entry'type                  04504000
      << base of data portion of log entry >>                           04506000
                                                                        04508000
                                                                        04510000
  << The next two items are used during initialization to  >>           04512000
  << set up the logging system.                            >>           04514000
                                                                        04516000
   ,log'buffer'size               = 1 + log'entry'data                  04518000
                                  - he'length + 1                       04520000
                                  + log'data'length                     04522000
      << Size of buffer to allocate in CIPER data segment >>            04524000
                                                                        04526000
   ,log'dst'size                  = 32000                               04528000
      << Size of dst (in words) to allocate for logging >>              04530000
                                                                        04532000
;                                                                       04534000
                                                                        04536000
                                                                        04538000
  << Logging event types (as defined so far).  Permissable >>           04540000
  << range is 1 to 15.  Zero defaults to mean all events.  >>           04542000
                                                                        04544000
  equate                                                                04546000
                                                                        04548000
    all'events                    = 0                                   04550000
      << Enable/disable all events defined >>                           04552000
                                                                        04554000
   ,pcal'exit'time                = 1                                   04556000
      << Execution time from driver entry to exit >>                    04558000
                                                                        04560000
   ,event'type'2                  = 2                                   04562000
      << Undefined >>                                                   04564000
                                                                        04566000
   ,event'type'3                  = 3                                   04568000
      << Undefined >>                                                   04570000
                                                                        04572000
   ,event'type'4                  = 4                                   04574000
      << Undefined >>                                                   04576000
                                                                        04578000
   ,event'type'5                  = 5                                   04580000
      << Undefined >>                                                   04582000
                                                                        04584000
   ,event'type'6                  = 6                                   04586000
      << Undefined >>                                                   04588000
                                                                        04590000
   ,event'type'7                  = 7                                   04592000
      << Undefined >>                                                   04594000
                                                                        04596000
   ,event'type'8                  = 8                                   04598000
      << Undefined >>                                                   04600000
                                                                        04602000
   ,event'type'9                  = 9                                   04604000
      << Undefined >>                                                   04606000
                                                                        04608000
   ,event'type'10                 = 10                                  04610000
      << Undefined >>                                                   04612000
                                                                        04614000
   ,event'type'11                 = 11                                  04616000
      << Undefined >>                                                   04618000
                                                                        04620000
   ,event'type'12                 = 12                                  04622000
      << Undefined >>                                                   04624000
                                                                        04626000
   ,event'type'13                 = 13                                  04628000
      << Undefined >>                                                   04630000
                                                                        04632000
   ,event'type'14                 = 14                                  04634000
      << Undefined >>                                                   04636000
                                                                        04638000
   ,event'type'15                 = 15                                  04640000
      << Undefined >>                                                   04642000
                                                                        04644000
  ;                                                                     04646000
                                                                        04648000
                                                                        04650000
  << Log entry type codes.  Used by reduction program to >>             04652000
  << sort events by type.                                >>             04654000
                                                                        04656000
  equate                                                                04658000
                                                                        04660000
    head'entry'type               = 0                                   04662000
      << Head entry of logging dst. >>                                  04664000
                                                                        04666000
   ,execution'time                = 1                                   04668000
      << Driver execution time from pcal to exit >>                     04670000
                                                                        04672000
  ;                                                                     04674000
                                                                        04676000
                                                                        04678000
                                                                        04680000
                                                                        04682000
                                                                        04684000
                                                                        04686000
$PAGE "CIPER MESSAGE CATALOG DEFINITIONS"                               04688000
  << Definition of CIPER message catalog set number and >>              04690000
  << message text numbers.                              >>              04692000
                                                                        04694000
  equate                                                                04696000
                                                                        04698000
    ciper'set                     = 28                                  04700000
      << message set of CIPER error messages >>                         04702000
                                                                        04704000
   ,not'ready'msg                 = 1                                   04706000
      << ldev not ready >>                                              04708000
                                                                        04710000
   ,power'up'msg                  = 2                                   04712000
      << device powered up or reset >>                                  04714000
                                                                        04716000
   ,off'line'msg                  = 3                                   04718000
      << device has been placed off-line >>                             04720000
                                                                        04722000
   ,on'line'msg                   = 4                                   04724000
      << device has been placed on-line >>                              04726000
                                                                        04728000
   ,paper'out'msg                 = 5                                   04730000
      << device reports out of paper >>                                 04732000
                                                                        04734000
   ,paper'jam'msg                 = 6                                   04736000
      << device reports paper jam >>                                    04738000
                                                                        04740000
   ,platen'open'msg               = 7                                   04742000
      << device reports platen is open >>                               04744000
                                                                        04746000
   ,ribbon'error'msg              = 8                                   04748000
      << to be assigned >>                                              04750000
                                                                        04752000
   ,self'test'msg                 = 9                                   04754000
      << device reports self test failure >>                            04756000
                                                                        04758000
   ,msg'illegal'header'length     = 10                                  04760000
      << device reports illegal record header length >>                 04762000
                                                                        04764000
   ,msg'record'sequence'error     = 11                                  04766000
      << device reports sequence error in record sequence >>            04768000
      << number                                           >>            04770000
                                                                        04772000
   ,msg'illegal'creator'of'record = 12                                  04774000
      << device received a record with an invalid creator >>            04776000
      << bit in the record header                         >>            04778000
                                                                        04780000
   ,msg'undef'record'opcode       = 13                                  04782000
      << device received a record with an invalid opcode  >>            04784000
      << field in the record header                       >>            04786000
                                                                        04788000
   ,msg'undef'data'type           = 14                                  04790000
      << device received a record with an invalid data    >>            04792000
      << type field in the record header                  >>            04794000
                                                                        04796000
   ,msg'bad'ESB'format'number     = 15                                  04798000
      << device received a silent run command with an in- >>            04800000
      << valid ESB format number in it.                   >>            04802000
                                                                        04804000
   ,msg'bad'block'label'length    = 17                                  04806000
      << device received a record marked 'start of block' >>            04808000
      << that had an invalid block label length parameter >>            04810000
                                                                        04812000
   ,msg'transport'error           = 18                                  04814000
      << device's transport service interface reported an >>            04816000
      << error it could not recover from                  >>            04818000
                                                                        04820000
   ,msg'data'overrun              = 19                                  04822000
      << device was overrun by data it could not accept   >>            04824000
      << due to lack of buffer space                      >>            04826000
                                                                        04828000
   ,msg'data'lost                 = 20                                  04830000
      << device reports loss of data for some unknown     >>            04832000
      << reason                                           >>            04834000
                                                                        04836000
   ,shutdown'msg                  = 30                                  04838000
      << used when cpr'shutdown is called >>                            04840000
                                                                        04842000
  ;                                                                     04844000
                                                                        04846000
$PAGE "CIPER MISCELLANEOUS #2"                                          04848000
                                                                        04850000
                                                                        04852000
                                                                        04856000
  << DEFINITIONS OF SYSTEM GLOBAL INFORMATION >>                        04858000
                                                                        04860000
  define                                                                04862000
                                                                        04864000
    sysdb                         = 512D #                              04866000
      << absolute address of system global >>                           04868000
                                                                        04870000
  ;                                                                     04872000
                                                                        04874000
                                                                        04876000
  equate                                                                04878000
                                                                        04880000
    sysdb'                        = 512                                 04882000
      << single word equivalence of sysdb >>                            04884000
                                                                        04886000
   ,sysdb'sbuf'base               = sysdb' + 6                          04888000
      << contains sysdb relative address of system >>                   04890000
      << buffer table                              >>                   04892000
                                                                        04894000
   ,sysdb'ioq'base                = sysdb' + 5                          04896000
      << contains sysdb relative address of system >>                   04898000
      << IOQ table                                 >>                   04900000
                                                                        04902000
   ,sys'buff'size                 = 128                                 04904000
      << size in words of system buffer (excluding link) >>             04906000
                                                                        04908000
  ;                                                                     04910000
                                                                        04912000
                                                                        04914000
  << DEFINITION OF SYSTEM DATA SEGMENTS >>                              04916000
                                                                        04918000
  equate                                                                04920000
                                                                        04922000
    sbuf'dst                      = %10                                 04924000
      << data segment number of system buffer table >>                  04926000
                                                                        04928000
   ,ioq'dst                       = %13                                 04930000
      << data segment number of IOQ table >>                            04932000
                                                                        04934000
  ;                                                                     04936000
                                                                        04938000
  <<ciper intrinsics>>                                                  04940000
$PAGE "INTRINSICS"                                                      04942000
                                                                        04944000
                                                                        04946000
intrinsic                                                               04948000
          debug                                                         04950000
;                                                                       04952000
                                                                        04954000
  <<ciper external procedure declarations>>                             04956000
integer procedure getioq(type);                                         04958000
  value                  type ;                                         04960000
  integer                type ;                                         04962000
  option external, privileged, uncallable;                              04964000
                                                                        04966000
                                                                        04968000
procedure returnsysbuf(index);                                          04970000
  value                index ;                                          04972000
  integer              index ;                                          04974000
  option external, privileged, uncallable;                              04976000
$PAGE "EXTERNAL PROCEDURE: EXCHANGEDB"                                  04978000
logical procedure exchangeDB(destination'dseg);                         04980000
value                        destination'dseg ;                         04982000
integer                      destination'dseg ;                         04984000
option external, privileged, uncallable;                                04986000
                                                                        04988000
COMMENT                                                                 04990000
                                                                        04992000
The procedure  exchangeDB is called to put  DB at the base of a         04994000
data segment  or to return DB  to the caller's  stack DB.   The         04996000
destination data  segment number is supplied as  a parameter if         04998000
not returning tothe stack.  If returning to the stack, supply 0         05000000
as the parameter.                                                       05002000
                                                                        05004000
exchangeDB returns the DST number of where DB was (0 if stack).         05006000
This value  may be  saved  and  returned  on  the next  call to         05008000
exchangeDB to restore the previous enviorment.                          05010000
;                                                                       05012000
                                                                        05014000
$PAGE "EXTERNAL PROCEDURES: GETDATASEG & GETDATASEGC"                   05016000
integer procedure getdataseg(memsize, vdsize);                          05018000
value                        memsize, vdsize ;                          05020000
integer                      memsize, vdsize ;                          05022000
option external, privileged, uncallable;                                05024000
                                                                        05026000
integer procedure getdatasegc(memsize, vdsize);                         05028000
value                         memsize, vdsize ;                         05030000
integer                       memsize, vdsize ;                         05032000
option external, privileged, uncallable;                                05034000
                                                                        05036000
COMMENT                                                                 05038000
                                                                        05040000
This function  is called  to create  an extra  data  segment or         05042000
stack.   A DST entry and VDS are allocated and the DST entry is         05044000
initialized to  an absent  state.   The entry  point for  stack         05046000
allocation is getstack.  The entry point to initialize the data         05048000
segment to 0's is getdatasegc.                                          05050000
                                                                        05052000
The DST number is returned.                                             05054000
;                                                                       05056000
                                                                        05058000
$PAGE "EXTERNAL PROCEDURE: GETSIR"                                      05060000
integer procedure getsir(sir);                                          05062000
value                    sir ;                                          05064000
integer                  sir ;                                          05066000
option external, privileged, uncallable;                                05068000
                                                                        05070000
COMMENT                                                                 05072000
                                                                        05074000
getsir is called to obtain exclusive access to a resource which         05076000
is protected by the queueing semaphore passed as the parameter.         05078000
If the sir is busy, the process is queued by priority through a         05080000
doubly linked  list strung through PCB entries.   If the holder         05082000
of the resource is of less  urgent priority than the requestor,         05084000
the holder's  priority is temporarily  bumped until he releases         05086000
the resource.                                                           05088000
                                                                        05090000
The return value indicates  whether the process already holds a         05092000
sir,  and  whether  the  caller  already  holds  the  sir  it's         05094000
currently  requesting.   This value should be  saved and passed         05096000
along to relsir so that proper accounting can be maintained.            05098000
                                                                        05100000
(getsir = 1) := process already held some sir.                          05102000
(getsir = 3) := process already holds the sir its requesting.           05104000
(getsir = 0) := process is acquiring its first sir.                     05106000
;                                                                       05108000
                                                                        05110000
$PAGE "EXTERNAL PROCEDURE: P'ATTACHIO"                                  05112000
                                                                        05114000
double procedure p'attachio(ldev, qmisc, dstx, addr, fnct,              05116000
                 cnt, p1, p2, flags,                           <<04540>>05118000
                 extbase, extsize );                           <<04540>>05120000
                                                                        05122000
value                       ldev, qmisc, dstx, addr, fnct,              05124000
                 cnt, p1, p2, flags,                           <<04540>>05126000
                 extbase, extsize ;                            <<04540>>05128000
                                                                        05130000
integer                     ldev, qmisc, dstx, addr, fnct,              05132000
                           cnt, p1, p2, flags, extsize ;       <<04540>>05134000
                                                               <<04540>>05136000
double                     extbase ;                           <<04540>>05138000
                                                               <<04540>>05140000
option external, privileged, variable;                         <<04540>>05142000
                                                                        05144000
                                                                        05146000
COMMENT                                                                 05148000
                                                                        05150000
Purpose:  This procedure constructs a physical IOQ element and          05152000
links it to the appropriate device queue. If this is the first          05154000
element in the queue or the request specifies preemption,  the          05156000
monitor is  called to  initiate the  operation.   For  blocked          05158000
requests,  the monitor may  be recalled by  p'attachio after a          05160000
"wait" if  the request  is not  completed  when  the caller is          05162000
awoken.                                                                 05164000
                                                                        05166000
     If not IOQ elements are available, impedable requests are          05168000
suspended until  an IOQ element becomes  available.   Requests          05170000
which specify not impedable are not  "waited"  for any reason.          05172000
class of device is called.                                              05174000
                                                                        05176000
Input:                                                                  05178000
ldev :=   Logical device number to which the IO is destined.            05180000
                                                                        05182000
qmisc :=  Miscellaneous  parameter  specified for  the device.          05184000
          If not specified must be zero.                                05186000
                                                                        05188000
dstx :=   DST  number of data segment.  If zero then specifies          05190000
          that addr is DB relative to the callers stack.  Must          05192000
          be zero if system buffers is specified.                       05194000
                                                                        05196000
addr :=   If  FLAGS.(12:1)  =  1  then  this is an  index to a          05198000
          system  buffer.  If FLAGS.(12:1) =  0 then ADDR is a          05200000
          relative address within data segment DSTX.                    05202000
                                                                        05204000
fnct :=   Function code:  device defined but usually:                   05206000
                                                                        05208000
          0 = Read                                                      05210000
          1 = Write                                                     05212000
          2 = Open file                                                 05214000
          3 = Close file                                                05216000
          4 = Close device                                              05218000
                                                                        05220000
cnt :=    Data transfer count:                                          05222000
                                                                        05224000
          If CNT > 0 then CNT value is a word count.  If CNT <          05226000
          0 then CNT value is a byte count.                             05228000
                                                                        05230000
p1 :=     Parameter 1,  device dependent.                               05232000
                                                                        05234000
p2 :=     Parameter 2,  device dependent.                               05236000
extbase := Logical sector number of current file system        <<04540>>05238000
           extent (disc only).                                 <<04540>>05240000
                                                               <<04540>>05242000
extsize := Number of sectors in current file system extent.    <<04540>>05244000
                                                               <<04540>>05246000
$PAGE                                                                   05248000
flags :=  Bit word.  Definitions are:                                   05250000
                                                                        05252000
.( 0:4)   Control and specification flags:                              05254000
                                                                        05256000
          0 = unknown                                                   05258000
          1 = file system                                               05260000
          2 = spooler                                                   05262000
         3 = directory                                         <<04540>>05264000
         4-15 various file system (see P'ATTACHIO)             <<04540>>05266000
                                                                        05268000
.( 4:3)   0   Reserved. Not used.                                       05270000
                                                                        05272000
.( 7:2)   Premption flags.                                              05274000
                                                                        05276000
          1 = soft premption                                            05278000
          2 = hard premption                                            05280000
                                                                        05282000
.( 9:1)   0   Reserved. Not used.                                       05284000
                                                                        05286000
.(10:1)   Special  request.   Device  defined.   If  set  then          05288000
          handling is to be applied to this request.                    05290000
                                                                        05292000
.(11:1)   If set then this is a diagnostic request.                     05294000
                                                                        05296000
.(12:1)   System  buffer  flag.   If set the  ADDR is an index          05298000
          relative  to  the  SBUF  table.   For  devices which          05300000
          support chaining the data is transferred to and from          05302000
          a  set  of chained buffers, up  to a maximum of 1024          05304000
          words.   IF  clear  then  ADDR  is  a  data  segment          05306000
          relative address.                                             05308000
                                                                        05310000
.(13:3)   Request type:                                                 05312000
                                                                        05314000
          0  = Unblocked, no wake on completion.  Impede if no          05316000
              LIOQ element is available.                                05318000
                                                                        05320000
          1  = Blocked.  Caller is  to be waited until request          05322000
              is completed.                                             05324000
                                                                        05326000
          2   =   Unblocked,   wake  caller  when  request  is          05328000
              completed.  impede if no LIOQ available.                  05330000
                                                                        05332000
          3  =  Unblocked  and no process  is to be associated          05334000
              with this request.  Impede if no LIOQ available.          05336000
                                                                        05338000
          4  =  Unblocked,  no  wake on completion  but do not          05340000
              impede if no LIOQ available.                              05342000
                                                                        05344000
          5 = Reserved.                                                 05346000
                                                                        05348000
          6  = Unblocked, wake on completion but do not impede          05350000
              if no LIOQ is available.                                  05352000
                                                                        05354000
          7  =  Unblocked  and no process  is to be associated          05356000
              with  this request but do  not impede if no LIOQ          05358000
              available.                                                05360000
                                                                        05362000
$PAGE                                                                   05364000
Output:                                                                 05366000
p'attachio  :=  a double word value  which may contain several          05368000
          different pieces of information as decribed below:            05370000
                                                                        05372000
                                                                        05374000
                           Blocked                                      05376000
                           -------                                      05378000
                                                                        05380000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  05382000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05384000
 S-1  |        PCB            |  Qualifying  |General |                 05386000
      |       Number          |    Status    | Status |                 05388000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05390000
 S-0  |               Transmission Log                |                 05392000
      |               /Control Returns                |                 05394000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05396000
                                                                        05398000
                    Unblocked (IO system)                               05400000
                    ---------------------                               05402000
                                                                        05404000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  05406000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05408000
 S-1  | 0| 0| 0|         IOQ Index of request         |                 05410000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05412000
 S-0  |                       0                       |                 05414000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05416000
                                                                        05418000
                     Unblocked (DISC IO)                                05420000
                     -------------------                                05422000
                                                                        05424000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  05426000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05428000
 S-1  | 1| 0| 0|      Disk Request Table Pointer      |                 05430000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05432000
 S-0  |                       0                       |                 05434000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05436000
                                                                        05438000
                    Unblocked (CS devices)                              05440000
                    ----------------------                              05442000
                                                                        05444000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  05446000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05448000
 S-1  | 0| 1| 0|         ?????????????????????        |                 05450000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05452000
 S-0  |                       0                       |                 05454000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05456000
                                                                        05458000
$PAGE                                                                   05460000
                    Unblocked (CIPER IO)                                05462000
                    --------------------                                05464000
                                                                        05466000
Note  that  CIPER  logical IOQ is  included here for reference          05468000
only.   The first implementation of CIPER does not include the          05470000
use of LIOQ's.  The second release of CIPER will, however, use          05472000
this structure.                                                         05474000
        0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15                  05476000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05478000
 S-1  | 0| 0| 1|    Logical IOQ number of request     |                 05480000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05482000
 S-0  |                       0                       |                 05484000
      +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+                 05486000
                                                                        05488000
                                                                        05490000
  Control Returns :=                                                    05492000
                                                                        05494000
  Disk Request Table Pointer :=                                         05496000
                                                                        05498000
  General Status :=                                                     05500000
                                                                        05502000
  IOQ index of request :=                                               05504000
                                                                        05506000
  Logical IOQ Number of request :=                                      05508000
                                                                        05510000
  PCB Number :=                                                         05512000
                                                                        05514000
  Qualifing Status :=                                                   05516000
                                                                        05518000
  Transmission log :=                                                   05520000
     If CNT > 0 then CNT value is a word count.                         05522000
     If CNT < 0 then CNT value is a byte count.                         05524000
     This is the same as the CNT parameter of ATTACHIO.                 05526000
                                                                        05528000
The  IOQ index/number returned above  is used as the parameter          05530000
to IOSTATUS to determine the completion status of the request.          05532000
If  the  request type in FLAGS  specified that this request is          05534000
not  impedable  then the IOQ index/LIOQ  number return will be          05536000
zero if no IOQ/LIOQ elements are available.                             05538000
                                                                        05540000
For type 3 requests, if ADDR is not zero then it is assumed to          05542000
be a system buffer index.  At the completion of a request, the          05544000
system  buffer(s) pointed to by ADDR  are returned to the free          05546000
list by the I/O system.                                                 05548000
;                                                                       05550000
                                                                        05552000
$PAGE "EXTERNAL PROCEDURE: RELDATASEG"                                  05554000
procedure reldataseg(dseg);                                             05556000
value                dseg ;                                             05558000
integer              dseg ;                                             05560000
option external, privileged, uncallable;                                05562000
                                                                        05564000
COMMENT                                                                 05566000
                                                                        05568000
This function is called to return resources of a stack of extra         05570000
data segment.                                                           05572000
;                                                                       05574000
                                                                        05576000
$PAGE "EXTERNAL PROCEDURE: RELSIR"                                      05578000
procedure relsir(sir, savedvalue);                                      05580000
value            sir, savedvalue ;                                      05582000
integer          sir, savedvalue ;                                      05584000
option external, privileged, uncallable;                                05586000
                                                                        05588000
COMMENT                                                                 05590000
                                                                        05592000
relsir  releases  the  access   lock  to  the  system  resource         05594000
protected by the queueing semaphore passed as a parameter.  The         05596000
savedvalue returned  from getsir is  passed in  as a parameter,         05598000
and is used to determine if the process had nested calls to the         05600000
same sir  (in which  case the  sir  lock  is not released)  and         05602000
whether the process is releasing its last sir (in which case it         05604000
can field  nasty  pseudo-interrupts  which  could result in the         05606000
process being aborted).                                                 05608000
                                                                        05610000
The resource  is given to the head  of the sir queue,  which is         05612000
the most urgent  process waiting on the  sir due to the queue's         05614000
priority structure.                                                     05616000
                                                                        05618000
If the  process  had its  priority  bumped due  to more  urgent         05620000
processes queueing for the resource, the next rescheduling will         05622000
put it back where it belongs.                                           05624000
;                                                                       05626000
                                                                        05628000
$PAGE "EXTERNAL PROCEDURE:  SETCRITICAL"                       <<04422>>05630000
logical procedure setcritical;                                 <<04422>>05632000
                                                               <<04422>>05634000
  option external, privileged, uncallable;                     <<04422>>05636000
                                                               <<04422>>05638000
COMMENT                                                        <<04422>>05640000
                                                               <<04422>>05642000
  Sets the critical bit in the PCB which prevents the current  <<04422>>05644000
process from being aborted.  It returns a value which          <<04422>>05646000
indicates whether the process was already critical.            <<04422>>05648000
                                                               <<04422>>05650000
;                                                              <<04422>>05652000
$PAGE "EXTERNAL PROCEDURE:  RESETCRITICAL"                     <<04422>>05654000
procedure resetcritical( old'critical'value );                 <<04422>>05656000
                                                               <<04422>>05658000
  value                  old'critical'value  ;                 <<04422>>05660000
                                                               <<04422>>05662000
  logical                old'critical'value  ;                 <<04422>>05664000
                                                               <<04422>>05666000
  option external, privileged, uncallable    ;                 <<04422>>05668000
                                                               <<04422>>05670000
                                                               <<04422>>05672000
COMMENT                                                        <<04422>>05674000
                                                               <<04422>>05676000
  Restores the process to the abortable state unless nested    <<04422>>05678000
calls to setcritical have been made.                           <<04422>>05680000
                                                               <<04422>>05682000
;                                                              <<04422>>05684000
$PAGE "EXTERNAL PROCEDURE: RESETDB"                                     05686000
procedure resetDB(where);                                               05688000
value             where ;                                               05690000
integer           where ;                                               05692000
option external, privileged, uncallable;                                05694000
                                                                        05696000
COMMENT                                                                 05698000
                                                                        05700000
The procedure resetDB  is  called  after  calling  setsysDB  to         05702000
restore  DB  to  the  value  that  was  expected  upon  calling         05704000
setsysDB.                                                               05706000
                                                                        05708000
The value returned  by  setsysDB  should  be  supplied  as  the         05710000
parameter  for  resetDB.    If  'where'  =  -1  then DB will be         05712000
returned to the stack or data segment it was  at  before  being         05714000
set   to  an  absolute  location.    If  'where'  =  0  then  a         05716000
suddendeath(611) will result.  If 'where' is any value beside 0         05718000
or -1 then DB will be set to  the  absolute  location  'where'.         05720000
;                                                                       05722000
                                                                        05724000
$PAGE "EXTERNAL PROCEDURE: SUDDENDEATH"                                 05726000
procedure suddendeath(N);                                               05728000
value                 N ;                                               05730000
integer               N ;                                               05732000
option external, privileged, uncallable;                                05734000
                                                                        05736000
COMMENT                                                                 05738000
                                                                        05740000
Outputs the system halt message with the decimal number N.              05742000
;                                                                       05744000
                                                                        05746000
  <<procedures to be put in other modules>>                             05748000
$PAGE "DB MANIPULATION PROCEDURES : CHANGEDB"                           05752000
double procedure changedb(newdb);                                       05754000
value                     newdb ;                                       05756000
double                    newdb ;                                       05758000
option external, privileged, uncallable;                                05760000
                                                                        05762000
COMMENT --George R. O'Connor. HP Boise Division (11/20/81).             05764000
                                                                        05766000
Purpose:  Performs  an extended EXCHANGEDB  to handle DB being          05768000
set to an absolute address, in bank zero.                               05770000
                                                                        05772000
Error   reporting:   No  error  reporting  occurs  explicitly.          05774000
SUDDENDEATH's  may result from some  of the KERNELC procedures          05776000
which are called.                                                       05778000
                                                                        05780000
External references:                                                    05782000
                     exchangedb                                         05784000
                    ,fixed low memory                                   05786000
                    ,pcb                                                05788000
                    ,resetdb                                            05790000
                    ,setsysdb                                           05792000
                                                                        05794000
Input:                                                                  05796000
     newdb  := A double word value which indicates where DB is          05798000
to  be set to.  If newdb < 0d  then DB will be set to the data          05800000
segment number -newdb.  If newdb = 0d then DB will be returned          05802000
to  the process's stack location.  If  newdb = 1d then DB will          05804000
be  returned  to the data segment or  stack location it was at          05806000
before  being set to an absolute location.  If newdb > 1d then          05808000
DB  will  be set to the absolute  address of newdb.  Note that          05810000
this  permits  DB  to be set to  absolute locations outside of          05812000
bank zero.                                                              05814000
                                                                        05816000
Output:                                                                 05818000
    changedb  :=  The  value which the  caller should save and          05820000
pass  back to changedb so that the previous environment may be          05822000
properly  restored.   If  DB  was  at  the  stack  then  0d is          05824000
returned.   If  DB was set to the  base of a data segment then          05826000
the negative data segment number is returned.  If DB was at an          05828000
absolute  location  then  the  absolute  address  location  is          05830000
returned.                                                               05832000
                                                                        05834000
Side effects:                                                           05836000
     The  dbxdsinfo word of the  current process control block          05838000
may be changed.                                                         05840000
                                                                        05842000
Special considerations:                                                 05844000
     Highly privileged.                                                 05846000
;                                                                       05848000
                                                                        05852000
$IF X7 = ON                                                             05854000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST"                                    05856000
logical procedure b08'init'log'dst(cb'info, size);                      05858000
                                                                        05860000
  value                            cb'info, size ;                      05862000
                                                                        05864000
  integer pointer                  cb'info       ;                      05866000
                                                                        05868000
  integer                                   size ;                      05870000
                                                                        05872000
  option privileged, uncallable                  ;                      05874000
                                                                        05876000
                                                                        05878000
                                                                        05880000
COMMENT                                                                 05882000
                                                                        05884000
  PURPOSE:                                                              05886000
                                                                        05888000
    This procedure will attempt to allocate a new XDS for log-          05890000
    ging purposes.  If successfull, it will initialize the              05892000
    head entry of the new XDS, then link the new XDS into the           05894000
    chain of logging dst's.                                             05896000
                                                                        05898000
                                                                        05900000
  INPUT PARAMETERS:                                                     05902000
                                                                        05904000
    CB'INFO, a pointer to the control block information area            05906000
      of the CIPER data segment for this ldev and level 7.              05908000
                                                                        05910000
    SIZE, which is the number of words required in the new              05912000
      logging XDS.                                                      05914000
                                                                        05916000
                                                                        05918000
  OUTPUT PARAMETERS:                                                    05920000
                                                                        05922000
    B08'INIT'LOG'DST, which is true if successful, false other-         05924000
      wise.                                                             05926000
                                                                        05928000
                                                                        05930000
  SIDE-EFFECTS:                                                         05932000
                                                                        05934000
    If allocation of the new dst is successful, the new dst             05936000
    will be linked in and be ready for use.  If not successful,         05938000
    all logging will be disabled (by setting bit 0 of event'map).       05940000
    cb'info(logging'dst) will not be updated, to retain the             05942000
    link to previous logging dst's (if any).                            05944000
                                                                        05946000
                                                                        05948000
  SPECIAL CONSIDERATIONS:                                               05950000
                                                                        05952000
    When called, DB must be set to the base of the CIPER data           05954000
    segment.                                                            05956000
                                                                        05958000
                                                                        05960000
  CHANGE HISTORY:                                                       05962000
                                                                        05964000
    As issued.                                                          05966000
                                                                        05968000
                                                                        05970000
;                                                                       05972000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST -- LOCAL DECLARATIONS"              05974000
begin                                                                   05976000
                                                                        05978000
  integer pointer                                                       05980000
                                                                        05982000
    log'buffer                                                          05984000
      << points to buffer area in CIPER data segment where  >>          05986000
      << log records may be assembled.                      >>          05988000
                                                                        05990000
  ;                                                                     05992000
                                                                        05994000
                                                                        05996000
  integer                                                               05998000
                                                                        06000000
    old'dst                                                             06002000
      << contains dst index of current log dst >>                       06004000
                                                                        06006000
   ,new'dst                                                             06008000
      << contains dst index of new log dst >>                           06010000
                                                                        06012000
  ;                                                                     06014000
                                                                        06016000
                                                                        06018000
procedure lockseg'(segident, blocked'lock);                             06020000
  value            segident, blocked'lock ;                             06022000
  integer          segident               ;                             06024000
  logical                    blocked'lock ;                             06026000
  option external, privileged, uncallable;                              06028000
                                                                        06030000
procedure unlockseg'(segident);                                         06032000
  value              segident ;                                         06034000
  integer            segident ;                                         06036000
  option external, privileged, uncallable;                              06038000
                                                                        06040000
  declare'move'from'data'segment;                                       06042000
                                                                        06044000
  declare'move'to'data'segment;                                         06046000
                                                                        06048000
$PAGE "LOGGING UTILITIES:  USER SUBROUTINES"                            06050000
logical subroutine get'log'buffer(log'buffer);                          06052000
                                                                        06054000
  value                           log'buffer ;                          06056000
                                                                        06058000
  integer pointer                 log'buffer ;                          06060000
                                                                        06062000
COMMENT                                                                 06064000
                                                                        06066000
  PURPOSE:                                                              06068000
                                                                        06070000
    This subroutine will return the address of the logging              06072000
    buffer in the CIPER data segment.                                   06074000
                                                                        06076000
                                                                        06078000
  INPUT PARAMETERS:                                                     06080000
                                                                        06082000
    LOG'BUFFER, which is a dummy parameter used solely as               06084000
      a scratch variable.                                               06086000
                                                                        06088000
                                                                        06090000
  OUTPUT PARAMETERS:                                                    06092000
                                                                        06094000
    GET'LOG'BUFFER, which returns a DB relative address to              06096000
      the logging buffer.                                               06098000
                                                                        06100000
                                                                        06102000
  SIDE-EFFECTS:                                                         06104000
                                                                        06106000
    None.                                                               06108000
                                                                        06110000
                                                                        06112000
  SPECIAL CONSIDERATIONS:                                               06114000
                                                                        06116000
    None.                                                               06118000
                                                                        06120000
                                                                        06122000
  CHANGE HISTORY:                                                       06124000
                                                                        06126000
    As issued.                                                          06128000
                                                                        06130000
;                                                                       06132000
                                                                        06134000
begin                                                                   06136000
                                                                        06138000
  @log'buffer := cb'info(logging'buffer)                                06140000
               + cb'info(cds'area'base);                                06142000
  get'log'buffer := @log'buffer + log'buffer;                           06144000
                                                                        06146000
end;                                                                    06148000
                                                                        06150000
$PAGE                                                                   06152000
subroutine get'head'entry(log'buffer);                                  06154000
                                                                        06156000
  value                   log'buffer ;                                  06158000
                                                                        06160000
  integer pointer         log'buffer ;                                  06162000
                                                                        06164000
COMMENT                                                                 06166000
                                                                        06168000
  PURPOSE:                                                              06170000
                                                                        06172000
    This subroutine will move the head entry from the current           06174000
    logging dst into the base of the logging buffer in the              06176000
    CIPER data segment.                                                 06178000
                                                                        06180000
                                                                        06182000
  INPUT PARAMETERS:                                                     06184000
                                                                        06186000
    LOG'BUFFER, which points to the logging buffer in the               06188000
      CIPER data segment.                                               06190000
                                                                        06192000
                                                                        06194000
  OUTPUT PARAMETERS:                                                    06196000
                                                                        06198000
    None.                                                               06200000
                                                                        06202000
                                                                        06204000
  SIDE-EFFECTS:                                                         06206000
                                                                        06208000
    None.                                                               06210000
                                                                        06212000
                                                                        06214000
  SPECIAL CONSIDERATIONS:                                               06216000
                                                                        06218000
    None.                                                               06220000
                                                                        06222000
  CHANGE HISTORY:                                                       06224000
                                                                        06226000
    As issued.                                                          06228000
                                                                        06230000
;                                                                       06232000
                                                                        06234000
begin                                                                   06236000
                                                                        06238000
  @log'buffer := cb'info(logging'buffer)                                06240000
               + cb'info(cds'area'base);                                06242000
  mfds(log'buffer,cb'info(logging'dst),0,1);                            06244000
  mfds(log'buffer(1),cb'info(logging'dst),1,log'buffer-1);              06246000
                                                                        06248000
end;                                                                    06250000
                                                                        06252000
$PAGE                                                                   06254000
subroutine put'head'entry(log'buffer);                                  06256000
                                                                        06258000
  value                   log'buffer ;                                  06260000
                                                                        06262000
  integer pointer         log'buffer ;                                  06264000
                                                                        06266000
COMMENT                                                                 06268000
                                                                        06270000
  PURPOSE:                                                              06272000
                                                                        06274000
    This subroutine will move the head entry from the logging           06276000
    buffer of the CIPER data segment into the base of the               06278000
    current logging dst.                                                06280000
                                                                        06282000
                                                                        06284000
  INPUT PARAMETERS:                                                     06286000
                                                                        06288000
    LOG'BUFFER, which points to the logging buffer in the               06290000
      CIPER data segment.                                               06292000
                                                                        06294000
                                                                        06296000
  OUTPUT PARAMETERS:                                                    06298000
                                                                        06300000
    None.                                                               06302000
                                                                        06304000
                                                                        06306000
  SIDE-EFFECTS:                                                         06308000
                                                                        06310000
    None.                                                               06312000
                                                                        06314000
                                                                        06316000
  SPECIAL CONSIDERATIONS:                                               06318000
                                                                        06320000
    None.                                                               06322000
                                                                        06324000
  CHANGE HISTORY:                                                       06326000
                                                                        06328000
    As issued.                                                          06330000
                                                                        06332000
;                                                                       06334000
                                                                        06336000
begin                                                                   06338000
                                                                        06340000
  @log'buffer := cb'info(logging'buffer)                                06342000
               + cb'info(cds'area'base);                                06344000
  mtds(cb'info(logging'dst),0,log'buffer,log'buffer);                   06346000
                                                                        06348000
end;                                                                    06350000
                                                                        06352000
$PAGE                                                                   06354000
subroutine put'log'entry(log'buffer);                                   06356000
                                                                        06358000
  value                  log'buffer ;                                   06360000
                                                                        06362000
  integer pointer        log'buffer ;                                   06364000
                                                                        06366000
COMMENT                                                                 06368000
                                                                        06370000
  PURPOSE:                                                              06372000
                                                                        06374000
    This subroutine will move information from the logging              06376000
    buffer of the CIPER data segment to the next available              06378000
    location in the current logging dst.                                06380000
                                                                        06382000
                                                                        06384000
  INPUT PARAMETERS:                                                     06386000
                                                                        06388000
    LOG'BUFFER, which points to the logging buffer in the               06390000
      CIPER data segment.                                               06392000
                                                                        06394000
                                                                        06396000
  OUTPUT PARAMETERS:                                                    06398000
                                                                        06400000
    None.                                                               06402000
                                                                        06404000
                                                                        06406000
  SIDE-EFFECTS:                                                         06408000
                                                                        06410000
    Can cause a new logging data segment to be allocated,               06412000
    linking the new and old together in a linked list.                  06414000
                                                                        06416000
                                                                        06418000
  SPECIAL CONSIDERATIONS:                                               06420000
                                                                        06422000
    None.                                                               06424000
                                                                        06426000
  CHANGE HISTORY:                                                       06428000
                                                                        06430000
    As issued.                                                          06432000
                                                                        06434000
;                                                                       06436000
                                                                        06438000
begin                                                                   06440000
                                                                        06442000
  if ( log'buffer(he'next'word) + log'buffer(log'entry'length) )        06444000
     > log'buffer(he'last'word) then                                    06446000
    begin                                                               06448000
      if not b08'init'log'dst(cb'info,log'dst'size) then return;        06450000
    end;                                                                06452000
                                                                        06454000
  mtds(cb'info(logging'dst),log'buffer(he'next'word),log'buffer,        06456000
       log'buffer(log'entry'length));                                   06458000
                                                                        06460000
  log'buffer(he'next'word) := log'buffer(he'next'word)                  06462000
                         + log'buffer(log'entry'length);                06464000
                                                                        06466000
end;                                                                    06468000
$PAGE                                                                   06470000
logical subroutine event'enabled(event);                                06472000
                                                                        06474000
  value                          event ;                                06476000
                                                                        06478000
  integer                        event ;                                06480000
                                                                        06482000
                                                                        06484000
COMMENT                                                                 06486000
                                                                        06488000
  PURPOSE:                                                              06490000
                                                                        06492000
    This subroutine will check the event map of cb'info to de-          06494000
    termine if logging has been enabled for this event.  If it          06496000
    has, the routine will return true.  False is returned               06498000
    otherwise.                                                          06500000
                                                                        06502000
                                                                        06504000
  INPUT PARAMETERS:                                                     06506000
                                                                        06508000
    EVENT, which indicates the event to check.  Valid events            06510000
      range from 1 to 15 (will be expanded later).  Any other           06512000
      value produces an immediate return.                               06514000
                                                                        06516000
                                                                        06518000
  OUTPUT PARAMETERS:                                                    06520000
                                                                        06522000
    EVENT'ENABLED, which is the function return of the subrou-          06524000
      tine.  If the particular event has been enabled, a value          06526000
      of true is returned.  Otherwise, a value of false is re-          06528000
      turned.                                                           06530000
                                                                        06532000
                                                                        06534000
  SIDE-EFFECTS:                                                         06536000
                                                                        06538000
    None.                                                               06540000
                                                                        06542000
                                                                        06544000
  SPECIAL CONSIDERATIONS:                                               06546000
                                                                        06548000
    None.                                                               06550000
                                                                        06552000
                                                                        06554000
  CHANGE HISTORY:                                                       06556000
                                                                        06558000
                                                                        06560000
                                                                        06562000
                                                                        06564000
;                                                                       06566000
begin                                                                   06568000
                                                                        06570000
  if event <= 0 or event > 15 then                                      06572000
    begin                                                               06574000
      event'enabled := false;                                           06576000
    end                                                                 06578000
  else                                                                  06580000
    begin                                                               06582000
      x := event;                                                       06584000
      event := %40000;                                                  06586000
      while dxbz do event := event & csr(1);                            06588000
      event := integer( logical( event ) lor %100000 );                 06590000
      event'enabled := integer                                          06592000
        (logical( cb'info(event'map) ) land logical( event ) )          06594000
        > 0;                                                            06596000
    end;                                                                06598000
                                                                        06600000
end; << of subroutine event'enabled >>                                  06602000
                                                                        06604000
                                                                        06606000
$PAGE "PROCEDURE:  B08'INIT'LOG'DST -- PROCEDURE BODY"                  06608000
  << First, try to get a new data segment, initialized to >>            06610000
  << all zeros.                                           >>            06612000
                                                                        06614000
  new'dst := getdatasegc(size,size);                                    06616000
  if <> then                                                            06618000
    begin                                                               06620000
      cb'info(event'map) := integer                                     06622000
         ( logical( cb'info(event'map) ) lor %100000 );                 06624000
      b08'init'log'dst := false;                                        06626000
      return;                                                           06628000
    end;                                                                06630000
                                                                        06632000
                                                                        06634000
  << Lock down the new dst so it won't get swapped out of >>            06636000
  << core (for logging speed).                            >>            06638000
                                                                        06640000
  lockseg'(new'dst,false);  << lock but don't freeze >>                 06642000
                                                                        06644000
                                                                        06646000
  << We got a dst, so set up the pointer to the logging  >>             06648000
  << buffer.                                             >>             06650000
                                                                        06652000
  @log'buffer := get'log'buffer(log'buffer);                            06654000
                                                                        06656000
                                                                        06658000
  << If this is the first dst allocated, there is no back >>            06660000
  << links to save, so set old'dst to a null value        >>            06662000
                                                                        06664000
  if cb'info(logging'dst) = nul'dseg then                               06666000
    begin                                                               06668000
      << No previous dst to save >>                                     06670000
      old'dst := nul'dseg;                                              06672000
    end                                                                 06674000
  else                                                                  06676000
    begin                                                               06678000
      << Save link to old dst >>                                        06680000
      old'dst := cb'info(logging'dst);                                  06682000
      log'buffer(he'next'dst) := new'dst;                               06684000
      put'head'entry(log'buffer);                                       06686000
    end;                                                                06688000
                                                                        06690000
                                                                        06692000
  << Now set up the info for the head entry of the new dst >>           06694000
                                                                        06696000
  cb'info(logging'dst) := new'dst;                                      06698000
  log'buffer(he'length) := head'entry'length;                           06700000
  log'buffer(he'type) := head'entry'type;                               06702000
  log'buffer(he'ldev) := cb'info(logical'device);                       06704000
  log'buffer(he'next'word) := head'entry'length;                        06706000
  log'buffer(he'last'word) := size - 1;                                 06708000
  log'buffer(he'previous'dst) := old'dst;                               06710000
  log'buffer(he'next'dst) := nul'dseg;                                  06712000
                                                                        06714000
                                                                        06716000
  << Save the new head entry in the new data segment >>                 06718000
                                                                        06720000
  put'head'entry(log'buffer);                                           06722000
                                                                        06724000
                                                                        06726000
  << If there was an old dst, unlock it so it can be swapped >>         06728000
  << out of core to make room for other things.              >>         06730000
                                                                        06732000
  if old'dst <> nul'dseg then                                           06734000
    begin                                                               06736000
      unlockseg'(old'dst);                                              06738000
    end;                                                                06740000
                                                                        06742000
                                                                        06744000
  << Set completion true and return >>                                  06746000
                                                                        06748000
  b08'init'log'dst := true;                                             06750000
                                                                        06752000
                                                                        06754000
  << All done >>                                                        06756000
                                                                        06758000
end;  << of procedure b08'init'log'dst >>                               06760000
                                                                        06762000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING"                                  06764000
integer procedure b08'enable'logging(cb'info, event);                   06766000
                                                                        06768000
  value                              cb'info, event ;                   06770000
                                                                        06772000
  logical pointer                    cb'info        ;                   06774000
                                                                        06776000
  integer                                     event ;                   06778000
                                                                        06780000
  option privileged, uncallable;                                        06782000
                                                                        06784000
                                                                        06786000
COMMENT                                                                 06788000
                                                                        06790000
  PURPOSE:                                                              06792000
                                                                        06794000
    This procedure is called to enable logging of up to sixteen         06796000
    types of events.  The procedure is called with a event type         06798000
    number, which logging is to be enabled for.  In addition,           06800000
    if no logging XDS exists, one will be allocated and init-           06802000
    ialized.  The data segment number of the logging XDS is             06804000
    saved in cb'info(logging'dst).                                      06806000
                                                                        06808000
                                                                        06810000
  INPUT PARAMETERS:                                                     06812000
                                                                        06814000
    CB'INFO, which is a pointer to the control block informa-           06816000
      tion area of the logical driver.  This area contains              06818000
      the dst number of the logging dst, as well as a bit map           06820000
      describing which events to log.                                   06822000
                                                                        06824000
    EVENT, which is an integer in the range of 0 through                06826000
      max'event'number and specifies which event(s) to enable.          06828000
      If zero is passed, all events will be enabled.                    06830000
                                                                        06832000
                                                                        06834000
  OUTPUT PARAMETERS:                                                    06836000
                                                                        06838000
    B08'ENABLE'LOGGING, which is the completion status of the           06840000
      procedure call.  If logging was successfully enabled, a           06842000
      value of one is returned.  If logging could not be enabled,       06844000
      (due to unavailability of an XDS) a value other than one          06846000
      will be returned.                                                 06848000
                                                                        06850000
                                                                        06852000
  SIDE-EFFECTS:                                                         06854000
                                                                        06856000
    One or more XDS's may be allocated in a linked fashion.             06858000
    Certain words of cb'info will updated.                              06860000
                                                                        06862000
                                                                        06864000
  SPECIAL CONSIDERATIONS:                                               06866000
                                                                        06868000
    None.                                                               06870000
                                                                        06872000
                                                                        06874000
  CHANGE HISTORY:                                                       06876000
                                                                        06878000
    As issued.                                                          06880000
                                                                        06882000
                                                                        06884000
;                                                                       06886000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING -- LOCAL DECLARATIONS"            06888000
begin                                                                   06890000
                                                                        06892000
  << Declaration of local variables >>                                  06894000
                                                                        06896000
  logical                                                               06898000
                                                                        06900000
    bit'mask                                                            06902000
      << Used to generate mask of which event(s) to enable >>           06904000
                                                                        06906000
  ;                                                                     06908000
$PAGE "PROCEDURE:  B08'ENABLE'LOGGING -- PROCEDURE BODY"                06910000
  << First, see if there is a logging data segment.  If not, >>         06912000
  << try to obtain one from the system.                      >>         06914000
                                                                        06916000
  if cb'info(logging'dst) = nul'dseg then                               06918000
    begin                                                               06920000
      << No logging dst, try to allocate one. >>                        06922000
                                                                        06924000
      if b08'init'log'dst(cb'info,log'dst'size) then                    06926000
        begin                                                           06928000
          cb'info(event'map) := cb'info(event'map) land %77777;         06930000
        end                                                             06932000
      else                                                              06934000
        begin                                                           06936000
          cb'info(event'map) := cb'info(event'map) lor %100000;         06938000
        end;                                                            06940000
    end;                                                                06942000
                                                                        06944000
  << Now we have (or already had) a logging data segment. >>            06946000
  << Convert the event parameter into a bit map, then "or" >>           06948000
  << that map into the event'map of cb'info.               >>           06950000
                                                                        06952000
  if event < 0 then event := -event;                                    06954000
  if event = 0 then                                                     06956000
    begin                                                               06958000
      bit'mask := %77777;                                               06960000
    end                                                                 06962000
  else                                                                  06964000
    begin                                                               06966000
      bit'mask := %40000 & csr(event - 1);                     <<04434>>06970000
    end;                                                                06972000
                                                                        06974000
  cb'info(event'map) := cb'info(event'map) lor bit'mask;                06976000
                                                                        06978000
  << All done!! >>                                                      06980000
                                                                        06982000
end;                                                                    06984000
                                                                        06986000
                                                                        06988000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING"                                 06990000
                                                                        06992000
logical procedure b08'disable'logging(cb'info, event);                  06994000
                                                                        06996000
  value                               cb'info, event ;                  06998000
                                                                        07000000
  logical pointer                     cb'info        ;                  07002000
                                                                        07004000
  integer                                      event ;                  07006000
                                                                        07008000
  option privileged, uncallable;                                        07010000
                                                                        07012000
                                                                        07014000
COMMENT                                                                 07016000
                                                                        07018000
  PURPOSE:                                                              07020000
                                                                        07022000
    This procedure will disable one (or all) events from being          07024000
    logged.  It will not release the logging XDS, if any are            07026000
    allocated.                                                          07028000
                                                                        07030000
                                                                        07032000
  INPUT PARAMETERS:                                                     07034000
                                                                        07036000
    CB'INFO, which is a pointer to the control block informa-           07038000
      tion area of the logical driver.  This area contains the          07040000
      event'map, which describes which events are to be logged.         07042000
                                                                        07044000
    EVENT, which is an integer describing the event for which           07046000
      logging is to be disabled.  If zero, all events will be           07048000
      disabled.  Negative values are treated the same as posi-          07050000
      tive, i.e. 5 or -5 will cause event 5 to be disabled.             07052000
                                                                        07054000
                                                                        07056000
  OUTPUT PARAMETERS:                                                    07058000
                                                                        07060000
    None.                                                               07062000
                                                                        07064000
                                                                        07066000
  SIDE-EFFECTS:                                                         07068000
                                                                        07070000
    Event'map of cb'info will be modified appropriately.                07072000
                                                                        07074000
                                                                        07076000
  SPECIAL CONSIDERATIONS:                                               07078000
                                                                        07080000
    When called, DB must be set to the base of the CIPER data           07082000
    segment.                                                            07084000
                                                                        07086000
                                                                        07088000
  CHANGE HISTORY:                                                       07090000
                                                                        07092000
    As issued.                                                          07094000
                                                                        07096000
                                                                        07098000
;                                                                       07100000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING -- LOCAL DECLARATIONS"           07102000
begin                                                                   07104000
                                                                        07106000
  logical                                                               07108000
                                                                        07110000
    bit'mask                                                            07112000
      << Mask generated to turn appropriate logging bits off >>         07114000
                                                                        07116000
  ;                                                                     07118000
                                                                        07120000
$PAGE "PROCEDURE:  B08'DISABLE'LOGGING -- PROCEDURE BODY"               07122000
  << If the event number is negative, make it positive. >>              07124000
                                                                        07126000
  if event < 0 then event := -event;                                    07128000
                                                                        07130000
                                                                        07132000
  << Now determine if all events or just one are to be dis- >>          07134000
  << abled, and generate the appropriate bit'mask.          >>          07136000
                                                                        07138000
  if event = 0 then                                                     07140000
    begin                                                               07142000
      bit'mask := %100000;                                              07144000
    end                                                                 07146000
  else                                                                  07148000
    begin                                                               07150000
      bit'mask := %137777 & csr(event - 1);                    <<04434>>07154000
    end;                                                                07156000
                                                                        07158000
                                                                        07160000
  << Now "and" the zero'ed bits into the enable'map of  >>              07162000
  << cb'info.                                           >>              07164000
                                                                        07166000
  cb'info(event'map) := cb'info(event'map) land bit'mask;               07168000
                                                                        07170000
                                                                        07172000
  << All done!! >>                                                      07174000
                                                                        07176000
end;  << of procedure b08'disable'logging >>                            07178000
$IF                                                                     07180000
                                                                        07182000
  <<ciper forward procedure declarations>>                              07184000
$PAGE "FORWARD PROCEDURES"                                              07186000
                                                                        07188000
integer procedure b08'device'clear(cb'info, dev'clear'parm);            07190000
                                                                        07192000
  value                            cb'info, dev'clear'parm ;            07194000
                                                                        07196000
  integer pointer                  cb'info                 ;            07198000
                                                                        07200000
  integer                                   dev'clear'parm ;            07202000
                                                                        07204000
  option forward;                                                       07206000
                                                                        07208000
                                                                        07210000
                                                                        07212000
  <<ASCII translation routine>>                                         07214000
$PAGE "PROCEDURE:  B08'ASCII"                                           07216000
integer procedure b08'ascii(word, base, string);                        07218000
                                                                        07220000
  value                     word, base, string ;                        07222000
                                                                        07224000
  integer                   word, base         ;                        07226000
                                                                        07228000
  byte pointer                          string ;                        07230000
                                                                        07232000
  option privileged, uncallable                ;                        07234000
                                                                        07236000
                                                                        07238000
COMMENT                                                                 07240000
                                                                        07242000
  PURPOSE:                                                              07244000
                                                                        07246000
    This procedure performs a binary to ASCII conversion.  It           07248000
    operation is similar to the intrinsic 'ascii.'  The only            07250000
    reason for not using the intrinsic is the fact that the             07252000
    intrinsic cannot be called split-stack.                             07254000
                                                                        07256000
                                                                        07258000
  INPUT PARAMETERS:                                                     07260000
                                                                        07262000
    WORD, which is the 16 bit binary value to be converted.             07264000
                                                                        07266000
    BASE, which indicates the conversion base.  Valid inputs            07268000
      are:                                                              07270000
            8, which specifies convert to octal,                        07272000
           10, which specifies decimal conversion, left jus-            07274000
               tified, or                                               07276000
          -10, which specifies decimal conversion, right jus-           07278000
               tified.                                                  07280000
                                                                        07282000
    STRING, which is a byte pointer to the area where the               07284000
      converted string is to be built.  It must be large enough         07286000
      to contain the largest number to be converted.                    07288000
                                                                        07290000
                                                                        07292000
  OUTPUT PARAMETERS:                                                    07294000
                                                                        07296000
    B08'ASCII, which returns the character count of the                 07298000
      string returned.                                                  07300000
                                                                        07302000
                                                                        07304000
  SIDE-EFFECTS:                                                         07306000
                                                                        07308000
    None.                                                               07310000
                                                                        07312000
                                                                        07314000
  SPECIAL CONSIDERATIONS:                                               07316000
                                                                        07318000
    None.                                                               07320000
                                                                        07322000
                                                                        07324000
  CHANGE HISTORY:                                                       07326000
                                                                        07328000
    As issued.                                                          07330000
                                                                        07332000
;                                                                       07334000
                                                                        07336000
$PAGE "PROCEDURE:  B08'ASCII -- LOCAL DECLARATIONS"                     07338000
                                                                        07340000
begin                                                                   07342000
                                                                        07344000
  integer                                                               07346000
    count                                                               07348000
   ,x                             = x                                   07350000
  ;                                                                     07352000
                                                                        07354000
  logical                                                               07356000
    negative'flag                 := false                              07358000
  ;                                                                     07360000
                                                                        07362000
                                                                        07364000
$PAGE "PROCEDURE:  B08'ASCII -- PROCEDURE BODY"                         07366000
  if base = 8 then                                                      07368000
    begin                                                               07370000
      x := 5;                                                           07372000
      do                                                                07374000
        begin                                                           07376000
          string(x) := word.(13:3) + %60;                               07378000
          word := word & lsr(3);                                        07380000
          x := x - 1                                                    07382000
        end                                                             07384000
      until x < 0;                                                      07386000
                                                                        07388000
      count := 6;                                                       07390000
    end                                                                 07392000
  else                                                                  07394000
    begin                                                               07396000
      << check for positive or negative >>                              07398000
      if word < 0 then                                                  07400000
        begin                                                           07402000
          negative'flag := true;                                        07404000
          word := -word;                                                07406000
        end;                                                            07408000
      x := 5;                                                           07410000
      do                                                                07412000
        begin                                                           07414000
          << parse out digits until word = 0 >>                         07416000
                                                                        07418000
          string(x) := (word mod 10) + %60;                             07420000
          word := word / 10;                                            07422000
          x := x - 1;                                                   07424000
        end                                                             07426000
      until word = 0;                                                   07428000
                                                                        07430000
      if negative'flag then                                             07432000
        begin                                                           07434000
          string(x) := "-";                                             07436000
          x := x - 1;                                                   07438000
        end;                                                            07440000
                                                                        07442000
                                                                        07444000
      count := 5 - x;                                                   07446000
                                                                        07448000
      if count < 6 then                                                 07450000
        if base < 0 then                                                07452000
          begin                                                         07454000
            << number is to be right justified, so fill with >>         07456000
            << leading blanks.                               >>         07458000
                                                                        07460000
            string := " ";                                              07462000
            if 6 - count > 1 then                                       07464000
              begin                                                     07466000
                << Blank out any additional bytes with move >>          07468000
                << statement, now that first byte is blank. >>          07470000
                                                                        07472000
                move string(1) := string,(5-count);                     07474000
              end;                                                      07476000
          end                                                           07478000
        else                                                            07480000
          begin                                                         07482000
            << must move up to left justify >>                          07484000
                                                                        07486000
            move string := string(x+1),(count);                         07488000
          end;                                                          07490000
    end;                                                                07492000
                                                                        07494000
  b08'ascii := count;                                                   07496000
                                                                        07498000
                                                                        07500000
end;  << procedure b08'ascii >>                                         07502000
                                                                        07504000
$PAGE "CIPER GEN MESSAGE"                                               07506000
INTEGER PROCEDURE Cpr'genmsg(setno, msgno, mask, parm1, parm2,          07508000
                              parm3, parm4, parm5, dest, reply,         07510000
                               offset, dst, control             );      07512000
                                                                        07514000
value                        setno, msgno, mask, parm1, parm2,          07516000
                              parm3, parm4, parm5, dest, reply,         07518000
                               offset, dst, control              ;      07520000
                                                                        07522000
integer                      setno, msgno,                              07524000
                                                   dest,                07526000
                                       dst                       ;      07528000
                                                                        07530000
logical                                    mask, parm1, parm2,          07532000
                               parm3, parm4, parm5,      reply,         07534000
                                offset,      control             ;      07536000
                                                                        07538000
option privileged, variable, uncallable                            ;    07540000
                                                                        07542000
begin                                                                   07544000
                                                                        07546000
logical array                                                           07548000
       qm18(*)        =q-18                                             07550000
;                                                                       07552000
                                                                        07554000
                                                                        07556000
double dseg    ;                                                        07558000
                                                                        07560000
                                                                        07562000
                                                                        07564000
INTEGER PROCEDURE    iomessage(setno, msgno, mask, parm1, parm2,        07566000
                                parm3, parm4, parm5, dest, reply,       07568000
                                 offset, dst, control             );    07570000
                                                                        07572000
value                          setno, msgno, mask, parm1, parm2,        07574000
                                parm3, parm4, parm5, dest, reply,       07576000
                                 offset, dst, control              ;    07578000
                                                                        07580000
integer                        setno, msgno,                            07582000
                                                     dest,              07584000
                                         dst                       ;    07586000
                                                                        07588000
logical                                      mask, parm1, parm2,        07590000
                                 parm3, parm4, parm5,      reply,       07592000
                                  offset,      control             ;    07594000
                                                                        07596000
option external, privileged, variable, uncallable                  ;    07598000
                                                                        07600000
<< change db to sys db so iomessage can run >>                          07602000
                                                                        07604000
dseg := changedb(512D) ; << get on sys stack for message >>             07606000
                                                                        07608000
                                                                        07610000
                                                                        07612000
<< now move the parameter list in for the call to iomessage >>          07614000
                                                                        07616000
x := 0;                                                                 07618000
do                                                                      07620000
 begin                                                                  07622000
  TOS:=qm18(x);                                                         07624000
  x:=x+1;                                                               07626000
 end until x=15;                                                        07628000
                                                                        07630000
<< call iomessage with the parameter list >>                            07632000
                                                                        07634000
assemble (PCAL iomessage);                                              07636000
                                                                        07638000
<< set up the return value >>                                           07640000
                                                                        07642000
cpr'genmsg := TOS;  <<save the return value>>                           07644000
                                                                        07646000
<< get the user data segment back >>                                    07648000
                                                                        07650000
changedb(dseg) ; << get back on calling stack >>                        07652000
                                                                        07654000
<< we're all through for this time >>                                   07656000
                                                                        07658000
end;                                                                    07660000
                                                                        07662000
                                                                        07664000
                                                                        07666000
  <<general Ciper Data Segment (cds) error reporting and                07668000
       debugging routines>>                                             07670000
$PAGE "PROCEDURE:  CPR'SHUTDOWN"                                        07672000
procedure cpr'shutdown( error'number );                                 07674000
                                                                        07676000
  value                 error'number  ;                                 07678000
                                                                        07680000
  integer               error'number  ;                                 07682000
                                                                        07684000
  option privileged, uncallable       ;                                 07686000
                                                                        07688000
                                                                        07690000
COMMENT                                                                 07692000
                                                                        07694000
  PURPOSE:                                                              07696000
                                                                        07698000
    This procedure will mark the ldtx entry for the current             07700000
    ldev such that any other calls to this ldev will be re-             07702000
    jected.  This is done whenever (if ever) an integrity error         07704000
    is detected in the CIPER data segment.  If this is the              07706000
    first call to this procedure, a console message will be             07708000
    issued.                                                             07710000
                                                                        07712000
    Since cpr'shutdown may be called anywhere by CIPER pro-             07714000
    cedures that may not have the ldev number handy, the stack          07716000
    marker chain is followed until the call from ATTACHIO is            07718000
    found.  The ldev number is picked off the stack at that             07720000
    point.                                                              07722000
                                                                        07724000
                                                                        07726000
  INPUTS:                                                               07728000
                                                                        07730000
    ERROR'NUMBER, which is an internal error code indicating            07732000
      the source of the caller and type of error condition.             07734000
      If a console message is generated, this code will be a            07736000
      part of that message.                                             07738000
                                                                        07740000
                                                                        07742000
  OUTPUT PARAMETERS:                                                    07744000
                                                                        07746000
    None.                                                               07748000
                                                                        07750000
                                                                        07752000
  SIDE-EFFECTS:                                                         07754000
                                                                        07756000
    The ldtx'CPR'is'shutdown bit will be set in the ldtx entry          07758000
    for the appropriate CIPER ldev.                                     07760000
                                                                        07762000
    There are two cases where suddendeaths may occur.  One is           07764000
    if we cannot find the ldev numbers at all in the stack,             07766000
    probably because some of the stack markers have been cor-           07768000
    rupted.  The other reason is if we can find both places             07770000
    where the ldev number is, but the two numbers don't match.          07772000
                                                                        07774000
                                                                        07776000
  SPECIAL CONSIDERATIONS:                                               07778000
                                                                        07780000
    This procedure is written with three underlying assump-             07782000
    tions:                                                              07784000
                                                                        07786000
    a)  That all CIPER procedures reside in the same code               07788000
        segment.  This allows the stack walk-back to detect             07790000
        Attachio's stack marker.                                        07792000
                                                                        07794000
    b)  The ldev parameter to Attachio and B08'logical'dvr              07796000
        is always the first of nine parameters.                         07798000
                                                                        07800000
    c)  That the Q+1 to Q+4 area of B08'logical'dvr exactly             07802000
        matches the same area of Cpr'shutdown.  Cpr'shutdown            07804000
        expects to drop Q back to b08'logical'dvr's stack and           07806000
        use the information in the Q+1 to Q+4 area.                     07808000
                                                                        07810000
                                                                        07812000
  CHANGE HISTORY:                                                       07814000
                                                                        07816000
    As issued.                                                          07818000
                                                                        07820000
                                                                        07822000
;                                                                       07824000
$PAGE "PROCEDURE:  CPR'SHUTDOWN -- LOCAL VARIABLES"                     07826000
begin                                                                   07828000
                                                                        07830000
  << NOTE:  The following three variables MUST remain at >>             07832000
  << Q+1 through Q+4, or at least be consistent with the >>             07834000
  << b08'logical'dvr declarations.                       >>             07836000
                                                                        07838000
  << These variables are only used after the Q register  >>             07840000
  << has been set back at the base of b08'logical'dvr's  >>             07842000
  << stack.  This information is used to clean up and    >>             07844000
  << exit out through the tail end of b08'logical'dvr.   >>             07846000
                                                                        07848000
                                                                        07850000
  logical                                                               07852000
                                                                        07854000
    ldvr'exit'label'saved                                               07856000
      << Label on b08'logical'dvr stack that is exit address >>         07858000
                                                                        07860000
  ;                                                                     07862000
                                                                        07864000
                                                                        07866000
  double                                                                07868000
                                                                        07870000
    ldvr'callers'db                                                     07872000
      << Place to store where we were when we go to the >>              07874000
      << callers stack.                                 >>              07876000
  ;                                                                     07878000
                                                                        07880000
                                                                        07882000
  logical pointer                                                       07884000
                                                                        07886000
    ldvr'control'table                                                  07888000
      << pointer on b08'logical'dvr stack that must be set >>           07890000
      << to nil before exiting.                            >>           07892000
                                                                        07894000
  ;                                                                     07896000
                                                                        07898000
                                                                        07900000
  integer                                                               07902000
                                                                        07904000
    return'status                 = q-14                                07906000
      << return status of b08'logical'dvr stack >>                      07908000
                                                                        07910000
  ;                                                                     07912000
                                                                        07914000
$PAGE                                                                   07916000
  logical                                                               07918000
                                                                        07920000
    stack'marker'saved                                                  07922000
      << Saves the address of the Attachio stack marker. >>             07924000
                                                                        07926000
  ;                                                                     07928000
                                                                        07930000
                                                                        07932000
  logical pointer                                                       07934000
                                                                        07936000
    ldt0                                                                07938000
      << table pointer for zero'th entry of ldt >>                      07940000
                                                                        07942000
   ,ldtx                                                                07944000
      << table pointer for ldtx entry >>                                07946000
                                                                        07948000
   ;                                                                    07950000
                                                                        07952000
                                                                        07954000
  integer pointer                                                       07956000
                                                                        07958000
    stack'marker                                                        07960000
      << Used for indexing information out of the stack >>              07962000
                                                                        07964000
  ;                                                                     07966000
                                                                        07968000
                                                                        07970000
  integer                                                               07972000
                                                                        07974000
    logical'device                                                      07976000
      << device number of CIPER device to shutdown >>                   07978000
                                                                        07980000
   ,our'cst                                                             07982000
      << Saves the code segment we are in so we may look  >>            07984000
      << for a different segment number in the stack      >>            07986000
      << marker trace                                     >>            07988000
                                                                        07990000
                                                                        07992000
  ;                                                                     07994000
                                                                        07996000
                                                                        07998000
  define                                                                08000000
                                                                        08002000
    s'm'delta'Q                   = 0 #                                 08004000
      << stack marker word containing delta-Q to next >>                08006000
      << marker.                                      >>                08008000
                                                                        08010000
   ,s'm'cst'number                = -1).(8:8 #                          08012000
      << portion of stack marker which contains the cst >>              08014000
      << number of the procedure which made the pcal.   >>              08016000
                                                                        08018000
   ,ldev'parameter                = -12 #                               08020000
      << location of the ldev parameter of ATTACHIO and >>              08022000
      << b08'logical'dvr relative to their pcal stack   >>              08024000
      << markers.                                       >>              08026000
                                                                        08028000
  ;                                                                     08030000
                                                                        08032000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            08034000
equate                                                                  08036000
       table'entry'data    = 0                                          08038000
      ,table'entry'size    = -1 + table'entry'data                      08040000
      ,table'status        = -1 + table'entry'size                      08042000
      ,table'current'entry = -1 + table'status                          08044000
      ,table'base          = -1 + table'current'entry                   08046000
      ,table'dst           = -1 + table'base                            08048000
      ,table'sir           = -1 + table'dst                             08050000
      ,table'overhead      = -table'sir                                 08052000
;                                                                       08054000
define                                                                  08056000
       table'clean         = table'status).(0:1 #                       08058000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               08060000
      ,table'auto'sir      = table'status).(1:1 #                       08062000
      ,table'getsir'save   = table'status).(2:2 #                       08064000
      ,table'type          = table'status).(13:3 #                      08066000
;                                                                       08068000
                                                                        08070000
declare'move'from'data'segment;                                         08072000
                                                                        08074000
declare'move'to'data'segment;                                           08076000
                                                                        08078000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  08080000
subroutine open'table(T, dst, base, type, sir, auto'sir);               08082000
value                    dst, base, type, sir, auto'sir ;               08084000
logical pointer       T                                 ;               08086000
integer                  dst, base, type, sir           ;               08088000
logical                                        auto'sir ;               08090000
begin                                                 <<sxit return>>   08092000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           08094000
                                                                        08096000
COMMENT                                                                 08098000
                                                                        08100000
Purpose:                                                                08102000
                                                                        08104000
Error reporting:                                                        08106000
                                                                        08108000
External references:                                                    08110000
                                                                        08112000
Input:                                                                  08114000
                                                                        08116000
Output:                                                                 08118000
                                                                        08120000
Side effects:                                                           08122000
                                                                        08124000
Special considerations:  Must be called on the user's stack.            08126000
;                                                                       08128000
                                                                        08130000
  <<make some space on the stack directly under the calling             08132000
    parameters for the table'overhead area of table T of size           08134000
    table'overhead.>>                                                   08136000
assemble(lra s-0                                                        08138000
        ;stax                                                           08140000
        ;adds table'overhead <<the amount of space needed>>             08142000
        ;lra s-0  <<destination address>>                               08144000
        ;ldxa  <<source address>>                                       08146000
        ;ldni 7 <<the negative count of the parameter                   08148000
                  list size plus the return address  >>                 08150000
        ;move                                                           08152000
);                                                                      08154000
                                                                        08156000
  <<set the address of the table>>                                      08158000
assemble(lra s-6                                                        08160000
        ;stax                                                           08162000
);                                                                      08164000
@T:=x;                                                                  08166000
                                                                        08168000
  <<initialize the table's control area>>                               08170000
T(table'sir):=sir;                                                      08172000
T(table'dst):=dst;                                                      08174000
T(table'base):=base;                                                    08176000
T(table'current'entry):=0;                                              08178000
                                                                        08180000
  << T(table'status) variable >>                                        08182000
T(table'status) := 0;                                                   08184000
T(table'clean):=true;                                                   08186000
T(table'auto'sir):=auto'sir;                                            08188000
T(table'getsir'save):=0;                                                08190000
T(table'type):=type;                                                    08192000
                                                                        08194000
  << T(table'entry'size) >>                                             08196000
case T(table'type) of                                                   08198000
case'begin                                                              08200000
  << 0 := assume that the entry size is in T(table'entry'size).>>       08202000
  ;                                                                     08204000
  << 1 := MPE I/O tables (LPDT, LDT, LDTX).  The size of the table is   08206000
    the right byte of the first word.>>                                 08208000
  begin                                                                 08210000
  mfds(T(table'entry'size), T(table'dst), T(table'base), 1);            08212000
  T(table'entry'size):=T(table'entry'size).(8:8);                       08214000
  end                                                                   08216000
  ;                                                                     08218000
  << 2 := MPE memory management tables (DST, CST, XCST, PCB).  The      08220000
    size is the second word of the table.>>                             08222000
  mfds(T(table'entry'size), T(table'dst), T(table'base)+1, 1)           08224000
  ;                                                                     08226000
case'end;                                                               08228000
                                                                        08230000
  <<make some space on the stack directly under the calling             08232000
    parameters for the table'entry'data of size                         08234000
    = table(table'entry'size).>>                                        08236000
x:=T(table'entry'size);                                                 08238000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      08240000
                the return address in x.>>                              08242000
        ;adds 0 <<add the space to the stack.>>                         08244000
        ;ldxa  <<put the return address on the stack.>>                 08246000
);                                                                      08248000
                                                                        08250000
end;  <<open'table>>                                                    08252000
                                                                        08254000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   08256000
subroutine put'entry(T);                                                08258000
value                T ;                                                08260000
logical pointer      T ;                                                08262000
begin                                                                   08264000
                                                                        08266000
COMMENT                                                                 08268000
                                                                        08270000
Special considerations:  Must be called on the user's stack.            08272000
;                                                                       08274000
                                                                        08276000
if T(table'clean) then return;                                          08278000
                                                                        08280000
T(table'clean):=true;                                                   08282000
                                                                        08284000
mtds(T(table'dst),                     <<target'dseg'num>>              08286000
                                                                        08288000
     logical(integer(T(table'base)) +  <<target'offset>>                08290000
     integer(T(table'entry'size)) *                                     08292000
     integer(T(table'current'entry))),                                  08294000
                                                                        08296000
     T,                                <<source>>                       08298000
                                                                        08300000
     T(table'entry'size)               <<word'cnt>> );                  08302000
                                                                        08304000
if T(table'auto'sir) then                                               08306000
  relsir(T(table'sir), T(table'getsir'save));                           08308000
                                                                        08310000
end;  <<put'entry>>                                                     08312000
                                                                        08314000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   08316000
subroutine get'entry(T, index);                                         08318000
value                T, index ;                                         08320000
logical pointer      T        ;                                         08322000
integer                 index ;                                         08324000
begin                                                                   08326000
                                                                        08328000
COMMENT                                                                 08330000
                                                                        08332000
Special considerations:  Must be called on the user's stack.            08334000
;                                                                       08336000
                                                                        08338000
if not T(table'clean) then put'entry(T);                                08340000
                                                                        08342000
if T(table'auto'sir) then                                               08344000
  T(table'getsir'save):=getsir(T(table'sir));                           08346000
                                                                        08348000
mfds(T,                                <<target>>                       08350000
                                                                        08352000
     T(table'dst),                     <<source'dseg'num>>              08354000
                                                                        08356000
     logical(integer(T(table'base)) +  <<source'offset>>                08358000
     integer(T(table'entry'size)) *                                     08360000
     index),                                                            08362000
                                                                        08364000
     T(table'entry'size)               <<word'cnt>>);                   08366000
                                                                        08368000
T(table'current'entry):=index;                                          08370000
T(table'clean):=false;                                                  08372000
                                                                        08374000
end;  <<get'entry>>                                                     08376000
$PAGE "PROCEDURE:  CPR'SHUTDOWN -- PROCEDURE BODY"                      08378000
  << First, get back to the stack from where ever we are. >>            08380000
                                                                        08382000
  changeDB( 0D );                                                       08384000
                                                                        08386000
                                                                        08388000
  << Initialize the stack pointer to the current value of >>            08390000
  << the Q-register.                                      >>            08392000
                                                                        08394000
  @stack'marker := @delta'q;                                            08396000
                                                                        08398000
                                                                        08400000
  << Initialize the Code Segment numbers used for comparison >>         08402000
                                                                        08404000
  our'cst := stack'marker(s'm'cst'number);                              08406000
                                                                        08408000
                                                                        08410000
  << Now chain back down the stack until a stack marker is >>           08412000
  << found with a different CST number in it.  This will be >>          08414000
  << the ATTACHIO stack marker.                             >>          08416000
                                                                        08418000
  do                                                                    08420000
    begin                                                               08422000
                                                                        08424000
      if stack'marker(s'm'delta'Q) < 0 then suddendeath(635);           08426000
                                                                        08428000
      @stack'marker := @stack'marker                                    08430000
                     - stack'marker(s'm'delta'Q);                       08432000
                                                                        08434000
      if @stack'marker < nil then suddendeath(635);                     08436000
                                                                        08438000
    end                                                                 08440000
  until stack'marker(s'm'cst'number) <> our'cst;                        08442000
                                                                        08444000
  << When we fall through the loop, stack'marker should  >>             08446000
  << be pointing to the stack marker left by the call    >>             08448000
  << from Attachio to B08'logical'dvr.  Our copy of the  >>             08450000
  << ldev number should be twelve words below that stack >>             08452000
  << marker.                                             >>             08454000
                                                                        08456000
  << Pull the ldev number that ATTACHIO gave us. >>                     08458000
                                                                        08460000
  logical'device := stack'marker(ldev'parameter);                       08462000
                                                                        08464000
                                                                        08466000
  << Save the stack marker of Attachio >>                               08468000
                                                                        08470000
  stack'marker'saved := @stack'marker;                                  08472000
                                                                        08474000
                                                                        08476000
  << Drop stack'marker down one more marker, to the one that >>         08478000
  << was left by who ever called Attachio.  The ldev number  >>         08480000
  << that was given to Attachio will be twelve words below.  >>         08482000
  << Compare it to ours as a double check that we are going  >>         08484000
  << to shut down the correct ldev.                          >>         08486000
                                                                        08488000
  @stack'marker := @stack'marker                                        08490000
                 - stack'marker(s'm'delta'Q);                           08492000
                                                                        08494000
  if logical'device <> stack'marker(ldev'parameter) then                08496000
    begin                                                               08498000
                                                                        08500000
      suddendeath(635);                                                 08502000
                                                                        08504000
    end;                                                                08506000
                                                                        08508000
                                                                        08510000
  << We have now verified the logical device, so fix up its >>          08512000
  << ldtx entry for shutdown.                               >>          08514000
                                                                        08516000
  << Open the ldt. >>                                                   08518000
                                                                        08520000
  open'table( ldt0,                                                     08522000
              ldt'dst,                                                  08524000
              0 << base >>,                                             08526000
              1 << table type >>,                                       08528000
              ldt'sir,                                                  08530000
              false << auto'sir >>  );                                  08532000
                                                                        08534000
  << Get the head entry. >>                                             08536000
                                                                        08538000
  get'entry( ldt0, 0 );                                                 08540000
                                                                        08542000
                                                                        08544000
  << Open the ldtx. >>                                                  08546000
                                                                        08548000
  open'table( ldtx,                                                     08550000
              ldtx'dst,                                                 08552000
              ldtx'base,                                                08554000
              1, << table type >>                                       08556000
              ldtx'sir,                                                 08558000
              true << auto'sir >>  );                                   08560000
                                                                        08562000
                                                                        08564000
  << Get the entry for this ldev >>                                     08566000
                                                                        08568000
  get'entry( ldtx, logical'device );                                    08570000
                                                                        08572000
                                                                        08574000
  << If the device is not already shutdown then issue a >>              08576000
  << console message.                                   >>              08578000
                                                                        08580000
  if not ldtx(ldtx'cpr'is'shutdown) then                                08582000
    begin                                                               08584000
                                                                        08586000
      cpr'genmsg( ciper'set,                                            08588000
                  shutdown'msg,                                         08590000
                  %10000, << parm mask and types >>                     08592000
                  logical'device,                                       08594000
                  , << parm 2 >>                                        08596000
                  , << parm 3 >>                                        08598000
                  , << parm 4 >>                                        08600000
                  , << parm 5 >>                                        08602000
                  0                 );                                  08604000
                                                                        08606000
    end;                                                                08608000
                                                                        08610000
                                                                        08612000
  << Mark the ldtx entry as a ciper device that is shutdown >>          08614000
                                                                        08616000
  ldtx(ldtx'ciper'protocol) := set'bit;                                 08618000
                                                                        08620000
  ldtx(ldtx'cpr'is'shutdown) := set'bit;                                08622000
                                                                        08624000
                                                                        08626000
  << Put the modified entry back into the ldtx. >>                      08628000
                                                                        08630000
  put'entry( ldtx );                                                    08632000
                                                                        08634000
                                                                        08636000
  << Issue a device close to the transport service, so it  >>  <<04460>>08638000
  << can deallocate if necessary.  MTS, for example, can-  >>  <<04460>>08640000
  << not shut the line if there is a terminal allocated    >>  <<04460>>08642000
  << on the line.  The call is made directly to P'ATTACHIO >>  <<04460>>08644000
  << because the Level 4 control block may be inaccessible >>  <<04460>>08646000
  << as a result of the integrity error that got us here.  >>  <<04460>>08648000
  << Ignor the return status of P'ATTACHIO.                >>  <<04460>>08650000
                                                               <<04460>>08652000
  p'attachio( logical'device                                   <<04460>>08654000
             ,0 << qmisc >>                                    <<04460>>08656000
             ,0 << dst'num >>                                  <<04460>>08658000
             ,0 << address >>                                  <<04460>>08660000
             ,device'close                                     <<04460>>08662000
             ,0 << count >>                                    <<04460>>08664000
             ,0 << parm1 >>                                    <<04460>>08666000
             ,0 << parm2 >>                                    <<04460>>08668000
             ,blocked  << flags >> );                          <<04460>>08670000
                                                               <<04460>>08672000
                                                               <<04460>>08674000
  << We now have the ldev locked out so any further calls  >>           08676000
  << will be rejected.  We still need to get out of this   >>           08678000
  << request, however.  We cannot simply return to the     >>  <<04460>>08680000
  << procedure that called us, because it may not be cap-  >>           08682000
  << able of a graceful exit.  But we do need to exit thru >>           08684000
  << b08'logical'dvr so it can evaluate whether or not an  >>           08686000
  << IOQ should be returned.  To do that, we just move the >>           08688000
  << Q-register back to b08'logical'dvr's local variables, >>           08690000
  << set its control'table pointer to nil (to inhibit any  >>           08692000
  << calls to cpr'rel'ct), set up the appropriate return   >>           08694000
  << status, and jump (via an sxit instruction) to the     >>           08696000
  << exit label conveniently provided by b08'logical'dvr.  >>           08698000
                                                                        08700000
  << Force the stack back to where it was in the outer      >>          08702000
  << procedure of CIPER (b08'logical'dvr) so we can fake up >>          08704000
  << the return status, go back to the callers db, and exit >>          08706000
                                                                        08708000
  TOS := stack'marker'saved;                                            08710000
                                                                        08712000
  set(Q);                                                               08714000
                                                                        08716000
                                                                        08718000
  << Set b08'logical'dvr return status >>                               08720000
                                                                        08722000
  return'status := fatal'error;                                         08724000
                                                                        08726000
                                                                        08728000
  << Force the control'table pointer of b08'logical'dvr to >>           08730000
  << nil, so cpr'rel'ct will not get called as we exit.    >>           08732000
                                                                        08734000
  @ldvr'control'table := nil;                                           08736000
                                                                        08738000
                                                                        08740000
  << Get back to the dst that the original caller came to >>            08742000
  << us on.                                               >>            08744000
                                                                        08746000
  changedb( ldvr'callers'db );                                          08748000
                                                                        08750000
                                                                        08752000
  << Set up the exit label and get the hell out of here!! >>            08754000
                                                                        08756000
  TOS := ldvr'exit'label'saved;                                         08758000
                                                                        08760000
  assemble( sxit 0 );                                                   08762000
                                                                        08764000
end;  << of procedure cpr'shutdown >>                                   08766000
                                                                        08768000
$PAGE "PROCEDURE: CPR'INTERNAL'ERROR"                                   08770000
procedure cpr'internal'error;                                           08772000
                                                                        08774000
  option privileged, uncallable;                                        08776000
                                                                        08778000
begin                                                                   08780000
                                                                        08782000
  cpr'shutdown(1000);                                                   08784000
                                                                        08786000
end; <<cpr'internal'error>>                                             08788000
                                                                        08790000
$PAGE "PROCEDURE: CPR'CODING'ERROR"                                     08792000
procedure cpr'coding'error;                                             08794000
                                                                        08796000
  option privileged, uncallable;                                        08798000
                                                                        08800000
begin                                                                   08802000
                                                                        08804000
  cpr'shutdown(2000);                                                   08806000
                                                                        08808000
end; <<cpr'coding'error>>                                               08810000
                                                                        08812000
$PAGE "PROCEDURE: CPR'LIMIT'ERROR"                                      08814000
procedure cpr'limit'error;                                              08816000
                                                                        08818000
  option privileged, uncallable;                                        08820000
                                                                        08822000
begin                                                                   08824000
                                                                        08826000
  cpr'shutdown(3000);                                                   08828000
                                                                        08830000
end; <<cpr'limit'error>>                                                08832000
                                                                        08834000
$PAGE "PROCEDURE: CPR'ASSERTION"                                        08836000
procedure cpr'assertion(assertion);                                     08838000
                                                                        08840000
  value                 assertion ;                                     08842000
                                                                        08844000
  logical               assertion ;                                     08846000
                                                                        08848000
  option privileged, uncallable, variable;                              08850000
                                                                        08852000
begin                                                                   08854000
                                                                        08856000
  if not parm'mask.(15:1) then                                          08858000
    cpr'shutdown(4000)                                                  08860000
  else                                                                  08862000
    if not assertion then                                               08864000
      cpr'shutdown(5000);                                               08866000
                                                                        08868000
end; <<cpr'assertion>>                                                  08870000
                                                                        08872000
  <<generic Ciper Data Segment (cds) area management routines>>         08874000
    <<routines for cpr'get'cds'area & cpr'get'2ndary'cds'area>>         08876000
$PAGE "PROCEDURE: CPR'INIT'CDS'AREA"                                    08878000
integer procedure cpr'init'cds'area(mem, area'needed,                   08880000
                                    type, init'value);                  08882000
                                                                        08884000
  value                             mem, area'needed,                   08886000
                                    type, init'value ;                  08888000
                                                                        08890000
  logical pointer                   mem                                 08892000
                                                     ;                  08894000
                                                                        08896000
  integer                                area'needed                    08898000
                                                     ;                  08900000
                                                                        08902000
  logical                                                               08904000
                                    type, init'value ;                  08906000
                                                                        08908000
  option privileged, uncallable, variable;                              08910000
                                                                        08912000
begin                                                                   08914000
                                                                        08916000
COMMENT                                                                 08918000
                                                                        08920000
Purpose:  Do all the initialization of a block of memory in the         08922000
CIPER Data Segment.                                                     08924000
                                                                        08926000
Input:                                                                  08928000
     mem := pointer to the memory area to be initialized.               08930000
     area'needed := the size of the memory area to be used for          08932000
data.  Area'needed + cds'area'overhead must = the size of               08934000
new'mem'end.                                                            08936000
     type := the type identification code for the memory area.          08938000
     init'value := (optional) the initial value if any for the          08940000
data area.  If init'value is not sent then no initialization takes      08942000
place.                                                                  08944000
                                                                        08946000
Output:                                                                 08948000
     cpr'init'area := returns the pointer to the data area requested.   08950000
The data area is nestled within its header and trailer.                 08952000
                                                                        08954000
Side effects: The data area is initialized.                             08956000
                                                                        08958000
Special considerations:  This procedure must be called with DB          08960000
pointing to the CDS.                                                    08962000
;                                                                       08964000
                                                                        08966000
define                                                                  08968000
       init'value'     = (15:1) #                                       08970000
;                                                                       08972000
                                                                        08974000
@mem := @mem+cds'area'offset;                                           08976000
                                                                        08978000
mem(cds'area'size) := area'needed + cds'area'overhead;                  08980000
mem(cds'area'type) := type;                                             08982000
                                                                        08984000
mem( mem(cds'area'size) - cds'area'overhead) := mem(cds'area'size);     08986000
                                                                        08988000
if parm'mask.init'value' then                                           08990000
  begin                                                                 08992000
  mem:=init'value;                                                      08994000
  move mem(1) := mem, (area'needed-1);                                  08996000
  end;                                                                  08998000
                                                                        09000000
cpr'init'cds'area:=@mem;                                                09002000
                                                                        09004000
end; <<cpr'init'cds'area>>                                              09006000
                                                                        09008000
    <<end of routines for cpr'get'cds'area &                 >>         09010000
    << cpr'get'2ndary'cds'area                               >>         09012000
$PAGE "PROCEDURE: CPR'GET'CDS'AREA"                                     09014000
integer procedure cpr'get'cds'area(area'needed, type, init'value);      09016000
                                                                        09018000
  value                            area'needed, type, init'value ;      09020000
                                                                        09022000
  integer                          area'needed                   ;      09024000
                                                                        09026000
  logical                                       type, init'value ;      09028000
                                                                        09030000
  option privileged, uncallable, variable;                              09032000
                                                                        09034000
begin                                                                   09036000
                                                                        09038000
COMMENT                                                                 09040000
                                                                        09042000
Purpose: Allocates a portion of memory in a CIPER Data Segment of       09044000
the size and type specified.                                            09046000
                                                                        09048000
Input:                                                                  09050000
     size := the size of the data area required.                        09052000
     type := the type identification code for the data area.            09054000
     init'to'zero (optional) := if present the data area will be        09056000
initialized to zero.                                                    09058000
                                                                        09060000
Output:                                                                 09062000
     cpr'get'cds'area := the data segment base relative pointer to      09064000
the data area.  If no space is available then the pointers value will   09066000
be zero.                                                                09068000
                                                                        09070000
Special Considerations:                                                 09072000
     This procedure must be called with DB pointing at the CDS.         09074000
;                                                                       09076000
                                                                        09078000
define                                                                  09080000
       init'value'     = (15:1) #                                       09082000
;                                                                       09084000
integer                                                                 09086000
        mem'needed                                                      09088000
       ,neg'mem'needed                                                  09090000
       ,remainder                                                       09092000
;                                                                       09094000
integer pointer                                                         09096000
                mem'begin                                               09098000
               ,mem'end                                                 09100000
               ,new'mem'begin                                           09102000
               ,new'mem'end                                             09104000
;                                                                       09106000
logical pointer                                                         09108000
                sha                                                     09110000
;                                                                       09112000
                                                                        09114000
if area'needed = 0 then                                                 09116000
    <<mem'needed = 0 would work for cpr'get'cds'area 's algorithm,      09118000
      but cpr'rel'cds'area would abort when it found the empty heap     09120000
      during its checking.>>                                            09122000
    begin                                                               09124000
    cpr'get'cds'area:=0;                                                09126000
    return;                                                             09128000
    end;                                                                09130000
                                                                        09132000
@sha:=sha'segment'offset;                                               09134000
                                                                        09136000
  <<convert area'needed to a word quantity if needed>>                  09138000
if area'needed < 0 then area'needed := (1-area'needed) to'word;         09140000
                                                                        09142000
mem'needed := area'needed + cds'area'overhead;                          09144000
neg'mem'needed := -mem'needed;                                          09146000
                                                                        09148000
@mem'begin := sha(sha'free'space'tbl'ptr) - 1;                          09150000
                                                                        09152000
try'again:                                                              09154000
while mem'begin <> 0 do                                                 09156000
  begin                                                                 09158000
  if mem'begin <= neg'mem'needed then                                   09160000
      <<we have found an inactive block of a size >= mem'needed>>       09162000
    begin                                                               09164000
      <<compute the ending of the inactive block>>                      09166000
    @mem'end:=@mem'begin(mem'begin+1);                                  09168000
                                                                        09170000
      <<compute the boundaries of the block we are allocating>>         09172000
    @new'mem'end:=@mem'end;                                             09174000
    @new'mem'begin:=@new'mem'end(mem'needed-1);                         09176000
                                                                        09178000
      <<compute beginning of the remainder of the block, if any>>       09180000
    @mem'end:=@new'mem'begin(+1);                                       09182000
      <<adjust the remaining area's block boundarys>>                   09184000
    remainder:=@mem'end - @mem'begin - 1;                               09186000
    if remainder <> 0 then <<adjust remaining space>>                   09188000
      mem'begin := mem'end := remainder;                                09190000
                                                                        09192000
    cpr'get'cds'area :=                                                 09194000
         if parm'mask.init'value' then                                  09196000
             <<initialize the block's contents>>                        09198000
           cpr'init'cds'area(new'mem'end, area'needed, type,            09200000
                init'value)                                             09202000
         else             << v^ - flaky>>                               09204000
           cpr'init'cds'area(new'mem'end, area'needed, type);           09206000
                                                                        09208000
    return;                                                             09210000
    end;                                                                09212000
                                                                        09214000
  @mem'begin:=@mem'begin-\mem'begin\;                                   09216000
                                                                        09218000
end; <<of while>>                                                       09220000
                                                                        09222000
<<currently no space available, later this can try to expand the        09224000
  dst>>                                                                 09226000
                                                                        09228000
cpr'internal'error;                                                     09230000
                                                                        09232000
<<for later: go try'again;>>                                            09234000
                                                                        09236000
end; <<cpr'get'cds'area>>                                               09238000
                                                                        09240000
$PAGE "PROCEDURE: CPR'GET'2NDARY'CDS'AREA"                              09242000
integer procedure cpr'get'2ndary'cds'area(area'needed, type,            09244000
                                                 init'value);           09246000
                                                                        09248000
  value                                   area'needed, type,            09250000
                                                 init'value ;           09252000
                                                                        09254000
  integer                                 area'needed                   09256000
                                                            ;           09258000
                                                                        09260000
  logical                                              type,            09262000
                                                 init'value ;           09264000
                                                                        09266000
  option privileged, uncallable, variable;                              09268000
                                                                        09270000
begin                                                                   09272000
                                                                        09274000
COMMENT                                                                 09276000
                                                                        09278000
Purpose: Allocates a portion of memory in a CIPER Data Segment          09280000
of the size and type specified.  An attempt is made to place            09282000
this memory at a high order address.                                    09284000
                                                                        09286000
Input:                                                                  09288000
     size := the size of the data area required.                        09290000
     type := the type identification code for the data area.            09292000
     init'to'zero (optional) := if present the data area will           09294000
be initialized to zero.                                                 09296000
                                                                        09298000
Output:                                                                 09300000
     cpr'get'2ndary'cds'area := the data segment base relative          09302000
pointer to the data area.  If no space is available then the            09304000
pointers value will be zero.                                            09306000
                                                                        09308000
Special Considerations:                                                 09310000
     This procedure must be called with DB pointing at the CDS.         09312000
;                                                                       09314000
                                                                        09316000
define                                                                  09318000
       init'value'     = (15:1) #                                       09320000
;                                                                       09322000
integer                                                                 09324000
        mem'needed                                                      09326000
       ,neg'mem'needed                                                  09328000
       ,remainder                                                       09330000
;                                                                       09332000
integer pointer                                                         09334000
                mem'begin                                               09336000
               ,mem'end                                                 09338000
               ,new'mem'begin                                           09340000
               ,new'mem'end                                             09342000
;                                                                       09344000
logical pointer                                                         09346000
                sha                                                     09348000
;                                                                       09350000
                                                                        09352000
if area'needed = 0 then                                                 09354000
    <<mem'needed = 0 would work for cpr'get'2ndary'cds'area  >>         09356000
    <<'s algorithm, but cpr'rel'cds'area would abort when it >>         09358000
    <<found the empty heap during its checking.              >>         09360000
   begin                                                                09362000
    cpr'get'2ndary'cds'area:=0;                                         09364000
    return;                                                             09366000
    end;                                                                09368000
                                                                        09370000
@sha:=sha'segment'offset;                                               09372000
                                                                        09374000
  <<convert area'needed to a word quantity if needed         >>         09376000
if area'needed < 0 then area'needed := (1-area'needed) to'word;         09378000
                                                                        09380000
mem'needed := area'needed + cds'area'overhead;                          09382000
neg'mem'needed := -mem'needed;                                          09384000
                                                                        09386000
@mem'begin := sha(sha'free'space'tbl'ptr) - 1;                          09388000
                                                                        09390000
try'again:                                                              09392000
while mem'begin <> 0 do                                                 09394000
  begin                                                                 09396000
  if mem'begin <= neg'mem'needed then                                   09398000
      <<we have found an inactive block of a                 >>         09400000
      << size >= mem'needed                                  >>         09402000
    begin                                                               09404000
      <<compute the ending of the inactive block             >>         09406000
    @mem'end:=@mem'begin(mem'begin+1);                                  09408000
                                                                        09410000
      <<compute the boundaries of the block we are allocating>>         09412000
    @new'mem'begin:=@mem'begin;                                         09414000
    @new'mem'end:=@new'mem'begin(neg'mem'needed+1);                     09416000
                                                                        09418000
      <<compute beginning of the remainder of the block,     >>         09420000
      << if any                                              >>         09422000
    @mem'begin:=@new'mem'end(-1);                                       09424000
      <<adjust the remaining area's block boundarys          >>         09426000
    remainder:=@mem'end - @mem'begin - 1;                               09428000
    if remainder <> 0 then <<adjust remaining space          >>         09430000
      mem'begin := mem'end := remainder;                                09432000
                                                                        09434000
    cpr'get'2ndary'cds'area :=                                          09436000
         if parm'mask.init'value' then                                  09438000
             <<initialize the block's contents               >>         09440000
           cpr'init'cds'area(new'mem'end, area'needed, type,            09442000
                init'value)                                             09444000
         else                                                           09446000
           cpr'init'cds'area(new'mem'end, area'needed, type);           09448000
                                                                        09450000
    return;                                                             09452000
    end;                                                                09454000
                                                                        09456000
  @mem'begin:=@mem'begin-\mem'begin\;                                   09458000
                                                                        09460000
end; <<of while>>                                                       09462000
                                                                        09464000
<<currently no space available, later this can try to expand >>         09466000
<<the dst                                                    >>         09468000
                                                                        09470000
cpr'internal'error;                                                     09472000
                                                                        09474000
<<for later: go try'again;                                   >>         09476000
                                                                        09478000
end; <<cpr'get'2ndary'cds'area>>                                        09480000
                                                                        09482000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA"                                     09484000
procedure cpr'rel'cds'area(cds'area);                                   09486000
                                                                        09488000
  value                    cds'area ;                                   09490000
                                                                        09492000
  logical pointer          cds'area ;                                   09494000
                                                                        09496000
  option privileged, uncallable;                                        09498000
                                                                        09500000
begin                                                                   09502000
                                                                        09504000
COMMENT                                                                 09506000
                                                                        09508000
Purpose: Deallocates the portion of memory in a CIPER Data Segment      09510000
pointed to by cds'area.                                                 09512000
                                                                        09514000
Input:                                                                  09516000
     cds'area := points to the portion of memory to be deallocated.     09518000
                                                                        09520000
Output:                                                                 09522000
                                                                        09524000
Special Considerations:                                                 09526000
     This procedure must be called with DB pointing at the CDS.         09528000
A validity check is made that the area to be released is a valid        09530000
area.  If the memory area is invalid then cpr'initernal'error is        09532000
called.                                                                 09534000
;                                                                       09536000
                                                                        09538000
integer pointer                                                         09540000
                old'mem'begin                                           09542000
               ,old'mem'end                                             09544000
;                                                                       09546000
integer                                                                 09548000
        remainder                                                       09550000
;                                                                       09552000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA;  SUBROUTINE: COLLAPSE'AREAS"        09554000
integer subroutine collapse'areas(fix'up'end, dir, other'end);          09556000
value                             fix'up'end, dir, other'end ;          09558000
integer pointer                   fix'up'end,      other'end ;          09560000
integer                                       dir            ;          09562000
begin                                                                   09564000
                                                                        09566000
if fix'up'end(dir) < 0 then                                             09568000
  begin                                                                 09570000
  remainder:=fix'up'end + fix'up'end( dir );                            09572000
  @fix'up'end:=@fix'up'end( dir * \fix'up'end( dir )\ );                09574000
  fix'up'end:=remainder;                                                09576000
  other'end:=remainder;                                                 09578000
  end;                                                                  09580000
                                                                        09582000
collapse'areas := @fix'up'end;                                          09584000
                                                                        09586000
end; <<collapse'areas>>                                                 09588000
$PAGE "PROCEDURE: CPR'REL'CDS'AREA"                                     09590000
                                                                        09592000
if @cds'area = 0 then return; <<a null (nil) pointer>>                  09594000
                                                                        09596000
@old'mem'end := @cds'area( - cds'area'offset );                         09598000
@old'mem'begin := @old'mem'end( old'mem'end - 1 );                      09600000
                                                                        09602000
  <<verify this is a valid memory block>>                               09604000
if old'mem'begin <= 0 or old'mem'end <= 0 or                            09606000
     old'mem'begin <> old'mem'end then                                  09608000
  cpr'internal'error;                                                   09610000
                                                                        09612000
old'mem'end := -old'mem'end;                                            09614000
old'mem'begin := -old'mem'begin;                                        09616000
                                                                        09618000
@old'mem'begin := collapse'areas(old'mem'begin, 1, old'mem'end);        09620000
@old'mem'end := collapse'areas(old'mem'end, -1, old'mem'begin);         09622000
                                                                        09624000
end; <<cpr'rel'cds'area>>                                               09626000
                                                                        09628000
    <<cpr'lock'cds'area & cpr'unlock'cds'area>>                         09630000
$PAGE "PROCEDURE: CPR'LOCK'CDS'AREA & CPR'UNLOCK'CDS'AREA"              09632000
procedure cpr'lock'cds'area(area'ptr);                                  09634000
                                                                        09636000
  value                     area'ptr ;                                  09638000
                                                                        09640000
  logical pointer           area'ptr ;                                  09642000
                                                                        09644000
  option privileged, uncallable;                                        09646000
                                                                        09648000
begin                                                                   09650000
                                                                        09652000
COMMENT                                                                 09654000
                                                                        09656000
Purpose: to lock or unlock a ciper table in the cds.                    09658000
                                                                        09660000
Input:                                                                  09662000
     area'ptr := pointer to the table.                                  09664000
                                                                        09666000
Side effects:  The table pointed to is locked or unlocked via the sir   09668000
in the table, and the getsir return is saved in the appropriate place   09670000
in the table.                                                           09672000
                                                                        09674000
Special condsiderations:  DB must be pointing to the cds.               09676000
;                                                                       09678000
                                                                        09680000
entry                                                                   09682000
      cpr'unlock'cds'area                                               09684000
;                                                                       09686000
logical                                                                 09688000
        lock                                                            09690000
;                                                                       09692000
integer                                                                 09694000
        table'suptype                                                   09696000
;                                                                       09698000
                                                                        09700000
lock:=true;                                                             09702000
go to key;                                                              09704000
                                                                        09706000
cpr'unlock'cds'area:                                                    09708000
lock:=false;                                                            09710000
                                                                        09712000
key:                                                                    09714000
                                                                        09716000
cpr'assertion( sha'segment'offset <= @area'ptr <=                       09718000
     B08'maximum'dseg'size );                                           09720000
                                                                        09722000
table'suptype := area'ptr(cds'area'suptype);                            09724000
                                                                        09726000
cpr'assertion( sha'type'def <= table'suptype&lsl(8) <=                  09728000
     cbi'suptype'def);                                                  09730000
                                                                        09732000
case table'suptype of                                                   09734000
case'begin                                                              09736000
                                                                        09738000
    <<0 := never should happen>>                                        09740000
  cpr'coding'error;                                                     09742000
                                                                        09744000
    <<1 := sha'type'def>>                                               09746000
  cpr'coding'error;                                                     09748000
                                                                        09750000
    <<2 := ctm'type'def>>                                               09752000
  if lock then  pdisable  else  penable;                                09754000
                                                                        09756000
    <<3 := ct'suptype'def>>                                             09758000
  if lock then  <<do nothing>>  else  <<do nothing>>                    09760000
         <<eventually a sir mechanism will be used>>;                   09762000
                                                                        09764000
    <<4 := cb'suptype'def>>                                             09766000
  cpr'coding'error;                                                     09768000
                                                                        09770000
    <<5 := qh'suptype'def>>                                             09772000
  cpr'coding'error;                                                     09774000
                                                                        09776000
    <<6 := qe'suptype'def>>                                             09778000
  cpr'coding'error;                                                     09780000
                                                                        09782000
    <<7 := qei'suptype'def>>                                            09784000
  cpr'coding'error;                                                     09786000
                                                                        09788000
    <<8 := cbi'suptype'def>>                                            09790000
  cpr'coding'error;                                                     09792000
                                                                        09794000
case'end;                                                               09796000
                                                                        09798000
end; <<cpr'lock'cds'area & cpr'unlock'cds'area>>                        09800000
                                                                        09802000
$PAGE "PROCEDURE: CPR'SIZE'OF'CDS'AREA"                                 09804000
integer procedure cpr'size'of'cds'area(area'ptr);                       09806000
                                                                        09808000
  value                                area'ptr ;                       09810000
                                                                        09812000
  logical pointer                      area'ptr ;                       09814000
                                                                        09816000
  option privileged, uncallable;                                        09818000
                                                                        09820000
begin                                                                   09822000
                                                                        09824000
COMMENT                                                                 09826000
                                                                        09828000
Purpose:  Compute the logical size of a cds area.                       09830000
                                                                        09832000
Input:                                                                  09834000
     area'ptr := pointer to a cds area.                                 09836000
                                                                        09838000
Output:                                                                 09840000
     cpr'cds'area'size := the logical size of area'ptr.                 09842000
;                                                                       09844000
                                                                        09846000
if area'ptr(cds'area'size) <>                                           09848000
     area'ptr(area'ptr(cds'area'size) - 1) then cpr'internal'error;     09850000
                                                                        09852000
cpr'size'of'cds'area := area'ptr(cds'area'size) - cds'area'overhead;    09854000
                                                                        09856000
end; <<cpr'size'of'cds'area>>                                           09858000
                                                                        09860000
  <<Specific Ciper Data Segment (cds) area management routines>>        09862000
    <<routines for cpr'engine>>                                         09864000
      <<routines for cpr'get'ct'of>>                                    09866000
        <<routines for cpr'init'cdda'for>>                              09868000
          <<routines for cpr'get'cdda>>                                 09870000
            <<routines for cpr'init'cds>>                               09872000
$PAGE "PROCEDURE: CPR'INIT'SHA"                                         09874000
procedure cpr'init'sha(initial'dseg'size, maximum'dseg'size);           09876000
                                                                        09878000
  value                initial'dseg'size, maximum'dseg'size ;           09880000
                                                                        09882000
  integer              initial'dseg'size, maximum'dseg'size ;           09884000
                                                                        09886000
  option privileged, uncallable;                                        09888000
                                                                        09890000
begin                                                                   09892000
                                                                        09894000
COMMENT                                                                 09896000
                                                                        09898000
Purpose: Initialize the sha (segment header area) of a cds (ciper       09900000
data segment).                                                          09902000
                                                                        09904000
Input:                                                                  09906000
     initial'dseg'size := the initial data segment size.                09908000
     maximum'dseg'size := the maximum (i.e. largest ever) size of the   09910000
data segment.                                                           09912000
                                                                        09914000
Output: (none)                                                          09916000
                                                                        09918000
Side effects:  DB zero through sha'size area initialized.               09920000
;                                                                       09922000
                                                                        09924000
logical pointer                                                         09926000
                sha                                                     09928000
;                                                                       09930000
                                                                        09932000
@sha:=0; <<DB + 0>>                                                     09934000
                                                                        09936000
@sha:=cpr'init'cds'area(sha, sha'size, sha'type'def, 0);                09938000
                                                                        09940000
  <<adjust the segment size variables>>                                 09942000
if initial'dseg'size > maximum'dseg'size then                           09944000
  maximum'dseg'size := initial'dseg'size;                               09946000
                                                                        09948000
  <<set up the segment size variables>>                                 09950000
sha(sha'max'seg'size) := maximum'dseg'size;                             09952000
sha(sha'seg'size) := initial'dseg'size;                                 09954000
                                                                        09956000
end; <<cpr'init'sha>>                                                   09958000
                                                                        09960000
$PAGE "PROCEDURE: CPR'INIT'CNTL'OF'CDS'AREA"                            09962000
procedure cpr'init'cntl'of'cds'area(sha);                               09964000
                                                                        09966000
  value                             sha ;                               09968000
                                                                        09970000
  logical pointer                   sha ;                               09972000
                                                                        09974000
  option privileged, uncallable;                                        09976000
                                                                        09978000
begin                                                                   09980000
                                                                        09982000
COMMENT                                                                 09984000
                                                                        09986000
Purpose: Initialize the cds for the getting & releasing of cds area,    09988000
as used by cpr'get'cds'area & cpr'rel'cds'area.                         09990000
                                                                        09992000
Input:                                                                  09994000
     sha := pointer to the segment header area which contains the       09996000
sha'free'space'tbl'ptr.                                                 09998000
                                                                        10000000
Output: (none)                                                          10002000
                                                                        10004000
Side effects: The cds is initialized to look like:                      10006000
                                                                        10008000
                      +--------------------------+                      10010000
                      |           sha            |                      10012000
                      z (sha'free'space'tbl'ptr) z ----+                10014000
                      |                          |     |                10016000
                      +--------------------------+     |                10018000
                      |             0            |     |                10020000
                      +--------------------------+     | ---+           10022000
                      |-(initial free area size) |     |    |initial    10024000
                      +--------------------------+     |    |           10026000
                      |                          |     |    |free       10028000
                      z                          z     |    |           10030000
                      z                          z     |    |area       10032000
                      |                          |     |    |           10034000
                      +--------------------------+     |    |size       10036000
                      |-(initial free area size) |     |    |           10038000
                      +--------------------------+     | ---+           10040000
                      |             0            |  <--+                10042000
                      +--------------------------+                      10044000
                                                                        10046000
Special considerations:  DB must be at the cds.                         10048000
;                                                                       10050000
                                                                        10052000
logical pointer                                                         10054000
                mem                                                     10056000
;                                                                       10058000
                                                                        10060000
@mem:=0; <<set to base of dseg>>                                        10062000
                                                                        10064000
mem( sha(cds'area'size) ) := 0;                                         10066000
mem( sha(sha'seg'size) - 1 ) := 0; << = mem( sha(cds'area'size) ) >>    10068000
                                                                        10070000
                                                                        10072000
mem( sha(cds'area'size) + 1 ) :=                                        10074000
     - ( sha(sha'seg'size) - sha(cds'area'size) - 2 );                  10076000
                                                                        10078000
mem( sha(sha'seg'size) - 2 ) := mem( sha(cds'area'size) + 1 );          10080000
                                                                        10082000
                                                                        10084000
sha(sha'free'space'tbl'ptr) := @mem( sha(sha'seg'size) - 1 );           10086000
                                                                        10088000
end; <<cpr'init'cntl'of'cds'area>>                                      10090000
                                                                        10092000
$PAGE "PROCEDURE: CPR'INIT'CTM"                                         10094000
procedure cpr'init'ctm(sha, num'ctm'ents);                              10096000
                                                                        10098000
  value                sha, num'ctm'ents ;                              10100000
                                                                        10102000
  logical pointer      sha               ;                              10104000
                                                                        10106000
  integer                   num'ctm'ents ;                              10108000
                                                                        10110000
  option privileged, uncallable;                                        10112000
                                                                        10114000
begin                                                                   10116000
                                                                        10118000
COMMENT                                                                 10120000
                                                                        10122000
Purpose: Create and initialize the control table map of the cds.        10124000
                                                                        10126000
Input:                                                                  10128000
     sha := pointer to the segment header area of the cds.              10130000
     num'ctm'ents := the number of control table map (ctm) entries      10132000
to configure in.                                                        10134000
                                                                        10136000
Output: (none)                                                          10138000
                                                                        10140000
Side effect: Modifies sha(sha'ctm'ptr) to point to the ctm.             10142000
                                                                        10144000
Special considerations: DB must point to the cds.                       10146000
;                                                                       10148000
                                                                        10150000
integer                                                                 10152000
        area'needed                                                     10154000
       ,entry'size                                                      10156000
;                                                                       10158000
logical pointer                                                         10160000
                ctm                                                     10162000
               ,ctm0                                                    10164000
;                                                                       10166000
                                                                        10168000
entry'size :=                                                           10170000
     if ctm0'size > ctm'ent'size then                                   10172000
       ctm0'size                                                        10174000
     else                                                               10176000
       ctm'ent'size;                                                    10178000
                                                                        10180000
area'needed := entry'size * (num'ctm'ents + 1);                         10182000
                                                                        10184000
@ctm := cpr'get'cds'area(area'needed, ctm'type'def, 0);                 10186000
                                                                        10188000
if @ctm = 0 then cpr'internal'error;                                    10190000
                                                                        10192000
@ctm0:=@ctm(0); <<entry zero>>                                          10194000
                                                                        10196000
sha(sha'ctm'ptr) := @ctm0;                                              10198000
                                                                        10200000
ctm0(ctm0'ent'cnt) := num'ctm'ents;                                     10202000
                                                                        10204000
ctm0(ctm0'ctm'size) := entry'size;                                      10206000
                                                                        10208000
ctm0(ctm0'ent'inuse'cnt) := 0;                                          10210000
                                                                        10212000
end; <<cpr'init'ctm>>                                                   10214000
                                                                        10216000
$PAGE "PROCEDURE: CPR'INIT'LIOQ"                                        10218000
procedure cpr'init'lioq(sha, num'lioq'ents);                            10220000
                                                                        10222000
  value                 sha, num'lioq'ents ;                            10224000
                                                                        10226000
  logical pointer       sha                ;                            10228000
                                                                        10230000
  integer                    num'lioq'ents ;                            10232000
                                                                        10234000
  option privileged, uncallable;                                        10236000
                                                                        10238000
begin                                                                   10240000
                                                                        10242000
logical pointer                                                         10244000
                lioq                                                    10246000
;                                                                       10248000
                                                                        10250000
@lioq := cpr'get'cds'area(0 <<size>>, 0 <<type>>, 0);                   10252000
                                                                        10254000
<< for later>>                                                          10256000
<<if @lioq = 0 then cpr'internal'error;>>                               10258000
                                                                        10260000
sha(sha'lioq'list'ptr) := @lioq;                                        10262000
                                                                        10264000
end; <<cpr'init'lioq>>                                                  10266000
                                                                        10268000
            <<end of routines for cpr'init'cds>>                        10270000
$PAGE "PROCEDURE: CPR'INIT'CDS"                                         10272000
procedure cpr'init'cds(cdda'dseg, initial'dseg'size,                    10274000
                       maximum'dseg'size, num'ctm'ents,                 10276000
                       num'lioq'ents                   );               10278000
                                                                        10280000
  value                cdda'dseg, initial'dseg'size,                    10282000
                       maximum'dseg'size, num'ctm'ents,                 10284000
                       num'lioq'ents                    ;               10286000
                                                                        10288000
  integer              cdda'dseg, initial'dseg'size,                    10290000
                       maximum'dseg'size, num'ctm'ents,                 10292000
                       num'lioq'ents                    ;               10294000
                                                                        10296000
  option privileged, uncallable;                                        10298000
                                                                        10300000
begin                                                                   10302000
                                                                        10304000
COMMENT                                                                 10306000
                                                                        10308000
Purpose:  Initialize the ciper data segment.  DB should be set to       10310000
the data segment to be initialized.                                     10312000
                                                                        10314000
Input:                                                                  10316000
     initial'dseg'size := the initial (i.e. current) size of the        10318000
cds.                                                                    10320000
     maximum'dseg'size := the maximum (i.e. largest possible) size      10322000
of the cds.                                                             10324000
     num'ctm'ents := the number of ctm entries to configure in to       10326000
this cds.                                                               10328000
     num'lioq'ents := the number of lioq (logical IO queue) entries     10330000
to configure in to this cds.                                            10332000
                                                                        10334000
Output: (none)                                                          10336000
                                                                        10338000
Special considerations:  DB must be set to the data segment to be       10340000
initialized.                                                            10342000
;                                                                       10344000
                                                                        10346000
logical pointer                                                         10348000
                sha                                                     10350000
;                                                                       10352000
                                                                        10354000
cpr'init'sha(initial'dseg'size, maximum'dseg'size);                     10356000
                                                                        10358000
@sha:=sha'segment'offset;                                               10360000
                                                                        10362000
sha(sha'cds'dst'num) := cdda'dseg;                                      10364000
                                                                        10366000
cpr'init'cntl'of'cds'area(sha);                                         10368000
                                                                        10370000
cpr'init'ctm(sha, num'ctm'ents);                                        10372000
                                                                        10374000
cpr'init'lioq(sha, num'lioq'ents);                                      10376000
                                                                        10378000
end; <<cpr'init'cds>>                                                   10380000
                                                                        10382000
          <<end of routines for cpr'get'cdda>>                          10384000
$PAGE "PROCEDURE: CPR'GET'CDS"                                          10386000
logical procedure cpr'get'cds(ldev);                                    10388000
                                                                        10390000
  value                       ldev ;                                    10392000
                                                                        10394000
  integer                     ldev ;                                    10396000
                                                                        10398000
  option privileged, uncallable;                                        10400000
                                                                        10402000
begin                                                                   10404000
                                                                        10406000
COMMENT                                                                 10408000
                                                                        10410000
Purpose: Gets a data segment for Ciper.                                 10412000
                                                                        10414000
Input:                                                                  10416000
     ldev := the logical device for which the Ciper Data                10418000
Segment is required.                                                    10420000
                                                                        10422000
Output:                                                                 10424000
     cpr'get'cdda := if a data segment is available.                    10426000
                                                                        10428000
Side effects:                                                           10430000
     DB is left pointing to the cds.                                    10432000
;                                                                       10434000
                                                                        10436000
integer                                                                 10438000
        cds'db                                                          10440000
       ,initial'dseg'size                                               10442000
       ,maximum'dseg'size                                               10444000
       ,num'ctm'ents                                                    10446000
       ,num'lioq'ents                                                   10448000
;                                                                       10450000
                                                                        10452000
initial'dseg'size := B08'initial'dseg'size;                             10454000
maximum'dseg'size := B08'maximum'dseg'size;                             10456000
num'ctm'ents := B08'num'ctm'ents;                                       10458000
num'lioq'ents := B08'num'ctm'ents;                                      10460000
                                                                        10462000
cds'db:=getdatasegc(initial'dseg'size, maximum'dseg'size);              10464000
if <> then                                                              10466000
    <<unable to get a data segment>>                                    10468000
  begin                                                                 10470000
  cpr'get'cds := false;                                                 10472000
  return;                                                               10474000
  end;                                                                  10476000
                                                                        10478000
changedb( double( -cds'db ) );                                          10480000
                                                                        10482000
  <<initialize the cds (sha, free space, ctm, lioq)>>                   10484000
cpr'init'cds(cds'db, initial'dseg'size, maximum'dseg'size,              10486000
     num'ctm'ents, num'lioq'ents);                                      10488000
                                                                        10490000
cpr'get'cds := true;                                                    10492000
                                                                        10494000
end; <<cpr'get'cds>>                                                    10496000
                                                                        10498000
$PAGE "PROCEDURE: CPR'GET'CTMI"                                         10500000
integer procedure cpr'get'ctmi(ctm0, ldev);                             10502000
                                                                        10504000
  value                        ctm0, ldev ;                             10506000
                                                                        10508000
  logical pointer              ctm0       ;                             10510000
                                                                        10512000
  integer                            ldev ;                             10514000
                                                                        10516000
  option privileged, uncallable;                                        10518000
                                                                        10520000
begin                                                                   10522000
                                                                        10524000
COMMENT                                                                 10526000
                                                                        10528000
Purpose: Allocate a control table map entry and return the control      10530000
table map index.                                                        10532000
                                                                        10534000
Error conditions & responses:                                           10536000
                                                                        10538000
Input:                                                                  10540000
     ctm0 := pointer to the ctm of the cds.                             10542000
     ldev := the logical device number to which this entry              10544000
is be assigned.                                                         10546000
                                                                        10548000
Output:                                                                 10550000
      cpr'get'ctmi := the index into the ctm of the entry assigned.     10552000
If zero the no entry was available.                                     10554000
                                                                        10556000
Side effects:  The ctm entry found is updated with the appropriate      10558000
ldev number. <<In the future the sir will go here.>>                    10560000
                                                                        10562000
Special considerations: DB must be set to the cds.                      10564000
;                                                                       10566000
                                                                        10568000
logical pointer                                                         10570000
                ctm                                                     10572000
;                                                                       10574000
                                                                        10576000
cpr'lock'cds'area(ctm0);                                                10578000
                                                                        10580000
if ctm0(ctm0'ent'inuse'cnt) = ctm0(ctm0'ent'cnt) then                   10582000
    <<no entry available>>                                              10584000
  begin                                                                 10586000
  cpr'unlock'cds'area(ctm0);                                            10588000
  cpr'get'ctmi := 0;                                                    10590000
  return;                                                               10592000
  end;                                                                  10594000
                                                                        10596000
  <<point to the first entry>>                                          10598000
@ctm := @ctm0( ctm0(ctm0'ctm'size) );                                   10600000
                                                                        10602000
  <<search for the free entry, there must be one>>                      10604000
while ctm(ctm'ldev) <> 0 do                                             10606000
  @ctm:=@ctm( ctm0(ctm0'ctm'size) );                                    10608000
                                                                        10610000
ctm(ctm'ldev):=ldev; <<secure the entry>>                               10612000
                                                                        10614000
ctm0(ctm0'ent'inuse'cnt) := ctm0(ctm0'ent'inuse'cnt) + 1;               10616000
                                                                        10618000
cpr'unlock'cds'area(ctm0); <<unlock as quickly as possible>>            10620000
                                                                        10622000
  <<the rest of this entry should be clean from either                  10624000
    cpr'init'ctmi or cpr'rel'ctmi >>                                    10626000
                                                                        10628000
  <<compute & return the control table map index>>                      10630000
cpr'get'ctmi := (@ctm - @ctm0) / integer(ctm0(ctm0'ctm'size));          10632000
                                                                        10634000
end; <<cpr'get'ctmi>>                                                   10636000
                                                                        10638000
            <<routines for cpr'init'ct>>                                10640000
$PAGE "PROCEDURE: CPR'INIT'CB"                                          10642000
procedure cpr'init'cb(ct);                                              10644000
                                                                        10646000
  value               ct ;                                              10648000
                                                                        10650000
  logical pointer     ct ;                                              10652000
                                                                        10654000
  option privileged, uncallable;                                        10656000
                                                                        10658000
begin                                                                   10660000
                                                                        10662000
COMMENT                                                                 10664000
                                                                        10666000
Purpose:  Create and initialize the cb for ct(ct'lvl'active).           10668000
                                                                        10670000
Input:                                                                  10672000
     ct := control table pointer.                                       10674000
                                                                        10676000
Output: (none)                                                          10678000
                                                                        10680000
Side effects:  The address of the cb is loaded into ct(ct'lvln'cb'ptr). 10682000
;                                                                       10684000
                                                                        10686000
logical pointer                                                         10688000
                cb                                                      10690000
;                                                                       10692000
                                                                        10694000
@cb := cpr'get'cds'area(cb'size,                                        10696000
     cb'suptype'def lor ct(ct'lvl'active), 0);                          10698000
                                                                        10700000
ct(ct'lvln'cb'ptr + ct(ct'lvl'active)) := @cb;                          10702000
                                                                        10704000
end; <<cpr'init'cb>>                                                    10706000
                                                                        10708000
            <<end of routines for cpr'init'ct>>                         10710000
$PAGE "PROCEDURE: CPR'INIT'CT"                                          10712000
procedure cpr'init'ct(ctmi);                                            10714000
                                                                        10716000
  value               ctmi ;                                            10718000
                                                                        10720000
  integer             ctmi ;                                            10722000
                                                                        10724000
  option privileged, uncallable;                                        10726000
                                                                        10728000
begin                                                                   10730000
                                                                        10732000
integer pointer                                                         10734000
                ct                                                      10736000
;                                                                       10738000
double pointer                                                          10740000
               ct'd            = ct                                     10742000
;                                                                       10744000
logical pointer                                                         10746000
                ctm                                                     10748000
               ,ctm0                                                    10750000
               ,sha                                                     10752000
;                                                                       10754000
                                                                        10756000
@sha := sha'segment'offset;                                             10758000
                                                                        10760000
@ctm0 := sha(sha'ctm'ptr);                                              10762000
                                                                        10764000
@ctm := @ctm0 + integer(ctm0(ctm0'ctm'size)) * ctmi;                    10766000
                                                                        10768000
@ct := cpr'get'cds'area(ct'size'min + b08'ct'lvl'cnt,                   10770000
     ct'suptype'def, 0);                                                10772000
                                                                        10774000
if @ct = 0 then cpr'internal'error;                                     10776000
                                                                        10778000
ctm(ctm'ct'ptr) := @ct;                                                 10780000
                                                                        10782000
ct(ct'cds'dst'num) := sha(sha'cds'dst'num);                             10784000
                                                                        10786000
ct'd(ct'd'callers'db) := nul'db;                                        10788000
                                                                        10790000
ct(ct'ctmi) := ctmi;                                                    10792000
                                                                        10794000
ct(ct'lvl'cnt) := b08'ct'lvl'cnt;                                       10796000
ct(ct'vdt'ptr) := 0;                                                    10798000
                                                                        10800000
ct(ct'lvl'active) := 1;                                                 10802000
while not ( ct(ct'lvl'active) > ct(ct'lvl'cnt) ) do                     10804000
  begin                                                                 10806000
  cpr'init'cb(ct);                                                      10808000
  ct(ct'lvl'active) := ct(ct'lvl'active) + 1;                           10810000
  end;                                                                  10812000
                                                                        10814000
ct(ct'lvl'active) := 0;                                                 10816000
                                                                        10818000
end; <<cpr'init'ct>>                                                    10820000
                                                                        10822000
$PAGE "PROCEDURE: CPR'COND'CHG'LDTX"                                    10824000
procedure cpr'cond'chg'ldtx(ldev, cdda'dseg, ctmi);                     10826000
                                                                        10828000
  value                     ldev, cdda'dseg, ctmi ;                     10830000
                                                                        10832000
  integer                   ldev, cdda'dseg, ctmi ;                     10834000
                                                                        10836000
  option privileged, uncallable;                                        10838000
                                                                        10840000
begin                                                                   10842000
                                                                        10844000
COMMENT                                                                 10846000
                                                                        10848000
Purpose:  Conditionally changes the entry in the ldtx for this          10850000
ldev if the entry hasn't been initialized for CIPER.  If the            10852000
entry hasn't beeninitialized, the CIPER initialization bit is           10854000
set (word0.(2:1)), the CIPER data segment number (word1) is set         10856000
to cdda'dseg, and the CIPER control table map index (word2) is          10858000
set to ctmi.  Otherwise the data segment cdda'dseg is released          10860000
back to the system via the kernal ntrinsic reldataseg.                  10862000
                                                                        10864000
Error reporting:  No error reporting occurs.                            10866000
                                                                        10868000
External references:                                                    10870000
                     reldataseg                                         10872000
                                                                        10874000
Input:                                                                  10876000
     ldev := the logical device for which the ldtx is to be             10878000
conditionally altered.                                                  10880000
     cdda'dseg := the data segment number of a CIPER data segment       10882000
(cds) which has been initialized.                                       10884000
     ctmi := the control table map index for this logical device if     10886000
none has been assigned yet.                                             10888000
                                                                        10890000
Output: None.                                                           10892000
                                                                        10894000
Side effects:  The ldtx entry of this table is changed.                 10896000
                                                                        10898000
Special considerations:  Must be called on the user's stack.            10900000
;                                                                       10902000
                                                                        10904000
logical pointer                                                         10906000
                ldt                                                     10908000
               ,ldtx                                                    10910000
;                                                                       10912000
                                                                        10914000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            10916000
equate                                                                  10918000
       table'entry'data    = 0                                          10920000
      ,table'entry'size    = -1 + table'entry'data                      10922000
      ,table'status        = -1 + table'entry'size                      10924000
      ,table'current'entry = -1 + table'status                          10926000
      ,table'base          = -1 + table'current'entry                   10928000
      ,table'dst           = -1 + table'base                            10930000
      ,table'sir           = -1 + table'dst                             10932000
      ,table'overhead      = -table'sir                                 10934000
;                                                                       10936000
define                                                                  10938000
       table'clean         = table'status).(0:1 #                       10940000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               10942000
      ,table'auto'sir      = table'status).(1:1 #                       10944000
      ,table'getsir'save   = table'status).(2:2 #                       10946000
      ,table'type          = table'status).(13:3 #                      10948000
;                                                                       10950000
                                                                        10952000
$PAGE "UTILITY SUBROUTINE: MFDS"                                        10954000
Subroutine mfds(target, source'dseg'num, source'offset, word'cnt);      10956000
value           target, source'dseg'num, source'offset, word'cnt ;      10958000
logical pointer target                                           ;      10960000
logical                 source'dseg'num, source'offset, word'cnt ;      10962000
begin                                                                   10964000
                                                                        10966000
  assemble(stax; mfds 0; ldxa);                                         10968000
                                                                        10970000
end; <<mfds>>                                                           10972000
                                                                        10974000
                                                                        10976000
$PAGE "UTILITY SUBROUTINE: MTDS"                                        10978000
Subroutine mtds(target'dseg'num, target'offset, source, word'cnt);      10980000
value           target'dseg'num, target'offset, source, word'cnt ;      10982000
logical         target'dseg'num, target'offset,         word'cnt ;      10984000
logical pointer                                 source           ;      10986000
begin                                                                   10988000
                                                                        10990000
  assemble(stax; mtds 0; ldxa);                                         10992000
                                                                        10994000
end; <<mtds>>                                                           10996000
                                                                        10998000
                                                                        11000000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  11002000
subroutine open'table(T, dst, base, type, sir, auto'sir);               11004000
value                    dst, base, type, sir, auto'sir ;               11006000
logical pointer       T                                 ;               11008000
integer                  dst, base, type, sir           ;               11010000
logical                                        auto'sir ;               11012000
begin                                                 <<sxit return>>   11014000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           11016000
                                                                        11018000
COMMENT                                                                 11020000
                                                                        11022000
Purpose:                                                                11024000
                                                                        11026000
Error reporting:                                                        11028000
                                                                        11030000
External references:                                                    11032000
                                                                        11034000
Input:                                                                  11036000
                                                                        11038000
Output:                                                                 11040000
                                                                        11042000
Side effects:                                                           11044000
                                                                        11046000
Special considerations:  Must be called on the user's stack.            11048000
;                                                                       11050000
                                                                        11052000
  <<make some space on the stack directly under the calling             11054000
    parameters for the table'overhead area of table T of size           11056000
    table'overhead.>>                                                   11058000
assemble(lra s-0                                                        11060000
        ;stax                                                           11062000
        ;adds table'overhead <<the amount of space needed>>             11064000
        ;lra s-0  <<destination address>>                               11066000
        ;ldxa  <<source address>>                                       11068000
        ;ldni 7 <<the negative count of the parameter                   11070000
                  list size plus the return address  >>                 11072000
        ;move                                                           11074000
);                                                                      11076000
                                                                        11078000
  <<set the address of the table>>                                      11080000
assemble(lra s-6                                                        11082000
        ;stax                                                           11084000
);                                                                      11086000
@T:=x;                                                                  11088000
                                                                        11090000
  <<initialize the table's control area>>                               11092000
T(table'sir):=sir;                                                      11094000
T(table'dst):=dst;                                                      11096000
T(table'base):=base;                                                    11098000
T(table'current'entry):=0;                                              11100000
                                                                        11102000
  << T(table'status) variable >>                                        11104000
T(table'status) := 0;                                                   11106000
T(table'clean):=true;                                                   11108000
T(table'auto'sir):=auto'sir;                                            11110000
T(table'getsir'save):=0;                                                11112000
T(table'type):=type;                                                    11114000
                                                                        11116000
  << T(table'entry'size) >>                                             11118000
case T(table'type) of                                                   11120000
case'begin                                                              11122000
  << 0 := assume that the entry size is in T(table'entry'size).>>       11124000
  ;                                                                     11126000
  << 1 := MPE I/O tables (LPDT, LDT, LDTX).  The size of the table is   11128000
    the right byte of the first word.>>                                 11130000
  begin                                                                 11132000
  mfds(T(table'entry'size), T(table'dst), T(table'base), 1);            11134000
  T(table'entry'size):=T(table'entry'size).(8:8);                       11136000
  end                                                                   11138000
  ;                                                                     11140000
  << 2 := MPE memory management tables (DST, CST, XCST, PCB).  The      11142000
    size is the second word of the table.>>                             11144000
  mfds(T(table'entry'size), T(table'dst), T(table'base)+1, 1)           11146000
  ;                                                                     11148000
case'end;                                                               11150000
                                                                        11152000
  <<make some space on the stack directly under the calling             11154000
    parameters for the table'entry'data of size                         11156000
    = table(table'entry'size).>>                                        11158000
x:=T(table'entry'size);                                                 11160000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      11162000
                the return address in x.>>                              11164000
        ;adds 0 <<add the space to the stack.>>                         11166000
        ;ldxa  <<put the return address on the stack.>>                 11168000
);                                                                      11170000
                                                                        11172000
end;  <<open'table>>                                                    11174000
                                                                        11176000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   11178000
subroutine put'entry(T);                                                11180000
value                T ;                                                11182000
logical pointer      T ;                                                11184000
begin                                                                   11186000
                                                                        11188000
COMMENT                                                                 11190000
                                                                        11192000
Special considerations:  Must be called on the user's stack.            11194000
;                                                                       11196000
                                                                        11198000
if T(table'clean) then return;                                          11200000
                                                                        11202000
T(table'clean):=true;                                                   11204000
                                                                        11206000
mtds(T(table'dst),                     <<target'dseg'num>>              11208000
                                                                        11210000
     logical(integer(T(table'base)) +  <<target'offset>>                11212000
     integer(T(table'entry'size)) *                                     11214000
     integer(T(table'current'entry))),                                  11216000
                                                                        11218000
     T,                                <<source>>                       11220000
                                                                        11222000
     T(table'entry'size)               <<word'cnt>> );                  11224000
                                                                        11226000
if T(table'auto'sir) then                                               11228000
  relsir(T(table'sir), T(table'getsir'save));                           11230000
                                                                        11232000
end;  <<put'entry>>                                                     11234000
                                                                        11236000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   11238000
subroutine get'entry(T, index);                                         11240000
value                T, index ;                                         11242000
logical pointer      T        ;                                         11244000
integer                 index ;                                         11246000
begin                                                                   11248000
                                                                        11250000
COMMENT                                                                 11252000
                                                                        11254000
Special considerations:  Must be called on the user's stack.            11256000
;                                                                       11258000
                                                                        11260000
if not T(table'clean) then put'entry(T);                                11262000
                                                                        11264000
if T(table'auto'sir) then                                               11266000
  T(table'getsir'save):=getsir(T(table'sir));                           11268000
                                                                        11270000
mfds(T,                                <<target>>                       11272000
                                                                        11274000
     T(table'dst),                     <<source'dseg'num>>              11276000
                                                                        11278000
     logical(integer(T(table'base)) +  <<source'offset>>                11280000
     integer(T(table'entry'size)) *                                     11282000
     index),                                                            11284000
                                                                        11286000
     T(table'entry'size)               <<word'cnt>>);                   11288000
                                                                        11290000
T(table'current'entry):=index;                                          11292000
T(table'clean):=false;                                                  11294000
                                                                        11296000
end;  <<get'entry>>                                                     11298000
                                                                        11300000
$PAGE "PROCEDURE: CPR'COND'CHG'LDTX"                                    11302000
                                                                        11304000
  <<Open the ldt>>                                                      11306000
open'table(ldt, ldt'dst, 0 <<base>>, 1 <<type>>, ldt'sir, false);       11308000
                                                                        11310000
  <<Get the header entry>>                                              11312000
get'entry(ldt, 0);                                                      11314000
                                                                        11316000
  <<Open the ldtx with auto'sir locking>>                               11318000
open'table(ldtx, ldtx'dst,                                              11320000
     ldt(ldt0'ptr'1st'dct'ent) + ldt(ldt0'dct'size) <<base>>,           11322000
     1 <<type>>, ldtx'sir, true);                                       11324000
                                                                        11326000
  <<Get the entry of the ldev>>                                         11328000
get'entry(ldtx, ldev);                                                  11330000
                                                                        11332000
  <<Check to see if the ldev has been initialized for the CIPER         11334000
      protocol>>                                                        11336000
  <<Later a check should be made that it hasn't been initalized for     11338000
     some other type of protocol.>>                                     11340000
if not ldtx(ldtx'ciper'protocol) then                                   11342000
                                                                        11344000
    <<The ldev hasn't been initialized for a CIPER device.>>            11346000
    <<Change the entry.>>                                               11348000
  begin                                                                 11350000
  ldtx(ldtx'ciper'protocol) := true;                                    11352000
  ldtx(ldtx'cpr'cds) := cdda'dseg;                                      11354000
  ldtx(ldtx'cpr'ctmi) := ctmi;                                          11356000
  end                                                                   11358000
                                                                        11360000
else                                                                    11362000
                                                                        11364000
    <<The ldev has been initialized as a CIPER device return the        11366000
       data segment to the system.>>                                    11368000
  reldataseg(cdda'dseg);                                                11370000
                                                                        11372000
  <<Put the ldtx entry of the ldev back.>>                              11374000
put'entry(ldtx);                                                        11376000
                                                                        11378000
end; <<cpr'cond'chg'ldtx>>                                              11380000
                                                                        11382000
        <<end of routines for cpr'init'cdda'for>>                       11384000
$PAGE "PROCEDURE: CPR'INIT'CDS'FOR"                                     11386000
logical procedure cpr'init'cds'for(ldev);                               11388000
                                                                        11390000
  value                            ldev ;                               11392000
                                                                        11394000
  integer                          ldev ;                               11396000
                                                                        11398000
  option privileged, uncallable;                                        11400000
                                                                        11402000
begin                                                                   11404000
                                                                        11406000
COMMENT                                                                 11408000
                                                                        11410000
Purpose:  Creates the "ciper data segment" for ldev.  Basically         11412000
this creates the data areas but does not fill in any CIPER functional   11414000
data.                                                                   11416000
                                                                        11418000
Input:                                                                  11420000
      ldev := the logical device for which the data area is created.    11422000
                                                                        11424000
Output:                                                                 11426000
      cpr'init'cds'for := if a data segment was successfully            11428000
initialized.                                                            11430000
                                                                        11432000
Side effects:  DB is exchanged to the base of the cds for this ldev.    11434000
;                                                                       11436000
                                                                        11438000
integer                                                                 11440000
        ctmi                                                            11442000
;                                                                       11444000
double                                                                  11446000
       cds'db                                                           11448000
;                                                                       11450000
logical pointer                                                         11452000
                ctm0                                                    11454000
               ,sha                                                     11456000
;                                                                       11458000
                                                                        11460000
if not cpr'get'cds(ldev) then                                           11462000
    <<unable to get a data segment>>                                    11464000
  begin                                                                 11466000
  cpr'init'cds'for := false;                                            11468000
  return;                                                               11470000
  end;                                                                  11472000
                                                                        11474000
@sha := sha'segment'offset;                                             11476000
                                                                        11478000
@ctm0 := sha(sha'ctm'ptr);                                              11480000
                                                                        11482000
ctmi := cpr'get'ctmi(ctm0, ldev);                                       11484000
if ctmi = 0 then                                                        11486000
  begin                                                                 11488000
  cpr'init'cds'for := false;                                            11490000
  return;                                                               11492000
  end;                                                                  11494000
                                                                        11496000
cpr'init'ct(ctmi);                                                      11498000
                                                                        11500000
  <<temporarily go back to the caller's stack>>                         11502000
cds'db := changedb( 0D );                                               11504000
                                                                        11506000
  <<test and conditionally set the ldtx>>                               11508000
cpr'cond'chg'ldtx(ldev, -integer( cds'db ), ctmi);                      11510000
                                                                        11512000
cpr'init'cds'for := true;                                               11514000
                                                                        11516000
end; <<cpr'init'cds'for>>                                               11518000
                                                                        11520000
      <<end of routines for cpr'get'ct'of>>                             11522000
$PAGE "PROCEDURE: CPR'GET'CT'OF"                                        11524000
integer procedure cpr'get'ct'of(ldev, callers'db);                      11526000
                                                                        11528000
  value                         ldev, callers'db ;                      11530000
                                                                        11532000
  integer                       ldev             ;                      11534000
                                                                        11536000
  double                              callers'db ;                      11538000
                                                                        11540000
  option privileged, uncallable;                                        11542000
                                                                        11544000
begin                                                                   11546000
                                                                        11548000
COMMENT                                                                 11550000
                                                                        11552000
Purpose: Checks for the presence of a control table for this            11554000
device, if none exists then cpr'init'cdda'of(ldev) is called.           11556000
DB is changed to the base of the cds.  The address of the ct is         11558000
computed and returned.  Currently an ciper validity check is            11560000
made on the ldev, and an interference check is made on the              11562000
ct(callers'db).                                                         11564000
                                                                        11566000
Input:                                                                  11568000
     ldev := the logical device for which the control table             11570000
address is being requested.                                             11572000
                                                                        11574000
Output:                                                                 11576000
     cpr'get'ct'of := the DB (i.e. cds) relative address of the         11578000
control table of this device.                                           11580000
                                                                        11582000
Side effects:                                                           11584000
     DB is changed to the base of the cds for ldev.  The                11586000
caller's db location is saved in ct'd(ct'd'callers'db).                 11588000
;                                                                       11590000
                                                                        11592000
logical pointer <<for MPE tables>>                                      11594000
                ldt0                                                    11596000
               ,ldtx                                                    11598000
;                                                                       11600000
logical pointer                                                         11602000
                ct                                                      11604000
               ,ctm                                                     11606000
               ,ctm0                                                    11608000
               ,sha                                                     11610000
;                                                                       11612000
double pointer                                                          11614000
               ct'd            = ct                                     11616000
;                                                                       11618000
logical                                                                 11620000
        ctmi                                                            11622000
       ,debugging                                                       11624000
;                                                                       11626000
                                                                        11628000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            11630000
equate                                                                  11632000
       table'entry'data    = 0                                          11634000
      ,table'entry'size    = -1 + table'entry'data                      11636000
      ,table'status        = -1 + table'entry'size                      11638000
      ,table'current'entry = -1 + table'status                          11640000
      ,table'base          = -1 + table'current'entry                   11642000
      ,table'dst           = -1 + table'base                            11644000
      ,table'sir           = -1 + table'dst                             11646000
      ,table'overhead      = -table'sir                                 11648000
;                                                                       11650000
define                                                                  11652000
       table'clean         = table'status).(0:1 #                       11654000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               11656000
      ,table'auto'sir      = table'status).(1:1 #                       11658000
      ,table'getsir'save   = table'status).(2:2 #                       11660000
      ,table'type          = table'status).(13:3 #                      11662000
;                                                                       11664000
                                                                        11666000
$PAGE "UTILITY SUBROUTINE: MFDS"                                        11668000
Subroutine mfds(target, source'dseg'num, source'offset, word'cnt);      11670000
value           target, source'dseg'num, source'offset, word'cnt ;      11672000
logical pointer target                                           ;      11674000
logical                 source'dseg'num, source'offset, word'cnt ;      11676000
begin                                                                   11678000
                                                                        11680000
  assemble(stax; mfds 0; ldxa);                                         11682000
                                                                        11684000
end; <<mfds>>                                                           11686000
                                                                        11688000
                                                                        11690000
$PAGE "UTILITY SUBROUTINE: MTDS"                                        11692000
Subroutine mtds(target'dseg'num, target'offset, source, word'cnt);      11694000
value           target'dseg'num, target'offset, source, word'cnt ;      11696000
logical         target'dseg'num, target'offset,         word'cnt ;      11698000
logical pointer                                 source           ;      11700000
begin                                                                   11702000
                                                                        11704000
  assemble(stax; mtds 0; ldxa);                                         11706000
                                                                        11708000
end; <<mtds>>                                                           11710000
                                                                        11712000
                                                                        11714000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  11716000
subroutine open'table(T, dst, base, type, sir, auto'sir);               11718000
value                    dst, base, type, sir, auto'sir ;               11720000
logical pointer       T                                 ;               11722000
integer                  dst, base, type, sir           ;               11724000
logical                                        auto'sir ;               11726000
begin                                                 <<sxit return>>   11728000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           11730000
                                                                        11732000
COMMENT                                                                 11734000
                                                                        11736000
Purpose:                                                                11738000
                                                                        11740000
Error reporting:                                                        11742000
                                                                        11744000
External references:                                                    11746000
                                                                        11748000
Input:                                                                  11750000
                                                                        11752000
Output:                                                                 11754000
                                                                        11756000
Side effects:                                                           11758000
                                                                        11760000
Special considerations:  Must be called on the user's stack.            11762000
;                                                                       11764000
                                                                        11766000
  <<make some space on the stack directly under the calling             11768000
    parameters for the table'overhead area of table T of size           11770000
    table'overhead.>>                                                   11772000
assemble(lra s-0                                                        11774000
        ;stax                                                           11776000
        ;adds table'overhead <<the amount of space needed>>             11778000
        ;lra s-0  <<destination address>>                               11780000
        ;ldxa  <<source address>>                                       11782000
        ;ldni 7 <<the negative count of the parameter                   11784000
                  list size plus the return address  >>                 11786000
        ;move                                                           11788000
);                                                                      11790000
                                                                        11792000
  <<set the address of the table>>                                      11794000
assemble(lra s-6                                                        11796000
        ;stax                                                           11798000
);                                                                      11800000
@T:=x;                                                                  11802000
                                                                        11804000
  <<initialize the table's control area>>                               11806000
T(table'sir):=sir;                                                      11808000
T(table'dst):=dst;                                                      11810000
T(table'base):=base;                                                    11812000
T(table'current'entry):=0;                                              11814000
                                                                        11816000
  << T(table'status) variable >>                                        11818000
T(table'status) := 0;                                                   11820000
T(table'clean):=true;                                                   11822000
T(table'auto'sir):=auto'sir;                                            11824000
T(table'getsir'save):=0;                                                11826000
T(table'type):=type;                                                    11828000
                                                                        11830000
  << T(table'entry'size) >>                                             11832000
case T(table'type) of                                                   11834000
case'begin                                                              11836000
  << 0 := assume that the entry size is in T(table'entry'size).>>       11838000
  ;                                                                     11840000
  << 1 := MPE I/O tables (LPDT, LDT, LDTX).  The size of the table is   11842000
    the right byte of the first word.>>                                 11844000
  begin                                                                 11846000
  mfds(T(table'entry'size), T(table'dst), T(table'base), 1);            11848000
  T(table'entry'size):=T(table'entry'size).(8:8);                       11850000
  end                                                                   11852000
  ;                                                                     11854000
  << 2 := MPE memory management tables (DST, CST, XCST, PCB).  The      11856000
    size is the second word of the table.>>                             11858000
  mfds(T(table'entry'size), T(table'dst), T(table'base)+1, 1)           11860000
  ;                                                                     11862000
case'end;                                                               11864000
                                                                        11866000
  <<make some space on the stack directly under the calling             11868000
    parameters for the table'entry'data of size                         11870000
    = table(table'entry'size).>>                                        11872000
x:=T(table'entry'size);                                                 11874000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      11876000
                the return address in x.>>                              11878000
        ;adds 0 <<add the space to the stack.>>                         11880000
        ;ldxa  <<put the return address on the stack.>>                 11882000
);                                                                      11884000
                                                                        11886000
end;  <<open'table>>                                                    11888000
                                                                        11890000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   11892000
subroutine put'entry(T);                                                11894000
value                T ;                                                11896000
logical pointer      T ;                                                11898000
begin                                                                   11900000
                                                                        11902000
COMMENT                                                                 11904000
                                                                        11906000
Special considerations:  Must be called on the user's stack.            11908000
;                                                                       11910000
                                                                        11912000
if T(table'clean) then return;                                          11914000
                                                                        11916000
T(table'clean):=true;                                                   11918000
                                                                        11920000
mtds(T(table'dst),                     <<target'dseg'num>>              11922000
                                                                        11924000
     logical(integer(T(table'base)) +  <<target'offset>>                11926000
     integer(T(table'entry'size)) *                                     11928000
     integer(T(table'current'entry))),                                  11930000
                                                                        11932000
     T,                                <<source>>                       11934000
                                                                        11936000
     T(table'entry'size)               <<word'cnt>> );                  11938000
                                                                        11940000
if T(table'auto'sir) then                                               11942000
  relsir(T(table'sir), T(table'getsir'save));                           11944000
                                                                        11946000
end;  <<put'entry>>                                                     11948000
                                                                        11950000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   11952000
subroutine get'entry(T, index);                                         11954000
value                T, index ;                                         11956000
logical pointer      T        ;                                         11958000
integer                 index ;                                         11960000
begin                                                                   11962000
                                                                        11964000
COMMENT                                                                 11966000
                                                                        11968000
Special considerations:  Must be called on the user's stack.            11970000
;                                                                       11972000
                                                                        11974000
if not T(table'clean) then put'entry(T);                                11976000
                                                                        11978000
if T(table'auto'sir) then                                               11980000
  T(table'getsir'save):=getsir(T(table'sir));                           11982000
                                                                        11984000
mfds(T,                                <<target>>                       11986000
                                                                        11988000
     T(table'dst),                     <<source'dseg'num>>              11990000
                                                                        11992000
     logical(integer(T(table'base)) +  <<source'offset>>                11994000
     integer(T(table'entry'size)) *                                     11996000
     index),                                                            11998000
                                                                        12000000
     T(table'entry'size)               <<word'cnt>>);                   12002000
                                                                        12004000
T(table'current'entry):=index;                                          12006000
T(table'clean):=false;                                                  12008000
                                                                        12010000
end;  <<get'entry>>                                                     12012000
                                                                        12014000
$PAGE "PROCEDURE: CPR'GET'CT'OF"                                        12016000
    <<open the ldt>>                                                    12018000
  open'table(ldt0, ldt'dst, 0 << base >>, 1 << table'type >>,           12020000
       ldt'sir, false << auto'sir >> );                                 12022000
                                                                        12024000
    <<get the header entry>>                                            12026000
  get'entry(ldt0, 0);                                                   12028000
                                                                        12030000
    <<open the ldtx>>                                                   12032000
  open'table(ldtx, ldtx'dst, ldtx'base << base >>,                      12034000
       1 << table'type >>, ldtx'sir, false << auto'sir >> );            12036000
                                                                        12038000
    <<get the entry of the ldev>>                                       12040000
  get'entry(ldtx, ldev);                                                12042000
                                                                        12044000
  if not ldtx(ldtx'ciper'protocol) then                                 12046000
      <<no data segment allocated yet (i.e. must initialize)>>          12048000
    begin                                                               12050000
                                                                        12052000
    if not cpr'init'cds'for(ldev) then                                  12054000
        <<no data segment available>>                                   12056000
      go to error'exit;                                                 12058000
                                                                        12060000
      <<update the local copy of the ldtx for this ldev>>               12062000
    ldtx(table'clean) := true; <<disarm put'entry>>                     12064000
    get'entry(ldtx, ldev);                                              12066000
                                                                        12068000
    end;                                                                12070000
                                                                        12072000
  if ldtx(ldtx'cpr'is'shutdown) then                                    12074000
       << a cpr'shutdown type of error has occured in the    >>         12076000
    << ciper subsystem for this device, no more transctions  >>         12078000
    << can take place until the ciper subsystem for this     >>         12080000
    << device is reinitialized. >>                                      12082000
    go to error'exit;                                                   12084000
                                                                        12086000
    <<get a local copy of ctmi>>                                        12088000
  ctmi := ldtx(ldtx'cpr'ctmi);                                          12090000
                                                                        12092000
    <<get a local copy of the debugging flag>>                          12094000
  debugging := ldtx(ldtx'debugging);                                    12096000
                                                                        12098000
    <<change DB to data segment>>                                       12100000
  changedb( double( -integer( ldtx(ldtx'cpr'cds) ) ) );                 12102000
                                                                        12104000
    <<find @ct>>                                                        12106000
  @sha:=sha'segment'offset;                                             12108000
  @ctm0:=sha(sha'ctm'ptr);                                              12110000
                                                                        12112000
  @ctm:=@ctm0(ctm0(ctm0'ctm'size) * ctmi);                              12114000
                                                                        12116000
  @ct:=ctm(ctm'ct'ptr);                                                 12118000
                                                                        12120000
  cpr'lock'cds'area(ct);                                                12122000
                                                                        12124000
    << check that this is the correct ldev >>                           12126000
  cpr'assertion( integer(ctm(ctm'ldev)) = ldev );                       12128000
                                                                        12130000
    << check that no one else is using this device now! >>              12132000
  cpr'assertion( ct'd(ct'd'callers'db) = nul'db );                      12134000
                                                                        12136000
    << check that ciper isn't executing any level >>                    12138000
  cpr'assertion( ct(ct'lvl'active) = 0 );                               12140000
                                                                        12142000
  ct'd(ct'd'callers'db) := callers'db;                                  12144000
                                                                        12146000
  ct(ct'callers'stk) := abs( abs( 4 <<cpcb>> ) + 3 ).(1:10);            12148000
                                             << stk dst # >>            12150000
                                                                        12152000
  mfds( ct(ct'callers'stk'db), ct(ct'callers'stk), 1, 1);               12154000
                                                                        12156000
  cpr'get'ct'of := if debugging then -@ct else @ct;                     12158000
                                                                        12160000
return;                                                                 12162000
                                                                        12164000
error'exit:                                                             12166000
                                                                        12168000
  cpr'get'ct'of := 0; << indicates an error occured >>                  12170000
                                                                        12172000
  changedb( callers'db ); << get back to where we came in on >>         12174000
                                                                        12176000
end; <<cpr'get'ct'of>>                                                  12178000
                                                                        12180000
$PAGE "PROCEDURE: CPR'CB'OF"                                            12182000
integer procedure cpr'cb'of(ct, level);                                 12184000
                                                                        12186000
  value                     ct, level ;                                 12188000
                                                                        12190000
  logical pointer           ct        ;                                 12192000
                                                                        12194000
  integer                       level ;                                 12196000
                                                                        12198000
  option privileged, uncallable;                                        12200000
                                                                        12202000
begin                                                                   12204000
                                                                        12206000
COMMENT                                                                 12208000
                                                                        12210000
Purpose: Get the cds relative address of the control block              12212000
from the given control table for an CIPER internal                      12214000
implementation level.                                                   12216000
                                                                        12218000
Error reporting: cpr'internal'error is called if level is invalid.      12220000
                                                                        12222000
External references:                                                    12224000
                     cpr'internal'error                                 12226000
                                                                        12228000
Input:                                                                  12230000
     ct := the cds relative pointer of the control table.               12232000
     level := the CIPER implementation level for which the control      12234000
block address is being requested.  If the level isn't valid then        12236000
cpr'internal'error is called.                                           12238000
                                                                        12240000
Output:                                                                 12242000
     cpr'cb'of := the cds relative address of the control block         12244000
from ct and for the level specified.                                    12246000
                                                                        12248000
Side effects:  ct(ct'lvl'active) (i.e. the level currently active       12250000
of ciper'engine) is set to level.                                       12252000
                                                                        12254000
Special considerations:  Must be called with DB at the cds.             12256000
;                                                                       12258000
                                                                        12260000
$PAGE                                                                   12262000
                                                                        12264000
if not ( 1 <= level <= integer(ct(ct'lvl'cnt)) ) then                   12266000
  cpr'internal'error;                                                   12268000
                                                                        12270000
ct(ct'lvl'active) := level;                                             12272000
                                                                        12274000
cpr'cb'of := ct(ct'lvln'cb'ptr + level);                                12276000
                                                                        12278000
end; <<cpr'cb'of>>                                                      12280000
                                                                        12282000
$PAGE "PROCEDURE: CPR'REL'CT"                                           12284000
procedure cpr'rel'ct(ct, callers'db);                                   12286000
                                                                        12288000
  value              ct, callers'db ;                                   12290000
                                                                        12292000
  logical pointer    ct             ;                                   12294000
                                                                        12296000
  double                 callers'db ;                                   12298000
                                                                        12300000
  option privileged, uncallable;                                        12302000
                                                                        12304000
begin                                                                   12306000
                                                                        12308000
COMMENT                                                                 12310000
                                                                        12312000
Purpose: DB is changed back to the caller's original data segment.      12314000
                                                                        12316000
Input:                                                                  12318000
     ct := the pointer to the ct which is to be released.               12320000
                                                                        12322000
Output:                                                                 12324000
                                                                        12326000
Side effects:  DB is changed back to the caller's original data         12328000
segment.                                                                12330000
;                                                                       12332000
                                                                        12334000
double pointer                                                          12336000
               ct'd            = ct                                     12338000
;                                                                       12340000
                                                                        12342000
ct(ct'lvl'active) := 0;                                                 12344000
                                                                        12346000
ct'd(ct'd'callers'db) := nul'db;                                        12348000
ct(ct'callers'stk) := 0;                                                12350000
ct(ct'callers'stk'db) := 0;                                             12352000
                                                                        12354000
cpr'unlock'cds'area(ct);                                                12356000
                                                                        12358000
changedb(callers'db);                                                   12360000
                                                                        12362000
end; <<cpr'rel'ct>>                                                     12364000
                                                                        12366000
    <<Include file for communication queue routines>>                   12368000
$PAGE "PROCEDURE: T'DELINK'SON'DOWN"                                    12370000
procedure t'delink'son'down(father, end'ptr, son, next'son'ptr);        12372000
                                                                        12374000
  value                     father, end'ptr, son, next'son'ptr ;        12376000
                                                                        12378000
  logical pointer           father,          son               ;        12380000
                                                                        12382000
  integer                           end'ptr,      next'son'ptr ;        12384000
                                                                        12386000
  option privileged, uncallable;                                        12388000
                                                                        12390000
begin                                                                   12392000
                                                                        12394000
if end'ptr <> nil then                                                  12396000
  if @father <> nil then                                                12398000
    father(end'ptr) :=                                                  12400000
       if next'son'ptr <> nil and @son <> nil then                      12402000
         son(next'son'ptr)                                              12404000
       else                                                             12406000
         nil;                                                           12408000
                                                                        12410000
end; <<t'delink'son'down>>                                              12412000
                                                                        12414000
$PAGE "PROCEDURE: T'DELINK'SON'SIDE"                                    12416000
procedure t'delink'son'side(father, end2'ptr,                           12418000
                            son, side1'ptr, side2'ptr);                 12420000
                                                                        12422000
  value                     father, end2'ptr,                           12424000
                            son, side1'ptr, side2'ptr ;                 12426000
                                                                        12428000
  logical pointer           father,                                     12430000
                            son                       ;                 12432000
                                                                        12434000
  integer                           end2'ptr,                           12436000
                                 side1'ptr, side2'ptr ;                 12438000
                                                                        12440000
  option privileged, uncallable;                                        12442000
                                                                        12444000
begin                                                                   12446000
                                                                        12448000
logical pointer                                                         12450000
                end2            <<secondary end pointer>>               12452000
               ,side1           <<primary side pointer>>                12454000
               ,side2           <<secondary side pointer>>              12456000
;                                                                       12458000
                                                                        12460000
if side2'ptr <> nil then                                                12462000
  if side1'ptr <> nil then                                              12464000
    begin                                                               12466000
    @side1 := son(side1'ptr);                                           12468000
    side1(side2'ptr) := nil;                                            12470000
    end                                                                 12472000
  else                                                                  12474000
    if end2'ptr <> nil then                                             12476000
      begin                                                             12478000
      @end2 := father(end2'ptr);                                        12480000
      if @end2 <> nil then                                              12482000
        begin                                                           12484000
        @side2 := @end2;                                                12486000
        while integer( side2( side2'ptr ) ) <> @son do                  12488000
          @side2 := side2(side2'ptr);                                   12490000
        side2(side2'ptr) := nil;                                        12492000
        end;                                                            12494000
      end;                                                              12496000
                                                                        12498000
end; <<t'delink'son'side>>                                              12500000
                                                                        12502000
$PAGE "PROCEDURE: T'DELINK'SON'UP"                                      12504000
procedure t'delink'son'up(son, father'ptr);                             12506000
                                                                        12508000
  value                   son, father'ptr ;                             12510000
                                                                        12512000
  logical pointer         son             ;                             12514000
                                                                        12516000
  integer                      father'ptr ;                             12518000
                                                                        12520000
  option privileged, uncallable;                                        12522000
                                                                        12524000
begin                                                                   12526000
                                                                        12528000
if father'ptr <> nil then                                               12530000
  son(father'ptr) := nil;                                               12532000
                                                                        12534000
end; <<t'delink'son'up>>                                                12536000
                                                                        12538000
$PAGE "PROCEDURE: T'LINK'SON'DOWN"                                      12540000
procedure t'link'son'down(father, end'ptr, new'son);                    12542000
                                                                        12544000
  value                   father, end'ptr, new'son ;                    12546000
                                                                        12548000
  logical pointer         father,          new'son ;                    12550000
                                                                        12552000
  integer                         end'ptr          ;                    12554000
                                                                        12556000
  option privileged, uncallable;                                        12558000
                                                                        12560000
begin                                                                   12562000
                                                                        12564000
if end'ptr <> nil then                                                  12566000
  if father(end'ptr) = nil then                                         12568000
    father(end'ptr) := @new'son;                                        12570000
                                                                        12572000
end; <<t'link'son'down>>                                                12574000
                                                                        12576000
$PAGE "PROCEDURE: T'LINK'SON'SIDE"                                      12578000
procedure t'link'son'side(father, end1'ptr, end2'ptr,                   12580000
                          new'son, side1'ptr         );                 12582000
                                                                        12584000
  value                   father, end1'ptr, end2'ptr,                   12586000
                          new'son, side1'ptr          ;                 12588000
                                                                        12590000
  logical pointer         father,                                       12592000
                          new'son                     ;                 12594000
                                                                        12596000
  integer                         end1'ptr, end2'ptr,                   12598000
                                   side1'ptr          ;                 12600000
                                                                        12602000
  option privileged, uncallable;                                        12604000
                                                                        12606000
begin                                                                   12608000
                                                                        12610000
logical pointer                                                         12612000
                end1 <<primary end pointer>>                            12614000
               ,end2 <<secondary end pointer>>                          12616000
               ,side1 <<primary side pointer>>                          12618000
;                                                                       12620000
                                                                        12622000
if side1'ptr <> nil then                                                12624000
  if end1'ptr <> nil then                                               12626000
    begin                                                               12628000
    @end1 := father(end1'ptr);                                          12630000
    end1(side1'ptr) := @new'son;                                        12632000
    end                                                                 12634000
  else                                                                  12636000
    if end2'ptr <> nil then                                             12638000
      begin                                                             12640000
      @end2 := father(end2'ptr);                                        12642000
      if @end2 <> nil then                                              12644000
        begin                                                           12646000
        @end1 := @end2;                                                 12648000
        while end1(side1'ptr) <> nil do                                 12650000
          @end1 := end1(side1'ptr);                                     12652000
        end2(side1'ptr) := @new'son;                                    12654000
        end;                                                            12656000
      end;                                                              12658000
                                                                        12660000
end; <<t'link'son'side>>                                                12662000
                                                                        12664000
$PAGE "PROCEDURE: T'LINK'SON'UP"                                        12666000
procedure t'link'son'up(father, new'son, father'ptr);                   12668000
                                                                        12670000
  value                 father, new'son, father'ptr ;                   12672000
                                                                        12674000
  logical pointer       father, new'son             ;                   12676000
                                                                        12678000
  integer                                father'ptr ;                   12680000
                                                                        12682000
  option privileged, uncallable;                                        12684000
                                                                        12686000
begin                                                                   12688000
                                                                        12690000
if father'ptr <> nil then                                               12692000
  new'son(father'ptr) := @father;                                       12694000
                                                                        12696000
end; <<t'link'son'up>>                                                  12698000
                                                                        12700000
$PAGE "PROCEDURE: CPR'INIT'COMQ"                                        12702000
procedure cpr'init'comq(cb, number, size);                              12704000
                                                                        12706000
  value                 cb, number, size ;                              12708000
                                                                        12710000
  logical pointer       cb               ;                              12712000
                                                                        12714000
  integer                   number, size ;                              12716000
                                                                        12718000
  option privileged, uncallable;                                        12720000
                                                                        12722000
begin                                                                   12724000
                                                                        12726000
COMMENT                                                                 12728000
                                                                        12730000
Purpose:  Initializes the communication queue (comq) for a given        12732000
control block.                                                          12734000
;                                                                       12736000
                                                                        12738000
integer counter;                                                        12740000
                                                                        12742000
logical pointer                                                         12744000
                qe                                                      12746000
               ,qe'                                                     12748000
               ,qh                                                      12750000
;                                                                       12752000
                                                                        12754000
  <<get the queue header (qh)>>                                         12756000
@qh := cpr'get'cds'area(qh'size,                                        12758000
     (qh'suptype'def lor cb(cds'area'subtype)), 0);                     12760000
                                                                        12762000
  <<link the qh into the cb>>                                           12764000
cb(cb'qh'ptr) := @qh;                                                   12766000
                                                                        12768000
  <<compute the size of each qe>>                                       12770000
qh(qh'qe'size) := qe'size'min + size;                                   12772000
                                                                        12774000
cpr'assertion(number >= 0);                                             12776000
                                                                        12778000
qh(qh'free'cnt) := 0;                                                   12780000
                                                                        12782000
while integer(qh(qh'free'cnt)) <> number do                             12784000
  begin                                                                 12786000
                                                                        12788000
  @qe := cpr'get'cds'area(qh(qh'qe'size),                               12790000
       (qe'suptype'def lor cb(cds'area'subtype)), 0);                   12792000
                                                                        12794000
  @qe' := qh(qh'free'list'ptr);                                         12796000
                                                                        12798000
  qh(qh'free'list'ptr) := @qe;                                          12800000
                                                                        12802000
  qe(qe'next'free'ptr) := @qe';                                         12804000
                                                                        12806000
  qh(qh'free'cnt) := qh(qh'free'cnt) + 1;                               12808000
  end;                                                                  12810000
                                                                        12812000
end; <<cpr'init'comq>>                                                  12814000
                                                                        12816000
$PAGE "PROCEDURE: CPR'GET'QH'OF"                                        12818000
logical procedure cpr'get'qh'of(ct);                                    12820000
                                                                        12822000
  value                         ct ;                                    12824000
                                                                        12826000
  logical pointer               ct ;                                    12828000
                                                                        12830000
  option privileged, uncallable;                                        12832000
                                                                        12834000
begin                                                                   12836000
                                                                        12838000
COMMENT                                                                 12840000
                                                                        12842000
;                                                                       12844000
                                                                        12846000
logical pointer                                                         12848000
                cb                                                      12850000
;                                                                       12852000
                                                                        12854000
cpr'assertion( ct'suptype'def = ct(cds'area'suptype) );                 12856000
                                                                        12858000
@cb := ct(ct'lvl'active'ptr);                                           12860000
                                                                        12862000
cpr'get'qh'of := cb(cb'qh'ptr);                                         12864000
                                                                        12866000
end; <<cpr'get'qh'of>>                                                  12868000
                                                                        12870000
$PAGE "PROCEDURE: CPR'GET'QE"                                           12872000
logical procedure cpr'get'qe(ct);                                       12874000
                                                                        12876000
  value                      ct ;                                       12878000
                                                                        12880000
  logical pointer            ct ;                                       12882000
                                                                        12884000
  option privileged, uncallable;                                        12886000
                                                                        12888000
begin                                                                   12890000
                                                                        12892000
COMMENT                                                                 12894000
                                                                        12896000
Purpose:  Removes a comq from the free list.  Updates qh'free'cnt,      12898000
qh'inuse'cnt, and qh'max'inuse'cnt.                                     12900000
;                                                                       12902000
                                                                        12904000
logical pointer                                                         12906000
                qe                                                      12908000
               ,qh                                                      12910000
;                                                                       12912000
                                                                        12914000
@qh := cpr'get'qh'of(ct);                                               12916000
                                                                        12918000
cpr'lock'cds'area(qh);                                                  12920000
                                                                        12922000
  if qh(qh'free'list'ptr) = 0 then cpr'limit'error;                     12924000
                                                                        12926000
  @qe := qh(qh'free'list'ptr);                                          12928000
                                                                        12930000
  qh(qh'free'list'ptr) := qe(qe'next'free'ptr);                         12932000
                                                                        12934000
    <<adjust measurement data>>                                         12936000
  qh(qh'inuse'cnt) := qh(qh'inuse'cnt) + 1;                             12938000
                                                                        12940000
  qh(qh'free'cnt) := qh(qh'free'cnt) - 1;                               12942000
                                                                        12944000
  if qh(qh'inuse'cnt) > qh(qh'max'inuse'cnt) then                       12946000
    qh(qh'max'inuse'cnt) := qh(qh'inuse'cnt);                           12948000
                                                                        12950000
cpr'unlock'cds'area(qh);                                                12952000
                                                                        12954000
  <<clean out the comq 's control information>>                         12956000
qe  := 0;                                                               12958000
move qe(1) := qe, (qh(qh'qe'size) -1);                                  12960000
                                                                        12962000
  <<return the comq 's address>>                                        12964000
cpr'get'qe := @qe;                                                      12966000
                                                                        12968000
end; <<cpr'get'qe>>                                                     12970000
                                                                        12972000
$PAGE "PROCEDURE: CPR'REL'QE"                                           12974000
procedure cpr'rel'qe(ct, qe);                                           12976000
                                                                        12978000
  value              ct, qe ;                                           12980000
                                                                        12982000
  logical pointer    ct, qe ;                                           12984000
                                                                        12986000
  option privileged, uncallable;                                        12988000
                                                                        12990000
begin                                                                   12992000
                                                                        12994000
COMMENT                                                                 12996000
                                                                        12998000
;                                                                       13000000
logical pointer                                                         13002000
                qh                                                      13004000
;                                                                       13006000
                                                                        13008000
@qh := cpr'get'qh'of(ct);                                               13010000
                                                                        13012000
cpr'assertion( qh(cds'area'subtype) = qe(cds'area'subtype));            13014000
                                                                        13016000
cpr'lock'cds'area(qh);                                                  13018000
                                                                        13020000
  qe(qe'next'free'ptr) := qh(qh'free'list'ptr);                         13022000
                                                                        13024000
  qh(qh'free'list'ptr) := @qe;                                          13026000
                                                                        13028000
  qh(qh'free'cnt) := qh(qh'free'cnt) + 1;                               13030000
                                                                        13032000
  qh(qh'inuse'cnt) := qh(qh'inuse'cnt) - 1;                             13034000
                                                                        13036000
cpr'unlock'cds'area(qh);                                                13038000
                                                                        13040000
end; <<cpr'rel'qe>>                                                     13042000
                                                                        13044000
$PAGE "PROCEDURE: CPR'CQ'ADD'SON"                                       13046000
procedure cpr'cq'add'son(father, first'ptr, last'ptr,                   13048000
                         new'son, prev'ptr, next'ptr,                   13050000
                         father'ptr                  );                 13052000
                                                                        13054000
  value                  father, first'ptr, last'ptr,                   13056000
                         new'son, prev'ptr, next'ptr,                   13058000
                         father'ptr                   ;                 13060000
                                                                        13062000
  logical                father,                                        13064000
                         new'son                                        13066000
                                                      ;                 13068000
                                                                        13070000
  integer                        first'ptr, last'ptr,                   13072000
                                  prev'ptr, next'ptr,                   13074000
                         father'ptr                   ;                 13076000
                                                                        13078000
  option privileged, uncallable;                                        13080000
                                                                        13082000
begin                                                                   13084000
                                                                        13086000
  << Link the son as the last son's next brother link              >>   13088000
  << (i.e. the NEXT-LINK)                                          >>   13090000
t'link'son'side(father, last'ptr, nil,                                  13092000
                new'son,  next'ptr);                                    13094000
                                                                        13096000
  << Link the son as the father's last son.  (LAST-LINK)           >>   13098000
t'link'son'down(father, last'ptr, new'son);                             13100000
                                                                        13102000
  << Link the son as the father's first son.  (FIRST-LINK)         >>   13104000
t'link'son'down(father, first'ptr, new'son);                            13106000
                                                                        13108000
  << Link the father as the father of the son.  (FATHER-LINK)      >>   13110000
t'link'son'up(father, new'son, father'ptr);                             13112000
                                                                        13114000
end; <<cpr'cq'add'son>>                                                 13116000
                                                                        13118000
$PAGE "PROCEDURE: CPR'CQ'DEL'SON"                                       13120000
procedure cpr'cq'del'son(father, first'ptr, last'ptr,                   13122000
                         son, prev'ptr, next'ptr,                       13124000
                         father'ptr                  );                 13126000
                                                                        13128000
  value                  father, first'ptr, last'ptr,                   13130000
                         son, prev'ptr, next'ptr,                       13132000
                         father'ptr                   ;                 13134000
                                                                        13136000
  logical pointer        father,                                        13138000
                         son                                            13140000
                                                      ;                 13142000
                                                                        13144000
  integer                        first'ptr, last'ptr,                   13146000
                              prev'ptr, next'ptr,                       13148000
                         father'ptr                   ;                 13150000
                                                                        13152000
  option privileged, uncallable;                                        13154000
                                                                        13156000
begin                                                                   13158000
                                                                        13160000
  << Delink the son as the second son's previous brother.     >>        13162000
  << (i.e. the PREV-LINK)                                     >>        13164000
t'delink'son'side(father, last'ptr,                                     13166000
                  son, next'ptr, prev'ptr);                             13168000
                                                                        13170000
  << Delink the son as the father's first son. (FIRST-LINK)   >>        13172000
t'delink'son'down(father, first'ptr, son, next'ptr);                    13174000
                                                                        13176000
  << Delink the son as the father's last son. (LAST-LINK)     >>        13178000
t'delink'son'down(father, last'ptr, son, prev'ptr);                     13180000
                                                                        13182000
  << Delink the father as the father of the son. (FATHER-LINK)>>        13184000
t'delink'son'up(son, father'ptr);                                       13186000
                                                                        13188000
end; <<cpr'cq'del'son>>                                                 13190000
                                                                        13192000
$PAGE "PROCEDURE: CPR'REQUEST'TRANSMIT"                                 13194000
procedure cpr'request'transmit(ct, request'qe, father'qe);              13196000
                                                                        13198000
  value                        ct, request'qe, father'qe ;              13200000
                                                                        13202000
  logical pointer              ct, request'qe, father'qe ;              13204000
                                                                        13206000
  option privileged, uncallable;                                        13208000
                                                                        13210000
begin                                                                   13212000
                                                                        13214000
logical pointer                                                         13216000
                qh                                                      13218000
;                                                                       13220000
                                                                        13222000
@qh := cpr'get'qh'of(ct);                                               13224000
                                                                        13226000
cpr'lock'cds'area(qh);                                                  13228000
                                                                        13230000
    <<Add the request'qe to the comq relational (family) links.>>       13232000
  cpr'cq'add'son(father'qe, qe'head'son'ptr, qe'tail'son'ptr,           13234000
                  request'qe, qe'head'brother'ptr, qe'tail'brother'ptr, 13236000
                  qe'father'ptr);                                       13238000
                                                                        13240000
    <<Add the request'qe to the comq sequential (queue) links.>>        13242000
  cpr'cq'add'son(qh, qh'head'request'qe'ptr, qh'tail'request'qe'ptr,    13244000
                  request'qe, qe'head'qe'ptr, qe'tail'qe'ptr,           13246000
                  qe'qh'ptr);                                           13248000
                                                                        13250000
cpr'unlock'cds'area(qh);                                                13252000
                                                                        13254000
end; <<cpr'request'transmit>>                                           13256000
                                                                        13258000
$PAGE "PROCEDURE: CPR'REQUEST'RECEIVE"                                  13260000
logical procedure cpr'request'receive(ct);                              13262000
                                                                        13264000
  value                               ct ;                              13266000
                                                                        13268000
  logical pointer                     ct ;                              13270000
                                                                        13272000
  option privileged, uncallable;                                        13274000
                                                                        13276000
begin                                                                   13278000
                                                                        13280000
logical pointer                                                         13282000
                qh                                                      13284000
               ,request'qe                                              13286000
;                                                                       13288000
                                                                        13290000
@qh := cpr'get'qh'of(ct);                                               13292000
                                                                        13294000
cpr'lock'cds'area(qh);                                                  13296000
                                                                        13298000
  @request'qe := qh( qh'head'request'qe'ptr );                          13300000
                                                                        13302000
  if @request'qe <> nil then                                            13304000
                                                                        13306000
    cpr'cq'del'son(qh, qh'head'request'qe'ptr, qh'tail'request'qe'ptr,  13308000
                   request'qe, qe'head'qe'ptr, qe'tail'qe'ptr,          13310000
                   qe'qh'ptr);                                          13312000
                                                                        13314000
cpr'unlock'cds'area(qh);                                                13316000
                                                                        13318000
cpr'request'receive := @request'qe;                                     13320000
                                                                        13322000
end; <<cpr'request'receive>>                                            13324000
                                                                        13326000
$PAGE "PROCEDURE: CPR'RESPONSE'TRANSMIT"                                13328000
procedure cpr'response'transmit(response'qe);                           13330000
                                                                        13332000
  value                         response'qe ;                           13334000
                                                                        13336000
  logical pointer               response'qe ;                           13338000
                                                                        13340000
  option privileged, uncallable;                                        13342000
                                                                        13344000
begin                                                                   13346000
                                                                        13348000
logical pointer                                                         13350000
                qh                                                      13352000
;                                                                       13354000
                                                                        13356000
@qh := response'qe( qe'qh'ptr );                                        13358000
                                                                        13360000
cpr'lock'cds'area(qh);                                                  13362000
                                                                        13364000
     <<Add the response'qe to the comq sequential (queue) links.>>      13366000
  cpr'cq'add'son(qh, qh'head'response'qe'ptr, qh'tail'response'qe'ptr,  13368000
                 response'qe, qe'head'qe'ptr, qe'tail'qe'ptr,           13370000
                 nil);                                                  13372000
                                                                        13374000
cpr'unlock'cds'area(qh);                                                13376000
                                                                        13378000
end; <<cpr'response'transmit>>                                          13380000
                                                                        13382000
$PAGE "PROCEDURE: CPR'RESPONSE'RECEIVE"                                 13384000
logical procedure cpr'response'receive(ct);                             13386000
                                                                        13388000
  value                                ct ;                             13390000
                                                                        13392000
  logical pointer                      ct ;                             13394000
                                                                        13396000
  option privileged, uncallable;                                        13398000
                                                                        13400000
begin                                                                   13402000
                                                                        13404000
logical pointer                                                         13406000
                qh                                                      13408000
               ,response'qe                                             13410000
;                                                                       13412000
                                                                        13414000
@qh := cpr'get'qh'of(ct);                                               13416000
                                                                        13418000
cpr'lock'cds'area(qh);                                                  13420000
                                                                        13422000
  @response'qe := qh( qh'head'response'qe'ptr );                        13424000
                                                                        13426000
  if @response'qe <> nil then                                           13428000
                                                                        13430000
  cpr'cq'del'son(qh, qh'head'response'qe'ptr, qh'tail'response'qe'ptr,  13432000
                   response'qe, qe'head'qe'ptr, qe'tail'qe'ptr,         13434000
                   qe'qh'ptr);                                          13436000
                                                                        13438000
cpr'unlock'cds'area(qh);                                                13440000
                                                                        13442000
cpr'response'receive := @response'qe;                                   13444000
                                                                        13446000
end; <<cpr'response'receive>>                                           13448000
                                                                        13450000
                                                                        13452000
    <<end of routines for cpr'engine>>                                  13454000
<<$INCLUDE engine.B2608.OConnor <<cpr'engine>>                          13456000
                                                                        13458000
  <<generic routines called by each ciper level>>                       13460000
$PAGE "PROCEDURE: CPR'INIT'CBI"                                         13462000
integer procedure cpr'init'cbi(cb, size);                               13464000
                                                                        13466000
  value                        cb, size ;                               13468000
                                                                        13470000
  logical pointer              cb       ;                               13472000
                                                                        13474000
  integer                          size ;                               13476000
                                                                        13478000
  option privileged, uncallable;                                        13480000
                                                                        13482000
begin                                                                   13484000
                                                                        13486000
COMMENT                                                                 13488000
                                                                        13490000
Purpose: Create, initialize, and link a cbi into the cb.                13492000
                                                                        13494000
Input:                                                                  13496000
     cb := pointer to control block for which this cbi is for.          13498000
     size := size of the cbi.                                           13500000
                                                                        13502000
Output:                                                                 13504000
     cpr'init'cbi := pointer to the cbi.                                13506000
;                                                                       13508000
                                                                        13510000
logical pointer                                                         13512000
                cbi                                                     13514000
;                                                                       13516000
                                                                        13518000
if cb(cb'info'ptr) <> 0 then cpr'internal'error;                        13520000
                                                                        13522000
@cbi := cpr'get'cds'area(size,                                          13524000
     (cbi'suptype'def lor cb(cds'area'subtype)), 0);                    13526000
                                                                        13528000
cb(cb'info'ptr) := @cbi;                                                13530000
                                                                        13532000
cpr'init'cbi := @cbi;                                                   13534000
                                                                        13536000
end; <<cpr'init'cbi>>                                                   13538000
                                                                        13540000
$PAGE "PROCEDURE: CPR'INIT'CBIX"                                        13542000
integer procedure cpr'init'cbix(cb, size);                              13544000
                                                                        13546000
  value                         cb, size ;                              13548000
                                                                        13550000
  logical pointer               cb       ;                              13552000
                                                                        13554000
  integer                           size ;                              13556000
                                                                        13558000
  option privileged, uncallable;                                        13560000
                                                                        13562000
begin                                                                   13564000
                                                                        13566000
COMMENT                                                                 13568000
                                                                        13570000
Purpose: Create and initialize a cbix.                                  13572000
                                                                        13574000
Input:                                                                  13576000
     cb := pointer to control block for which this cbix is for.         13578000
     size := size of the cbix.                                          13580000
                                                                        13582000
Output:                                                                 13584000
     cpr'init'cbix := pointer to the cbix.                              13586000
;                                                                       13588000
                                                                        13590000
logical pointer                                                         13592000
                cbix                                                    13594000
;                                                                       13596000
                                                                        13598000
@cbix := cpr'get'cds'area(size,                                         13600000
     (cbix'suptype'def lor cb(cds'area'subtype)), 0);                   13602000
                                                                        13604000
cpr'init'cbix := @cbix;                                                 13606000
                                                                        13608000
end; <<cpr'init'cbix>>                                                  13610000
                                                                        13612000
$PAGE "PROCEDURE:  HASH'FUNCTION'CODE"                                  13614000
integer procedure b08'hash'function'code(function);                     13616000
                                                                        13618000
  value                                  function ;                     13620000
                                                                        13622000
  integer                                function ;                     13624000
                                                                        13626000
  option privileged, uncallable                   ;                     13628000
                                                                        13630000
                                                                        13632000
COMMENT                                                                 13634000
                                                                        13636000
  PURPOSE:                                                              13638000
                                                                        13640000
    This procedure will hash a disjoint set of file system              13642000
    function codes into a contiguous set of CIPER internal              13644000
    function codes.  A PB array is used as a hash table.  In            13646000
    the first pass, the table will be 256 words long, and will          13648000
    map one for one.  Later, a more sophisticated hashing al-           13650000
    gorithm will be incorporated to allow the size of the hash          13652000
    table to be reduced.                                                13654000
                                                                        13656000
                                                                        13658000
  INPUT PARAMETERS:                                                     13660000
                                                                        13662000
    FUNCTION, which is the file system function code passed to          13664000
      the logical driver.                                               13666000
                                                                        13668000
                                                                        13670000
  OUTPUT PARAMETERS:                                                    13672000
                                                                        13674000
    B08'HASH'FUNCTION'CODE, which is the compressed CIPER in-           13676000
      ternal function code.  A value of zero indicates the              13678000
      function input is not supported by the logical driver.            13680000
                                                                        13682000
                                                                        13684000
  SIDE-EFFECTS:                                                         13686000
                                                                        13688000
    None.                                                               13690000
                                                                        13692000
                                                                        13694000
  SPECIAL CONSIDERATIONS:                                               13696000
                                                                        13698000
    None.                                                               13700000
                                                                        13702000
                                                                        13704000
  CHANGE HISTORY:                                                       13706000
                                                                        13708000
    As issued.                                                          13710000
                                                                        13712000
                                                                        13714000
;                                                                       13716000
                                                                        13718000
begin                                                                   13720000
                                                                        13722000
$PAGE "FUNCTION CODE HASHING TABLE (PB ARRAY)"                          13724000
  integer array                                                         13726000
                                                                        13728000
    hash'table(0:255)             = PB :=                               13730000
                                                                        13732000
<<   0: >>    1   << read data >>                                       13734000
<<   1: >>   ,2   << write data >>                                      13736000
<<   2: >>   ,3   << fopen >>                                           13738000
<<   3: >>   ,4   << fclose >>                                          13740000
<<   4: >>   ,5   << device close >>                                    13742000
<<   5: >>   ,0                                                         13744000
<<   6: >>   ,0                                                         13746000
<<   7: >>   ,0                                                         13748000
<<   8: >>   ,0                                                         13750000
<<   9: >>   ,0                                                         13752000
<<  10: >>   ,0                                                         13754000
<<  11: >>   ,0                                                         13756000
<<  12: >>   ,0                                                         13758000
<<  13: >>   ,0                                                         13760000
<<  14: >>   ,0                                                         13762000
<<  15: >>   ,6   << device status immediate >>                         13764000
<<  16: >>   ,0                                                         13766000
<<  17: >>   ,0                                                         13768000
<<  18: >>   ,0                                                         13770000
<<  19: >>   ,0                                                         13772000
<<  20: >>   ,0                                                         13774000
<<  21: >>   ,0                                                         13776000
<<  22: >>   ,0                                                         13778000
<<  23: >>   ,0                                                         13780000
<<  24: >>   ,0                                                         13782000
<<  25: >>   ,0                                                         13784000
<<  26: >>   ,0                                                         13786000
<<  27: >>   ,0                                                         13788000
<<  28: >>   ,0                                                         13790000
<<  29: >>   ,0                                                         13792000
<<  30: >>   ,0                                                         13794000
<<  31: >>   ,0                                                         13796000
<<  32: >>   ,0                                                         13798000
<<  33: >>   ,0                                                         13800000
<<  34: >>   ,0                                                         13802000
<<  35: >>   ,0                                                         13804000
<<  36: >>   ,0                                                         13806000
<<  37: >>   ,0                                                         13808000
<<  38: >>   ,0                                                         13810000
<<  39: >>   ,0                                                         13812000
<<  40: >>   ,0                                                         13814000
<<  41: >>   ,0                                                         13816000
<<  42: >>   ,0                                                         13818000
<<  43: >>   ,0                                                         13820000
<<  44: >>   ,0                                                         13822000
<<  45: >>   ,0                                                         13824000
<<  46: >>   ,0                                                         13826000
<<  47: >>   ,0                                                         13828000
<<  48: >>   ,0                                                         13830000
<<  49: >>   ,0                                                         13832000
<<  50: >>   ,0                                                         13834000
<<  51: >>   ,0                                                         13836000
<<  52: >>   ,0                                                         13838000
<<  53: >>   ,0                                                         13840000
<<  54: >>   ,0                                                         13842000
<<  55: >>   ,0                                                         13844000
<<  56: >>   ,0                                                         13846000
<<  57: >>   ,0                                                         13848000
<<  58: >>   ,0                                                         13850000
<<  59: >>   ,0                                                         13852000
<<  60: >>   ,0                                                         13854000
<<  61: >>   ,0                                                         13856000
<<  62: >>   ,0                                                         13858000
<<  63: >>   ,0                                                         13860000
<<  64: >>   ,7   << vfu download >>                                    13862000
<<  65: >>   ,8   << set left margin >>                                 13864000
<<  66: >>   ,0                                                         13866000
<<  67: >>   ,0                                                         13868000
<<  68: >>   ,0                                                         13870000
<<  69: >>   ,0                                                         13872000
<<  70: >>   ,0                                                         13874000
<<  71: >>   ,9   << buffered device status >>                          13876000
<<  72: >>   ,0                                                         13878000
<<  73: >>   ,10  << self test >>                                       13880000
<<  74: >>   ,0                                                         13882000
<<  75: >>   ,0                                                         13884000
<<  76: >>   ,0                                                         13886000
<<  77: >>   ,0                                                         13888000
<<  78: >>   ,0                                                         13890000
<<  79: >>   ,0                                                         13892000
<<  80: >>   ,0                                                         13894000
<<  81: >>   ,0                                                         13896000
<<  82: >>   ,0                                                         13898000
<<  83: >>   ,0                                                         13900000
<<  84: >>   ,0                                                         13902000
<<  85: >>   ,0                                                         13904000
<<  86: >>   ,0                                                         13906000
<<  87: >>   ,0                                                         13908000
<<  88: >>   ,0                                                         13910000
<<  89: >>   ,0                                                         13912000
<<  90: >>   ,0                                                         13914000
<<  91: >>   ,0                                                         13916000
<<  92: >>   ,0                                                         13918000
<<  93: >>   ,0                                                         13920000
<<  94: >>   ,0                                                         13922000
<<  95: >>   ,0                                                         13924000
<<  96: >>   ,0                                                         13926000
<<  97: >>   ,0                                                         13928000
<<  98: >>   ,0                                                         13930000
<<  99: >>   ,0                                                         13932000
<< 100: >>   ,0                                                         13934000
<< 101: >>   ,0                                                         13936000
<< 102: >>   ,0                                                         13938000
<< 103: >>   ,0                                                         13940000
<< 104: >>   ,0                                                         13942000
<< 105: >>   ,0                                                         13944000
<< 106: >>   ,0                                                         13946000
<< 107: >>   ,0                                                         13948000
<< 108: >>   ,0                                                         13950000
<< 109: >>   ,0                                                         13952000
<< 110: >>   ,0                                                         13954000
<< 111: >>   ,0                                                         13956000
<< 112: >>   ,0                                                         13958000
<< 113: >>   ,0                                                         13960000
<< 114: >>   ,0                                                         13962000
<< 115: >>   ,0                                                         13964000
<< 116: >>   ,0                                                         13966000
<< 117: >>   ,0                                                         13968000
<< 118: >>   ,0                                                         13970000
<< 119: >>   ,0                                                         13972000
<< 120: >>   ,0                                                         13974000
<< 121: >>   ,0                                                         13976000
<< 122: >>   ,0                                                         13978000
<< 123: >>   ,0                                                         13980000
<< 124: >>   ,0                                                         13982000
<< 125: >>   ,0                                                         13984000
<< 126: >>   ,0                                                         13986000
<< 127: >>   ,0                                                         13988000
<< 128: >>   ,11  << select character set >>                            13990000
<< 129: >>   ,19                                                        13992000
<< 130: >>   ,19                                                        13994000
<< 131: >>   ,19                                                        13996000
<< 132: >>   ,19                                                        13998000
<< 133: >>   ,12  << define physical page length >>                     14000000
<< 134: >>   ,19                                                        14002000
<< 135: >>   ,19                                                        14004000
<< 136: >>   ,19                                                        14006000
<< 137: >>   ,19                                                        14008000
<< 138: >>   ,19                                                        14010000
<< 139: >>   ,19                                                        14012000
<< 140: >>   ,13  << page control >>                                    14014000
<< 141: >>   ,14  << clear environment >>                               14016000
<< 142: >>   ,15  << start job >>                                       14018000
<< 143: >>   ,16  << load default environment >>                        14020000
<< 144: >>   ,17  << download terminal debugging softkeys >>            14022000
<< 145: >>   ,18  << end job >>                                         14024000
<< 146: >>   ,23  << Set/Clear extended capability mode >>              14026000
<< 147: >>   ,24  << Start of block >>                                  14028000
<< 148: >>   ,25  << End of block >>                                    14030000
<< 149: >>   ,19                                                        14032000
<< 150: >>   ,19                                                        14034000
<< 151: >>   ,19                                                        14036000
<< 152: >>   ,19                                                        14038000
<< 153: >>   ,19                                                        14040000
<< 154: >>   ,19                                                        14042000
<< 155: >>   ,19                                                        14044000
<< 156: >>   ,19                                                        14046000
<< 157: >>   ,19                                                        14048000
<< 158: >>   ,19                                                        14050000
<< 159: >>   ,19                                                        14052000
<< 160: >>   ,19                                                        14054000
<< 161: >>   ,19                                                        14056000
<< 162: >>   ,19                                                        14058000
<< 163: >>   ,19                                                        14060000
<< 164: >>   ,19                                                        14062000
<< 165: >>   ,19                                                        14064000
<< 166: >>   ,19                                                        14066000
<< 167: >>   ,19                                                        14068000
<< 168: >>   ,19                                                        14070000
<< 169: >>   ,19                                                        14072000
<< 170: >>   ,19                                                        14074000
<< 171: >>   ,19                                                        14076000
<< 172: >>   ,19                                                        14078000
<< 173: >>   ,19                                                        14080000
<< 174: >>   ,19                                                        14082000
<< 175: >>   ,19                                                        14084000
<< 176: >>   ,19                                                        14086000
<< 177: >>   ,19                                                        14088000
<< 178: >>   ,19                                                        14090000
<< 179: >>   ,36  << job report buffered >>                    <<04422>>14092000
<< 180: >>   ,34  << environmental status immediate >>                  14094000
<< 181: >>   ,35  << device status composite >>                         14096000
<< 182: >>   ,30  << Flush out any buffers with data in them >>         14098000
<< 183: >>   ,31  << Erase any pending data in buffers >>               14100000
<< 184: >>   ,19                                                        14102000
<< 185: >>   ,28  << Set control mask >>                                14104000
<< 186: >>   ,29  << Return job report information >>                   14106000
<< 187: >>   ,26  << read status types available >>                     14108000
<< 188: >>   ,27  << set available status (configuration) >>            14110000
<< 189: >>   ,20  << device clear >>                                    14112000
<< 190: >>   ,21  << begin silent run >>                                14114000
<< 191: >>   ,22  << read environmental status >>                       14116000
<< 192: >>   ,19                                                        14118000
<< 193: >>   ,0                                                         14120000
<< 194: >>   ,0                                                         14122000
<< 195: >>   ,0                                                         14124000
<< 196: >>   ,0                                                         14126000
<< 197: >>   ,0                                                         14128000
<< 198: >>   ,0                                                         14130000
<< 199: >>   ,0                                                         14132000
<< 200: >>   ,0                                                         14134000
<< 201: >>   ,0                                                         14136000
<< 202: >>   ,0                                                         14138000
<< 203: >>   ,0                                                         14140000
<< 204: >>   ,0                                                         14142000
<< 205: >>   ,0                                                         14144000
<< 206: >>   ,0                                                         14146000
<< 207: >>   ,0                                                         14148000
<< 208: >>   ,0                                                         14150000
<< 209: >>   ,0                                                         14152000
<< 210: >>   ,0                                                         14154000
<< 211: >>   ,0                                                         14156000
<< 212: >>   ,0                                                         14158000
<< 213: >>   ,0                                                         14160000
<< 214: >>   ,0                                                         14162000
<< 215: >>   ,0                                                         14164000
<< 216: >>   ,0                                                         14166000
<< 217: >>   ,0                                                         14168000
<< 218: >>   ,0                                                         14170000
<< 219: >>   ,0                                                         14172000
<< 220: >>   ,0                                                         14174000
<< 221: >>   ,0                                                         14176000
<< 222: >>   ,0                                                         14178000
<< 223: >>   ,0                                                         14180000
<< 224: >>   ,0                                                         14182000
<< 225: >>   ,0                                                         14184000
<< 226: >>   ,0                                                         14186000
<< 227: >>   ,0                                                         14188000
<< 228: >>   ,0                                                         14190000
<< 229: >>   ,0                                                         14192000
<< 230: >>   ,0                                                         14194000
<< 231: >>   ,0                                                         14196000
<< 232: >>   ,0                                                         14198000
<< 233: >>   ,0                                                         14200000
<< 234: >>   ,0                                                         14202000
<< 235: >>   ,0                                                         14204000
<< 236: >>   ,0                                                         14206000
<< 237: >>   ,0                                                         14208000
<< 238: >>   ,0                                                         14210000
<< 239: >>   ,0                                                         14212000
<< 240: >>   ,0                                                         14214000
<< 241: >>   ,0                                                         14216000
<< 242: >>   ,0                                                         14218000
<< 243: >>   ,0                                                         14220000
<< 244: >>   ,0                                                         14222000
<< 245: >>   ,0                                                         14224000
<< 246: >>   ,0                                                         14226000
<< 247: >>   ,0                                                         14228000
<< 248: >>   ,0                                                         14230000
<< 249: >>   ,0                                                         14232000
<< 250: >>   ,0                                                         14234000
<< 251: >>   ,0                                                         14236000
<< 252: >>   ,0                                                         14238000
<< 253: >>   ,0                                                         14240000
<< 254: >>   ,33  << Test cpr'shutdown.  P1 := recursion level >>       14242000
<< 255: >>   ,32  << Set maximum record size.  P1 := size in bytes >>   14244000
                                                                        14246000
  ;  << end of hash'table >>                                            14248000
                                                                        14250000
                                                                        14252000
$PAGE "PROCEDURE:  B08'HASH'FUNCTION'CODE -- PROCEDURE BODY"            14254000
  if function < 0 or function > 255 then                                14256000
    begin                                                               14258000
      b08'hash'function'code := 0;                                      14260000
    end                                                                 14262000
  else                                                                  14264000
    begin                                                               14266000
      b08'hash'function'code := hash'table(function);                   14268000
    end;                                                                14270000
                                                                        14272000
end;  << of procedure b08'hash'function'code >>                         14274000
                                                                        14276000
  <<CIPER level 4>>                                                     14278000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL"                                14280000
double procedure b08'network'protocol(control'table, function,          14282000
                                      buffer, count, dst'num,           14284000
                                      ldev                   );         14286000
                                                                        14288000
  value                               control'table, function,          14290000
                                      buffer, count, dst'num,           14292000
                                      ldev                    ;         14294000
                                                                        14296000
  logical pointer                     control'table           ;         14298000
                                                                        14300000
  integer                                            function,          14302000
                                      buffer, count, dst'num,           14304000
                                      ldev                    ;         14306000
                                                                        14308000
  option privileged, uncallable                               ;         14310000
                                                                        14312000
                                                                        14314000
COMMENT                                                                 14316000
                                                                        14318000
  PURPOSE:                                                              14320000
                                                                        14322000
    This procedure performs the function of the CIPER trans-            14324000
    port end-to-end control (Level 4).  This includes initial-          14326000
    ization of the transport service, segmentation of Level 7           14328000
    records into packets for output, and recombination of               14330000
    packets into records for input to Level 7.  Since certain           14332000
    physical drivers require fopens, fcloses, and device closes         14334000
    be sent when allocating/deallocating a user, this procedure         14336000
    will pass those requests down to the physical drivers.              14338000
                                                                        14340000
                                                                        14342000
  INPUT PARAMETERS:                                                     14344000
                                                                        14346000
    CONTROL'TABLE, which points to the control table in the             14348000
      CIPER data segment that is allocated for this ldev.               14350000
                                                                        14352000
    FUNCTION, which is the command telling what to do this              14354000
      call.  At present, the following functions are supported          14356000
      by Level 4:                                                       14358000
                                                                        14360000
        0 --> read a record from the device                             14362000
        1 --> write a record to the device                              14364000
        2 --> pass an fopen to the physical driver                      14366000
        3 --> pass an fclose to the physical driver                     14368000
        4 --> pass a device close to the physical driver                14370000
        5 --> initialize the transport service                          14372000
        6 --> status request (currently not implemented)                14374000
                                                                        14376000
    ADDRESS, which points to the data buffer where read, write,         14378000
      and initialization data is to be found.                           14380000
                                                                        14382000
    COUNT, which is the size, in bytes, of the request data             14384000
      buffer.                                                           14386000
                                                                        14388000
    DST'NUM, which is the data segment number of the segment            14390000
      where the request buffer is located.                              14392000
                                                                        14394000
    LDEV, which is the logical device number the request is             14396000
      for.                                                              14398000
                                                                        14400000
                                                                        14402000
  OUTPUT PARAMETERS:                                                    14404000
                                                                        14406000
    B08'NETWORK'PROTOCOL, which is a double word function re-           14408000
      turn.  Word 0 is the completion status of the call.               14410000
      Word 1 is the transfer log, in bytes, of data moved               14412000
      to/from the caller.                                               14414000
                                                                        14416000
                                                                        14418000
  SIDE-EFFECTS:                                                         14420000
                                                                        14422000
    This procedure allocates a control block global area within         14424000
    the CIPER data segment of six words.  This global area              14426000
    is used to maintain information the procedure must have             14428000
    from call to call.                                                  14430000
                                                                        14432000
                                                                        14434000
  SPECIAL CONSIDERATIONS:                                               14436000
                                                                        14438000
    When called, this procedure expects DB to be set to the             14440000
    CIPER data segment.                                                 14442000
                                                                        14444000
                                                                        14446000
  CHANGE HISTORY:                                                       14448000
                                                                        14450000
    As issued.                                                          14452000
                                                                        14454000
                                                                        14456000
;                                                                       14458000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL -- LOCAL VARIABLES"             14460000
begin                                                                   14462000
                                                                        14464000
  double                                                                14466000
                                                                        14468000
    return'info                   = b08'network'protocol                14470000
      << Completion status of the call >>                               14472000
                                                                        14474000
  ;                                                                     14476000
                                                                        14478000
                                                                        14480000
  integer                                                               14482000
                                                                        14484000
    return'status                 = b08'network'protocol                14486000
      << Completion status >>                                           14488000
                                                                        14490000
   ,transfer'log                  = b08'network'protocol + 1            14492000
      << Total count of data moved to or from device >>                 14494000
                                                                        14496000
  ;                                                                     14498000
                                                                        14500000
                                                                        14502000
  integer pointer                                                       14504000
                                                                        14506000
    control'block                                                       14508000
      << points to control block for this level >>                      14510000
                                                                        14512000
   ,cbi                                                                 14514000
      << points to control block information area >>                    14516000
                                                                        14518000
   ,header'save'area                                                    14520000
      << points to area reserved by upper level for saving >>           14522000
      << the data where the packet headers must go.        >>           14524000
                                                                        14526000
   ,trailer'save'area                                                   14528000
      << points to area reserved by upper level(s) for    >>            14530000
      << saving the data which is in the trailer space.   >>            14532000
                                                                        14534000
   ,packet'header                                                       14536000
      << points to the zeroeth word of the current packet >>            14538000
      << header.                                          >>            14540000
                                                                        14542000
   ,packet'trailer                                                      14544000
      << points to the location where the packet trailer  >>            14546000
      << (if any) is to be placed.                        >>            14548000
                                                                        14550000
   ,address                                                             14552000
      << pointer to calling buffer >>                                   14554000
                                                                        14556000
  ;                                                                     14558000
                                                                        14560000
                                                                        14562000
  byte pointer                                                          14564000
                                                                        14566000
    start'of'data                                                       14568000
      << Points to first byte beyond the packet header >>               14570000
                                                                        14572000
   ,next'byte'of'record                                                 14574000
      << points to next available byte of record buffer >>              14576000
      << area during input                              >>              14578000
                                                                        14580000
  ;                                                                     14582000
                                                                        14584000
                                                                        14586000
  integer                                                               14588000
                                                                        14590000
    packet'number                                                       14592000
      << Keeps the packet sequence count.  Used for genera- >>          14594000
      << tion of packet sequence numbers on output and se-  >>          14596000
      << quence number checking on input.                   >>          14598000
                                                                        14600000
   ,transmit'count                                                      14602000
      << The size, in bytes, of the current packet trans-   >>          14604000
      << mission                                            >>          14606000
                                                                        14608000
   ,total'count                                                         14610000
      << The tally of all packet information sent or re-    >>          14612000
      << ceived.                                            >>          14614000
                                                                        14616000
   ,data'count                                                          14618000
      << Portion of a transfer that is user data (excludes >>           14620000
      << header/trailer data)                              >>           14622000
                                                                        14624000
  ;                                                                     14626000
                                                                        14628000
                                                                        14630000
  logical                                                               14632000
                                                                        14634000
    finished                                                            14636000
      << Set true when last packet has been sent or re- >>              14638000
      << ceived.                                        >>              14640000
                                                                        14642000
  ;                                                                     14644000
                                                                        14646000
                                                                        14648000
  << Control block information area (cbi) definitions: >>               14650000
                                                                        14652000
  equate                                                                14654000
                                                                        14656000
    lvl'2'header'size             = 0                                   14658000
      << size (in words) of header space needed by level 2 >>           14660000
                                                                        14662000
   ,lvl'2'trailer'size            = 1 + lvl'2'header'size               14664000
      << size (in words) of trailer space needed by level 2 >>          14666000
                                                                        14668000
   ,lvl'2'packet'size             = 1 + lvl'2'trailer'size              14670000
      << maximum size (in bytes) of packet that can handled >>          14672000
      << by the current physical link.                      >>          14674000
                                                                        14676000
   ,header'move'size              = 1 + lvl'2'packet'size               14678000
      << total size of space required for level 2 and level >>          14680000
      << 4 headers.                                         >>          14682000
                                                                        14684000
   ,trailer'move'size             = 1 + header'move'size                14686000
      << total size (in words) of space required for level 2 >>         14688000
      << and level 4 trailers.                               >>         14690000
                                                                        14692000
   ,initialized                   = 1 + trailer'move'size               14694000
      << set to true if the cbi has been properly initial-   >>         14696000
      << ized.                                              >>          14698000
                                                                        14700000
   ,level'4'cbi'size              = 1 + initialized                     14702000
      << Total CDS area required for the cbi >>                         14704000
                                                                        14706000
  ;                                                                     14708000
                                                                        14710000
                                                                        14712000
  << Definitions of Level 4 packet headers: >>                          14714000
                                                                        14716000
  define                                                                14718000
                                                                        14720000
    p'head'length                 = 0).(0:8 #                           14722000
      << Length (in bytes) of packet header.  Length in-   >>           14724000
      << clused the length byte itself.                    >>           14726000
                                                                        14728000
   ,p'reserved                    = 0).(8:7 #                           14730000
      << Reserved field within packet header.  Should be >>             14732000
      << set to zero.                                    >>             14734000
                                                                        14736000
   ,end'of'message'flag           = 0).(15:1 #                          14738000
      << When set, indicates last packet of a record >>                 14740000
                                                                        14742000
   ,sequence'number               = 1 #                                 14744000
      << Used for detecting missing or duplicated packets. >>           14746000
      << First packet of record is zero, increments by one >>           14748000
      << until end of message.                             >>           14750000
                                                                        14752000
   ,data'start                    = 2 #                                 14754000
      << Base of data contained in the packet >>                        14756000
                                                                        14758000
  ;                                                                     14760000
                                                                        14762000
                                                                        14764000
  << Constants associated with Level 4 headers/trailers: >>             14766000
                                                                        14768000
  equate                                                                14770000
                                                                        14772000
    lvl'4'header'size             = 2                                   14774000
      << Size (in words) of packet headers >>                           14776000
                                                                        14778000
   ,lvl'4'trailer'size            = 0                                   14780000
      << Currently no trailer is used >>                                14782000
                                                                        14784000
   ,lvl'4'overhead                = lvl'4'header'size                   14786000
                                  + lvl'4'trailer'size                  14788000
      << Total amount of space required >>                              14790000
                                                                        14792000
   ,b'lvl'4'header'size           = lvl'4'header'size * 2               14794000
                                                                        14796000
   ,b'lvl'4'trailer'size          = lvl'4'trailer'size * 2              14798000
                                                                        14800000
   ,b'lvl'4'overhead              = lvl'4'overhead * 2                  14802000
                                                                        14804000
  ;                                                                     14806000
                                                                        14808000
                                                                        14810000
  << Function requests made of Level 2 (physical drivers): >>           14812000
                                                                        14814000
  equate                                                                14816000
                                                                        14818000
    physical'read                 = 0                                   14820000
      << Requests a packet from the device >>                           14822000
                                                                        14824000
   ,physical'write                = 1                                   14826000
      << Transmits a packet to the device >>                            14828000
                                                                        14830000
   ,physical'open                 = 2                                   14832000
      << Allocates the physical link if necessary >>                    14834000
                                                                        14836000
   ,physical'close                = 3                                   14838000
      << Usually is a nop for the physical level >>                     14840000
                                                                        14842000
   ,physical'deallocate           = 4                                   14844000
      << Deallocates the physical link >>                               14846000
                                                                        14848000
   ,physical'initialize           = 184                                 14850000
      << Causes the physical driver to initialize and re- >>            14852000
      << port packet size, header, and trailer requirements >>          14854000
                                                                        14856000
  ;                                                                     14858000
$PAGE "PROCEDURE:  B08'NETWORK'PROTOCOL -- PROCEDURE BODY"              14860000
  << First, initialize the control block and cbi pointers >>            14862000
                                                                        14864000
  @control'block := cpr'cb'of(control'table, 4);                        14866000
                                                                        14868000
  @cbi := control'block(cb'info'ptr);                                   14870000
                                                                        14872000
                                                                        14874000
  << Initialize the buffer address pointer >>                           14876000
                                                                        14878000
  @address := buffer;                                                   14880000
                                                                        14882000
                                                                        14884000
  << If cbi is nil, then we have not yet initialized a    >>            14886000
  << control block information area.                      >>            14888000
                                                                        14890000
  if @cbi = nil then                                                    14892000
    begin                                                               14894000
      @cbi := cpr'init'cbi(control'block, level'4'cbi'size);            14896000
    end;                                                                14898000
                                                                        14900000
  if not logical( cbi(initialized) )                                    14902000
     and function <> transport'initialize then                          14904000
    begin                                                               14906000
      return'status := illegal'function'sequence;                       14908000
      return;                                                           14910000
    end;                                                                14912000
                                                                        14914000
                                                                        14916000
  << Make sure the function code is within range. >>                    14918000
                                                                        14920000
  if function < transport'read or function > transport'status           14922000
      then                                                              14924000
    begin                                                               14926000
      return'status := invalid'request;                                 14928000
      return;                                                           14930000
    end;                                                                14932000
                                                                        14934000
                                                                        14936000
  << Now select the appropriate thing to do >>                          14938000
                                                                        14940000
  case function of                                                      14942000
    begin                                                               14944000
                                                                        14946000
      begin  << function = 0  (transport'read) >>                       14948000
                                                                        14950000
        << Initialize certain variables >>                              14952000
                                                                        14954000
        packet'number := total'count := 0;                              14956000
                                                                        14958000
        @next'byte'of'record := @address to'byte;                       14960000
                                                                        14962000
                                                                        14964000
        << Bring in packets until the message is finished >>            14966000
                                                                        14968000
        do                                                              14970000
          begin                                                         14972000
                                                                        14974000
            << Calculate the read length >>                             14976000
                                                                        14978000
            transmit'count := if count < cbi(lvl'2'packet'size)         14980000
                then count                                              14982000
                else cbi(lvl'2'packet'size);                            14984000
                                                                        14986000
                                                                        14988000
            << If the transmit count is not large enough for >>         14990000
            << a packet with at least one byte of data, re-  >>         14992000
            << turn with an error.                           >>         14994000
                                                                        14996000
            if transmit'count < b'lvl'4'overhead + 1 then               14998000
              begin                                                     15000000
                return'status := fatal'error;                           15002000
                return;                                                 15004000
              end;                                                      15006000
                                                                        15008000
                                                                        15010000
            << Get a packet from the physical layer >>                  15012000
                                                                        15014000
            do                                                          15016000
                                                                        15018000
              return'info :=                                            15020000
                p'attachio( ldev,                                       15022000
                            0,                                          15024000
                            dst'num,                                    15026000
                            @address,                                   15028000
                            physical'read,                              15030000
                            -transmit'count,                            15032000
                            0,                                          15034000
                            0,                                          15036000
                            blocked   )                                 15038000
                                                                        15040000
            until return'status.overall <> system'powerfail;            15042000
                                                                        15044000
                                                                        15046000
            << Check the return status >>                               15048000
                                                                        15050000
            if return'status.general <> successful then                 15052000
              begin                                                     15054000
                transfer'log := total'count;                            15056000
                return;                                                 15058000
              end;                                                      15060000
                                                                        15062000
                                                                        15064000
            << Check the packet header for validity >>                  15066000
                                                                        15068000
            @packet'header := @address                                  15070000
                            + cbi(lvl'2'header'size);                   15072000
                                                                        15074000
            if packet'header(p'head'length)                             15076000
                < b'lvl'4'header'size                                   15078000
            or packet'header(sequence'number) <> packet'number          15080000
            then                                                        15082000
              begin                                                     15084000
                return'status := packet'sequence'error;                 15086000
                transfer'log := total'count;                            15088000
                return;                                                 15090000
              end                                                       15092000
            else                                                        15094000
              begin                                                     15096000
                                                                        15098000
                << Adjust the count of non-control data >>              15100000
                                                                        15102000
                data'count := -transfer'log                             15104000
                            - b'lvl'4'overhead;                         15106000
                                                                        15108000
                                                                        15110000
                << Increment the packet number for the next >>          15112000
                << packet, if any.                          >>          15114000
                                                                        15116000
                packet'number := packet'number + 1;                     15118000
                                                                        15120000
                << Check for last packet of message >>                  15122000
                                                                        15124000
                finished := logical(                                    15126000
                    packet'header(end'of'message'flag) );               15128000
                                                                        15130000
                                                                        15132000
                << Compress out the packet header >>                    15134000
                                                                        15136000
                @start'of'data := (@packet'header to'byte)              15138000
                                + packet'header(p'head'length);         15140000
                                                                        15142000
                move next'byte'of'record := start'of'data,              15144000
                    (data'count),2;                                     15146000
                                                                        15148000
                @next'byte'of'record := TOS;                            15150000
                                                                        15152000
                                                                        15154000
                << Update the total count of data received >>           15156000
                                                                        15158000
                total'count := total'count + data'count;                15160000
                                                                        15162000
                                                                        15164000
                << Move the base address up for the next  >>            15166000
                << packet, if any                         >>            15168000
                                                                        15170000
                @address := @address + ((data'count+1) to'word);        15172000
                                                                        15174000
                << Decrement the request count, since the   >>          15176000
                << free space in the buffer is shrinking.   >>          15178000
                                                                        15180000
                count := count - data'count;                            15182000
                                                                        15184000
              end;                                                      15186000
                                                                        15188000
            end                                                         15190000
          until finished;                                               15192000
                                                                        15194000
          transfer'log := total'count;                                  15196000
                                                                        15198000
                                                                        15200000
      end;   << of transport read >>                                    15202000
                                                                        15204000
                                                                        15206000
      begin  << function = 1  (transport'write) >>                      15208000
                                                                        15210000
        << Initialize the packet sequence counter and the  >>           15212000
        << pointers to save areas.                         >>           15214000
                                                                        15216000
        packet'number := total'count := 0;                              15218000
                                                                        15220000
        @header'save'area := @address - cbi(header'move'size);          15222000
                                                                        15224000
        @trailer'save'area := @address + ((count + 1) to'word);         15226000
                                                                        15228000
                                                                        15230000
        do                                                              15232000
          begin                                                         15234000
                                                                        15236000
            << Set up the pointer for this packet header >>             15238000
                                                                        15240000
            @packet'header := @address - lvl'4'header'size;             15242000
                                                                        15244000
                                                                        15246000
            << Determine how much of the request can be     >>          15248000
            << satisfied with this packet.                  >>          15250000
                                                                        15252000
            if count + b'lvl'4'overhead                                 15254000
                 > cbi(lvl'2'packet'size) then                          15256000
              begin                                                     15258000
                transmit'count := cbi(lvl'2'packet'size);               15260000
              end                                                       15262000
            else                                                        15264000
              begin                                                     15266000
                transmit'count := count + b'lvl'4'overhead;             15268000
              end;                                                      15270000
                                                                        15272000
                                                                        15274000
            << Data'count is set to be the portion of the  >>           15276000
            << transmit count that is the caller's data and >>          15278000
            << not headers/trailers.                        >>          15280000
                                                                        15282000
            data'count := transmit'count - b'lvl'4'overhead;            15284000
                                                                        15286000
                                                                        15288000
            << Decrement the request count by the amount we >>          15290000
            << will send this pass.                         >>          15292000
                                                                        15294000
            count := count - data'count;                                15296000
                                                                        15298000
                                                                        15300000
            << Move data out of the place where the packet  >>          15302000
            << header/trailer will be built.                >>          15304000
                                                                        15306000
            move header'save'area :=                                    15308000
                packet'header(-cbi(lvl'2'header'size)),                 15310000
                (cbi(header'move'size));                                15312000
                                                                        15314000
            if cbi(trailer'move'size) > 0 then                          15316000
              begin                                                     15318000
                @packet'trailer := @address                             15320000
                                 + ((data'count + 1) to'word);          15322000
                move trailer'save'area := packet'trailer,               15324000
                             (cbi(trailer'move'size));                  15326000
              end;                                                      15328000
                                                                        15330000
                                                                        15332000
            << Make the packet header. >>                               15334000
                                                                        15336000
            packet'header(p'head'length) := b'lvl'4'header'size;        15338000
                                                                        15340000
            packet'header(p'reserved) := 0;                             15342000
                                                                        15344000
            packet'header(end'of'message'flag) := count = 0;            15346000
                                                                        15348000
            packet'header(sequence'number) := packet'number;            15350000
                                                                        15352000
                                                                        15354000
            << Send the packet to the device >>                         15356000
                                                                        15358000
            do                                                          15360000
                                                                        15362000
              return'info :=                                            15364000
                p'attachio( ldev,                                       15366000
                            0,                                          15368000
                            dst'num,                                    15370000
                            @packet'header(-cbi(lvl'2'header'size)),    15372000
                            physical'write,                             15374000
                            -transmit'count,                            15376000
                            0,                                          15378000
                            0,                                          15380000
                            blocked  )                                  15382000
                                                                        15384000
            until return'status.overall <> system'powerfail;            15386000
                                                                        15388000
                                                                        15390000
            << Check the return status >>                               15392000
                                                                        15394000
            if return'status.general <> successful then                 15396000
              begin                                                     15398000
                count := 0;                                             15400000
              end;                                                      15402000
                                                                        15404000
                                                                        15406000
            << Bump up the packet counter for the next >>               15408000
            << packet, if any is to come.              >>               15410000
                                                                        15412000
            packet'number := packet'number + 1;                         15414000
                                                                        15416000
                                                                        15418000
            << Update the total transfer count, restore the >>          15420000
            << data to the packet header/trailer areas, and >>          15422000
            << adjust the address to point to the next      >>          15424000
            << packet, if any.                              >>          15426000
                                                                        15428000
            total'count := total'count + (-transfer'log                 15430000
                                          - b'lvl'4'overhead);          15432000
                                                                        15434000
            @address := @address + (data'count to'word);                15436000
                                                                        15438000
            move packet'header(-cbi(lvl'2'header'size)) :=              15440000
                 header'save'area,(cbi(header'move'size));              15442000
                                                                        15444000
            if cbi(trailer'move'size) > 0 then                          15446000
              begin                                                     15448000
                move packet'trailer := trailer'save'area,               15450000
                                  ( cbi(trailer'move'size) );           15452000
              end;                                                      15454000
                                                                        15456000
          end                                                           15458000
        until count = 0;                                                15460000
                                                                        15462000
        transfer'log := total'count;                                    15464000
                                                                        15466000
      end;  << of transport'write >>                                    15468000
                                                                        15470000
                                                                        15472000
                                                                        15474000
      begin  << function = 2  (transport'open) >>                       15476000
                                                                        15478000
        do                                                              15480000
          return'info :=                                                15482000
              p'attachio( ldev,                                         15484000
                          0,                                            15486000
                          dst'num,                                      15488000
                          0,                                            15490000
                          physical'open,                                15492000
                          0,                                            15494000
                          0,                                            15496000
                          0,                                            15498000
                          blocked  )                                    15500000
                                                                        15502000
        until return'status.overall <> system'powerfail;                15504000
                                                                        15506000
      end;  << of transport'open >>                                     15508000
                                                                        15510000
                                                                        15512000
                                                                        15514000
      begin  << function = 3  (transport'close) >>                      15516000
                                                                        15518000
        do                                                              15520000
          return'info :=                                                15522000
              p'attachio( ldev,                                         15524000
                          0,                                            15526000
                          dst'num,                                      15528000
                          0,                                            15530000
                          physical'close,                               15532000
                          0,                                            15534000
                          0,                                            15536000
                          0,                                            15538000
                          blocked  )                                    15540000
                                                                        15542000
        until return'status.overall <> system'powerfail;                15544000
                                                                        15546000
      end;  << of transport'close >>                                    15548000
                                                                        15550000
                                                                        15552000
                                                                        15554000
      begin  << function = 4  (transport'deallocate) >>                 15556000
                                                                        15558000
        do                                                              15560000
          return'info :=                                                15562000
              p'attachio( ldev,                                         15564000
                          0,                                            15566000
                          dst'num,                                      15568000
                          0,                                            15570000
                          physical'deallocate,                          15572000
                          0,                                            15574000
                          0,                                            15576000
                          0,                                            15578000
                          blocked  )                                    15580000
                                                                        15582000
        until return'status.overall <> system'powerfail;                15584000
                                                                        15586000
      end;  << of transport'deallocate >>                               15588000
                                                                        15590000
                                                                        15592000
                                                                        15594000
      begin  << function = 5  (transport'initialize) >>                 15596000
                                                                        15598000
        do                                                              15600000
                                                                        15602000
          return'info :=                                                15604000
            p'attachio( ldev,                                           15606000
                        0,                                              15608000
                        dst'num,                                        15610000
                        @cbi,                                           15612000
                        physical'initialize,                            15614000
                        3,                                              15616000
                        0,                                              15618000
                        0,                                              15620000
                        blocked  )                                      15622000
                                                                        15624000
        until return'status.overall <> system'powerfail;                15626000
                                                                        15628000
        << If the transport service reported a packet length >>         15630000
        << of zero, it really means there is no restriction. >>         15632000
        << Set the length to a very large even number, or,   >>         15634000
        << if the count was non-zero, round down to an even  >>         15636000
        << length.                                           >>         15638000
                                                                        15640000
        if cbi(lvl'2'packet'size) = 0 then                              15642000
          begin                                                         15644000
            cbi(lvl'2'packet'size) := 32766;                            15646000
          end                                                           15648000
        else                                                            15650000
          begin                                                         15652000
            cbi(lvl'2'packet'size).bit'15 := 0;                         15654000
          end;                                                          15656000
                                                                        15658000
                                                                        15660000
        << Move the header size, trailer size, and packet   >>          15662000
        << size of level 2 back to the upper levels.        >>          15664000
                                                                        15666000
        cbi(header'move'size) := cbi(lvl'2'header'size)                 15668000
                               + lvl'4'header'size;                     15670000
                                                                        15672000
        cbi(trailer'move'size) := cbi(lvl'2'trailer'size)               15674000
                                + lvl'4'trailer'size;                   15676000
                                                                        15678000
        address(lvl'2'header'size) := cbi(header'move'size);            15680000
                                                                        15682000
        address(lvl'2'trailer'size) := cbi(trailer'move'size);          15684000
                                                                        15686000
        address(lvl'2'packet'size) := cbi(lvl'2'packet'size);           15688000
                                                                        15690000
                                                                        15692000
        << Mark the cbi as initialized >>                               15694000
                                                                        15696000
        cbi(initialized) := true;                                       15698000
                                                                        15700000
                                                                        15702000
        << Tell them we returned three words >>                         15704000
                                                                        15706000
        transfer'log := 3;                                              15708000
                                                                        15710000
      end;  << of transport'initialize >>                               15712000
                                                                        15714000
                                                                        15716000
                                                                        15718000
      begin  << function = 6  (transport'status) >>                     15720000
                                                                        15722000
        << currently not implemented >>                                 15724000
                                                                        15726000
        return'status := successful;                                    15728000
                                                                        15730000
      end;                                                              15732000
                                                                        15734000
    end;  << of case function >>                                        15736000
                                                                        15738000
                                                                        15740000
end;  << of b08'network'protocol >>                                     15742000
                                                                        15744000
  << CIPER level 6 >>                                                   15746000
$PAGE "PROCEDURE: CPR'XLATE"                                            15748000
double  procedure cpr'xlate(poinr, sbuff, ebuff,                        15750000
                            func, p1, p2, ucn, presodd,xparency);       15752000
value                       poinr, sbuff, ebuff,                        15754000
                            func, p1, p2, ucn, presodd,xparency ;       15756000
logical                                                xparency         15758000
                                                                ;       15760000
integer pointer             poinr                                       15762000
                                                                ;       15764000
integer                                                                 15766000
                            func, p1, p2, ucn, presodd          ;       15768000
byte pointer                       sbuff, ebuff                         15770000
                                                               ;        15772000
                                                                        15774000
option privileged, uncallable                                 ;         15776000
                                                                        15778000
begin                                                                   15780000
                                                                        15782000
COMMENT                                                                 15784000
                                                                        15786000
     PURPOSE:  This routine's reason for living is to convert or        15788000
translate the function codes and parameters recieved by the logical     15790000
driver to escape sequences that will be understood by the 2608B.        15792000
                                                                        15794000
     INPUT PARAMETERS:  The input parameters are:                       15796000
FUNC - The function code sent to the logical driver.                    15798000
P1   - The device dependant parameter for the function code.            15800000
P2   - Another device dependant qualifier on the function code.         15802000
PRESODD = 1 - Make start sequence odd.                                  15804000
        = 0 - Make start sequence even.                                 15806000
POINR - A two word interger array used as change of state variables     15808000
        in the translation sequence.                                    15810000
UCN   - Number of bytes in the user array.  Used to determine if the    15812000
        trailing sequence should be odd.                                15814000
XPARENCY - True implies transparency mode requested.                    15816000
                                                                        15818000
     OUTPUT PARAMETERS:  The return parameters are:                     15820000
SCNT  - Number of bytes in the start escape sequence.                   15822000
SBUFF - Buffer containing the start escape sequence.                    15824000
ECNT  - Number of bytes in the end escape sequence.                     15826000
EBUFF - Buffer containing the end escape sequence.                      15828000
ERR   - Error indicator with the following values:                      15830000
      = 0 - No error found.                                             15832000
      = 1 - Illegal function code specified.                            15834000
                                                                        15836000
                                                                        15838000
CHANGE HISTORY                                                          15840000
                                                                        15844000
                                                                        15846000
;                                                                       15848000
                                                                        15850000
define                                                                  15852000
       scnt            =irtnv(1).(0:8)#                                 15854000
      ,ecnt            =irtnv(1).(8:8)#                                 15856000
      ,err             =irtnv(0)#                                       15858000
      ,first'time'flag =poinr.(8:1)#                                    15860000
      ,p2save          =poinr.(9:7)#                                    15862000
      ,print'on'perf   = logical( P2.(14:1) ) #                <<04472>>15864000
      ,pre'space       = logical( P2.(15:1) ) #                <<04475>>15866000
      ,old'tof         =poinr.(0:1)#                                    15868000
      ,new'tof         =poinr.(1:1)#                                    15870000
      ,p'start         =%33,"&p "#                                      15872000
      ,l'start         =%33,"&l "#                                      15874000
      ,slew'start      =%15,%33,"&a +"#                                 15876000
      ,slew'tail       ="R"#                                            15878000
      ,xpar'tail       ="X"#                                            15880000
      ,space           =" "#                                            15882000
      ,cr              =%15#                                            15884000
;                                                                       15886000
integer                                                                 15888000
        i                                                               15890000
       ,j                                                               15892000
       ,k                                                               15894000
       ,l                                                               15896000
;                                                                       15898000
                                                                        15900000
byte array                                                              15902000
        bl(*)=l                                                         15904000
;                                                                       15906000
                                                                        15908000
double                                                                  15910000
       rtnvalue                                                         15912000
;                                                                       15914000
integer array                                                           15916000
              irtnv(*)=rtnvalue;                                        15918000
                                                                        15920000
byte pointer                                                            15922000
     single                                                             15924000
;                                                                       15926000
                                                                        15928000
integer                                                                 15930000
       single'cnt                                                       15932000
;                                                                       15934000
                                                                        15936000
logical array                                                           15938000
              language'code(0:15)=pb:=                                  15940000
    "0U"                                                                15942000
   ,"0V"                                                                15944000
   ,"1R"                                                                15946000
   ,"1K"                                                                15948000
   ,"0L"                                                                15950000
   ,"1L"                                                                15952000
   ,"0M"                                                                15954000
   ,"0P"                                                                15956000
   ,"0F"                                                                15958000
   ,"0G"                                                                15960000
   ,"0S"                                                                15962000
   ,"0D"                                                                15964000
   ,"1S"                                                                15966000
   ,"1E"                                                                15968000
   ,"0K"                                                                15970000
   ,"0E"                                                                15972000
;                                                                       15974000
                                                                        15976000
@single := @ebuff(40);                                                  15978000
ERR:=illegal'func'cd;                                                   15980000
irtnv:=0;                                                               15982000
cpr'xlate:=rtnvalue;                                                    15984000
IF FUNC<0  OR FUNC > 144 THEN RETURN;                                   15986000
I:=0;J:=0;new'tof:=0;                                                   15988000
if first'time'flag = 0 then                                             15990000
  begin                                                                 15992000
                                                               <<04472>>15994000
  first'time'flag:=1;                                                   15996000
  old'tof:=0;                                                           15998000
  end;                                                                  16000000
CASE FUNC OF                                                            16002000
  BEGIN  << of case statement >>                                        16004000
  RETURN;                                                               16006000
                                                                        16008000
                                                                        16010000
  BEGIN   <<FUNC = 1 - WRITE DATA>>                                     16012000
COMMENT     Check for a change of state between this call and the       16014000
   last and make sure that the escape sequence to handle it is          16016000
retruned.                                                               16018000
;                                                                       16020000
                                                                        16024000
                                                                        16026000
    IF P2.(15:1)=0 AND POINR.(15:1)=1 THEN                              16028000
      BEGIN                                                             16030000
      MOVE SBUFF(I):=(l'start,"3V");                           <<04472>>16032000
      I:=I+6;                                                           16034000
      END;                                                              16036000
                                                                        16038000
    P2save:=P2;                                                <<04472>>16040000
                                                                        16042000
    IF print'on'perf THEN                                      <<04472>>16044000
      BEGIN                                                             16046000
      MOVE single:=(slew'start,"1",slew'tail);                          16048000
      single'cnt:=8;                                                    16050000
      end else                                                          16052000
      begin                                                             16054000
      move single:=(l'start,"3V");                                      16056000
      single'cnt:=6;                                                    16058000
      END;                                                              16060000
                                                                        16064000
                                                                        16066000
<< P1 selects what will happen during the write and P2 tells us         16068000
   where to put it (front or rear). >>                                  16070000
                                                                        16072000
                                                                        16074000
    IF P1=%53 OR P1=%200 THEN                                           16076000
      BEGIN                                                             16078000
      IF P2.(15:1)=1 THEN                                               16080000
        BEGIN                                                           16082000
        MOVE SBUFF(I):=(cr);                                            16084000
        I:=I+1;                                                         16086000
        END ELSE                                                        16088000
        BEGIN                                                           16090000
        MOVE EBUFF(J):=(cr);                                            16092000
        J:=J+1;                                                         16094000
        END;                                                            16096000
      END ELSE                                                          16098000
                                                                        16100000
                                                                        16102000
    IF P1>%200 AND P1<%300 THEN                                         16106000
      BEGIN                                                             16108000
      IF P2.(15:1)=1 THEN                                               16110000
        BEGIN                                                           16112000
        MOVE SBUFF(I):=(slew'start);                                    16114000
        I:=I+6;                                                         16116000
        K:=B08'ASCII(P1-%200,10,SBUFF(I));                              16118000
        I:=I+K;                                                         16120000
        IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;              16122000
        SBUFF(I):=slew'tail;I:=I+1; <<APPEND STRING TERMINATOR>>        16124000
        END ELSE                                                        16126000
        BEGIN                                                           16128000
        MOVE EBUFF(J):=(slew'start);                                    16130000
        J:=J+6;                                                         16132000
        K:=B08'ASCII(P1-%200,10,EBUFF(J));                              16134000
        J:=J+K;                                                         16136000
        IF K.(15:1)=0 THEN BEGIN EBUFF(J):=%40;J:=J+1;END;              16138000
        EBUFF(J):=slew'tail;J:=J+1; <<APPEND STRING TERMINATOR>>        16140000
        END;                                                            16142000
      END ELSE                                                          16144000
                                                                        16146000
                                                                        16148000
    IF P1 > %277 AND P1 < %320 THEN                            <<04474>>16150000
      BEGIN                                                             16152000
      IF P2.(15:1)=1 THEN                                               16154000
                                                                        16156000
        BEGIN                                                           16158000
        MOVE SBUFF(I):=(l'start);                                       16160000
        I:=I+4;                                                         16162000
        K:=B08'ASCII(P1-%277,10,SBUFF(I));                              16164000
        I:=I+K;                                                         16166000
        IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;              16168000
        SBUFF(I):="V";I:=I+1; <<APPEND STRING TERMINATOR>>              16170000
                                                                        16172000
        END ELSE                                                        16174000
        BEGIN                                                           16176000
        MOVE EBUFF(J):=(l'start);                                       16178000
        J:=J+4;                                                         16180000
        K:=B08'ASCII(P1-%277,10,EBUFF(J));                              16182000
        J:=J+K;                                                         16184000
        IF K.(15:1)=0 THEN BEGIN EBUFF(J):=%40;J:=J+1;END;              16186000
        EBUFF(J):="V";J:=J+1; <<APPEND STRING TERMINATOR>>              16188000
        END;                                                            16190000
      END ELSE                                                          16192000
                                                                        16194000
                                                                        16196000
    if p1=%55 then                                             <<04472>>16198000
      if xparency and not print'on'perf then                   <<04472>>16200000
        if p2.(15:1) = 1 then                                  <<04472>>16202000
          begin                                                <<04472>>16204000
          move sbuff(i):=(l'start,"5V");                       <<04472>>16206000
          i:=i+6;                                              <<04472>>16208000
          end                                                  <<04472>>16210000
        else                                                   <<04472>>16212000
          begin                                                <<04472>>16214000
          move ebuff(j):=(l'start,"5V");                       <<04472>>16216000
          j:=j+6;                                              <<04472>>16218000
          end                                                  <<04472>>16220000
      else                                                     <<04472>>16222000
        if not print'on'perf then                              <<04472>>16224000
          if p2.(15:1) = 1 then                                <<04472>>16226000
            begin                                              <<04472>>16228000
            move sbuff(i):=                                    <<04472>>16230000
                 (l'start,"3V",l'start,"3V",l'start,"3V");     <<04472>>16232000
            i:=i+18;                                           <<04472>>16234000
            end                                                <<04472>>16236000
          else                                                 <<04472>>16238000
            begin                                              <<04472>>16240000
            move ebuff(j):=                                    <<04472>>16242000
                 (l'start,"3V",l'start,"3V",l'start,"3V");     <<04472>>16244000
            j:=j+18;                                           <<04472>>16246000
            end                                                <<04472>>16248000
        else                                                   <<04472>>16250000
          if p2.(15:1) = 1 then                                <<04472>>16252000
            begin                                              <<04472>>16254000
            move sbuff(i):=(slew'start,"3",slew'tail);         <<04472>>16256000
            i:=i+8;                                            <<04472>>16258000
            end                                                <<04472>>16260000
          else                                                 <<04472>>16262000
            begin                                              <<04472>>16264000
            move ebuff(j):=(slew'start,"3",slew'tail);         <<04472>>16266000
            j:=j+8;                                            <<04472>>16268000
            end                                                <<04472>>16270000
    else                                                       <<04472>>16272000
                                                               <<04472>>16274000
    if p1=%60 then                                             <<04472>>16276000
      if xparency and not print'on'perf then                   <<04472>>16278000
        if p2.(15:1) = 1 then                                  <<04472>>16280000
          begin                                                <<04472>>16282000
          move sbuff(i):=(l'start,"4V");                       <<04472>>16284000
          i:=i+6;                                              <<04472>>16286000
          end                                                  <<04472>>16288000
        else                                                   <<04472>>16290000
          begin                                                <<04472>>16292000
          move ebuff(j):=(l'start,"4V");                       <<04472>>16294000
          j:=j+6;                                              <<04472>>16296000
          end                                                  <<04472>>16298000
      else                                                     <<04472>>16300000
        if not print'on'perf then                              <<04472>>16302000
          if p2.(15:1) = 1 then                                <<04472>>16304000
            begin                                              <<04472>>16306000
            move sbuff(i):=                                    <<04472>>16308000
                 (l'start,"3V",l'start,"3V");                  <<04472>>16310000
            i:=i+12;                                           <<04472>>16312000
            end                                                <<04472>>16314000
          else                                                 <<04472>>16316000
            begin                                              <<04472>>16318000
            move ebuff(j):=                                    <<04472>>16320000
                 (l'start,"3V",l'start,"3V");                  <<04472>>16322000
            j:=j+12;                                           <<04472>>16324000
            end                                                <<04472>>16326000
        else                                                   <<04472>>16328000
          if p2.(15:1) = 1 then                                <<04472>>16330000
            begin                                              <<04472>>16332000
            move sbuff(i):=(slew'start,"2",slew'tail);         <<04472>>16334000
            i:=i+8;                                            <<04472>>16336000
            end                                                <<04472>>16338000
          else                                                 <<04472>>16340000
            begin                                              <<04472>>16342000
            move ebuff(j):=(slew'start,"2",slew'tail);         <<04472>>16344000
            j:=j+8;                                            <<04472>>16346000
            end                                                <<04472>>16348000
    else                                                       <<04472>>16350000
                                                                        16354000
                                                                        16356000
    IF P1 = %61 THEN                                           <<04472>>16358000
      BEGIN                                                             16360000
      new'tof := integer( (not pre'space) lor (ucn = 0) );     <<04475>>16362000
      IF old'tof =0 or ucn>0 then                                       16364000
        begin                                                           16366000
        IF P2.(15:1)=1 THEN                                             16370000
          BEGIN                                                         16372000
          MOVE SBUFF(I):=(l'start,"1V");                       <<04422>>16374000
          I:=I+6;                                                       16376000
          END ELSE                                                      16378000
          BEGIN                                                         16380000
          MOVE EBUFF(J):=(l'start,"1V");                       <<04422>>16382000
          J:=J+6;                                                       16384000
          END;                                                          16386000
        end;                                                            16388000
      END ELSE                                                          16390000
                                                                        16392000
                                                                        16394000
    IF P1=%62 THEN                                                      16396000
      BEGIN                                                             16398000
      IF P2.(15:1)=1 THEN                                               16400000
        BEGIN                                                           16402000
        MOVE SBUFF(I):=(l'start,"011V");                                16404000
        I:=I+8;                                                         16406000
        END ELSE                                                        16408000
        BEGIN                                                           16410000
        MOVE EBUFF(J):=(l'start,"011V");                                16412000
        J:=J+8;                                                         16414000
        END;                                                            16416000
      END ELSE                                                          16418000
                                                                        16420000
                                                                        16422000
    IF P1=%63 THEN                                                      16424000
      BEGIN                                                             16426000
      IF P2.(15:1)=1 THEN                                               16428000
        BEGIN                                                           16430000
        MOVE SBUFF(I):=(l'start,"0V");                         <<04422>>16432000
        I:=I+6;                                                         16434000
        END ELSE                                                        16436000
        BEGIN                                                           16438000
        MOVE EBUFF(J):=(l'start,"0V");                         <<04422>>16440000
        J:=J+6;                                                         16442000
        END;                                                            16444000
    END ELSE                                                            16446000
                                                                        16448000
                                                                        16450000
    IF P1=%320 THEN                                                     16452000
      BEGIN                                                             16454000
      END ELSE                                                          16456000
    BEGIN                                                               16458000
                                                                        16460000
                                                                        16462000
    IF P2.(15:1)=1 THEN                                                 16464000
      BEGIN                                                             16466000
      MOVE SBUFF(I):=single,(single'cnt);                               16468000
      I:=I+single'cnt;                                                  16470000
      END ELSE                                                          16472000
      BEGIN                                                             16474000
      MOVE EBUFF(J):=single,(single'cnt);                               16476000
      J:=J+single'cnt;                                                  16478000
      END;                                                              16480000
    END;                                                                16482000
                                                                        16484000
                                                                        16486000
                                                                        16488000
    If xparency then                                                    16490000
     begin                                                              16492000
      move sbuff(i):=(p'start);                                         16494000
      i:=i+4;                                                           16496000
      k:=b08'ascii(ucn,10,sbuff(i));                                    16498000
      i:=i+k;                                                           16500000
      if k.(15:1)=0 then                                                16502000
       begin                                                            16504000
        sbuff(i):=space;                                                16506000
        i:=i+1;                                                         16508000
       end;                                                             16510000
      sbuff(i):=xpar'tail;                                              16512000
      i:=i+1;                                                           16514000
     end;                                                               16516000
    old'tof:=new'tof;                                                   16518000
  END;   <<END OF FUNC=1>>                                              16520000
                                                                        16522000
                                                                        16524000
                                                                        16526000
  BEGIN  << FUNCTION CODE 2 - FOPEN >>                                  16528000
  MOVE SBUFF(I):=(l'start,"0V");                                        16530000
  I:=I+6;                                                               16532000
  old'tof := 1;                                                <<04472>>16534000
  END;                                                                  16536000
                                                                        16538000
                                                                        16540000
  BEGIN  << FUNCTION CODE 3 - FCLOSE >>                                 16542000
  MOVE SBUFF(I):=(l'start,"0V");                                        16544000
  I:=I+6;                                                               16546000
  old'tof := 1;                                                <<04472>>16548000
  END;                                                                  16550000
                                                                        16552000
                                                                        16554000
  BEGIN  << FUNCTION CODE 4 - DEVICE CLOSE >>                           16556000
  MOVE SBUFF(I):=(l'start,"0V");                                        16558000
  I:=I+6;                                                               16560000
  END;  << of function = 4 >>                                           16562000
                                                                        16564000
                                                                        16566000
  RETURN;  <<FUNCTION CODE 5 >>                                         16568000
                                                                        16570000
  RETURN;  <<FUNCTION CODE 6 >>                                         16572000
                                                                        16574000
                                                                        16576000
  RETURN;  <<FUNCTION CODE 7 >>                                         16578000
                                                                        16580000
                                                                        16582000
  RETURN;  <<FUNCTION CODE 8 >>                                         16584000
                                                                        16586000
                                                                        16588000
  RETURN;  <<FUNCTION CODE 9 >>                                         16590000
                                                                        16592000
                                                                        16594000
  RETURN;  <<FUNCTION CODE 10 >>                                        16596000
                                                                        16598000
                                                                        16600000
  RETURN;  <<FUNCTION CODE 11 >>                                        16602000
                                                                        16604000
                                                                        16606000
  RETURN;  <<FUNCTION CODE 12 >>                                        16608000
                                                                        16610000
                                                                        16612000
  RETURN;  <<FUNCTION CODE 13 >>                                        16614000
                                                                        16616000
                                                                        16618000
  RETURN;  <<FUNCTION CODE 14 >>                                        16620000
                                                                        16622000
                                                                        16624000
  RETURN;  <<FUNCTION CODE 15 >>                                        16626000
                                                                        16628000
                                                                        16630000
  RETURN;  <<FUNCTION CODE 16 >>                                        16632000
                                                                        16634000
                                                                        16636000
  RETURN;  <<FUNCTION CODE 17 >>                                        16638000
                                                                        16640000
                                                                        16642000
  RETURN;  <<FUNCTION CODE 18 >>                                        16644000
                                                                        16646000
                                                                        16648000
  RETURN;  <<FUNCTION CODE 19 >>                                        16650000
                                                                        16652000
                                                                        16654000
  RETURN;  <<FUNCTION CODE 20 >>                                        16656000
                                                                        16658000
                                                                        16660000
  RETURN;  <<FUNCTION CODE 21 >>                                        16662000
                                                                        16664000
                                                                        16666000
  RETURN;  <<FUNCTION CODE 22 >>                                        16668000
                                                                        16670000
                                                                        16672000
  RETURN;  <<FUNCTION CODE 23 >>                                        16674000
                                                                        16676000
                                                                        16678000
  RETURN;  <<FUNCTION CODE 24 >>                                        16680000
                                                                        16682000
                                                                        16684000
  RETURN;  <<FUNCTION CODE 25 >>                                        16686000
                                                                        16688000
                                                                        16690000
  RETURN;  <<FUNCTION CODE 26 >>                                        16692000
                                                                        16694000
                                                                        16696000
  RETURN;  <<FUNCTION CODE 27 >>                                        16698000
                                                                        16700000
                                                                        16702000
  RETURN;  <<FUNCTION CODE 28 >>                                        16704000
                                                                        16706000
                                                                        16708000
  RETURN;  <<FUNCTION CODE 29 >>                                        16710000
                                                                        16712000
                                                                        16714000
  RETURN;  <<FUNCTION CODE 30 >>                                        16716000
                                                                        16718000
                                                                        16720000
  RETURN;  <<FUNCTION CODE 31 >>                                        16722000
                                                                        16724000
                                                                        16726000
  RETURN;  <<FUNCTION CODE 32 >>                                        16728000
                                                                        16730000
                                                                        16732000
  RETURN;  <<FUNCTION CODE 33 >>                                        16734000
                                                                        16736000
                                                                        16738000
  RETURN;  <<FUNCTION CODE 34 >>                                        16740000
                                                                        16742000
                                                                        16744000
  RETURN;  <<FUNCTION CODE 35 >>                                        16746000
                                                                        16748000
                                                                        16750000
  RETURN;  <<FUNCTION CODE 36 >>                                        16752000
                                                                        16754000
                                                                        16756000
  RETURN;  <<FUNCTION CODE 37 >>                                        16758000
                                                                        16760000
                                                                        16762000
  RETURN;  <<FUNCTION CODE 38 >>                                        16764000
                                                                        16766000
                                                                        16768000
  RETURN;  <<FUNCTION CODE 39 >>                                        16770000
                                                                        16772000
                                                                        16774000
  RETURN;  <<FUNCTION CODE 40 >>                                        16776000
                                                                        16778000
                                                                        16780000
  RETURN;  <<FUNCTION CODE 41 >>                                        16782000
                                                                        16784000
                                                                        16786000
  RETURN;  <<FUNCTION CODE 42 >>                                        16788000
                                                                        16790000
                                                                        16792000
  RETURN;  <<FUNCTION CODE 43 >>                                        16794000
                                                                        16796000
                                                                        16798000
  RETURN;  <<FUNCTION CODE 44 >>                                        16800000
                                                                        16802000
                                                                        16804000
  RETURN;  <<FUNCTION CODE 45 >>                                        16806000
                                                                        16808000
                                                                        16810000
  RETURN;  <<FUNCTION CODE 46 >>                                        16812000
                                                                        16814000
                                                                        16816000
  RETURN;  <<FUNCTION CODE 47 >>                                        16818000
                                                                        16820000
                                                                        16822000
  RETURN;  <<FUNCTION CODE 48 >>                                        16824000
                                                                        16826000
                                                                        16828000
  RETURN;  <<FUNCTION CODE 49 >>                                        16830000
                                                                        16832000
                                                                        16834000
  RETURN;  <<FUNCTION CODE 50 >>                                        16836000
                                                                        16838000
                                                                        16840000
  RETURN;  <<FUNCTION CODE 51 >>                                        16842000
                                                                        16844000
                                                                        16846000
  RETURN;  <<FUNCTION CODE 52 >>                                        16848000
                                                                        16850000
                                                                        16852000
  RETURN;  <<FUNCTION CODE 53 >>                                        16854000
                                                                        16856000
                                                                        16858000
  RETURN;  <<FUNCTION CODE 54 >>                                        16860000
                                                                        16862000
                                                                        16864000
  RETURN;  <<FUNCTION CODE 55 >>                                        16866000
                                                                        16868000
                                                                        16870000
  RETURN;  <<FUNCTION CODE 56 >>                                        16872000
                                                                        16874000
                                                                        16876000
  RETURN;  <<FUNCTION CODE 57 >>                                        16878000
                                                                        16880000
                                                                        16882000
  RETURN;  <<function code 58 >>                                        16884000
                                                                        16886000
                                                                        16888000
  RETURN;  <<FUNCTION CODE 59 >>                                        16890000
                                                                        16892000
                                                                        16894000
  RETURN;  <<FUNCTION CODE 60 >>                                        16896000
                                                                        16898000
                                                                        16900000
  RETURN;  <<FUNCTION CODE 61 >>                                        16902000
                                                                        16904000
                                                                        16906000
  RETURN;  <<FUNCTION CODE 62 >>                                        16908000
                                                                        16910000
                                                                        16912000
  RETURN;  <<FUNCTION CODE 63 >>                                        16914000
                                                                        16916000
                                                                        16918000
  BEGIN    <<FUNCTION CODE 64 >>                                        16920000
  MOVE SBUFF(I):=(l'start);                                             16922000
  I:=I+4;                                                               16924000
  K:=B08'ASCII(P1,10,SBUFF(I));                                         16926000
  I:=I+K;                                                               16928000
  IF K.(15:1)=0 THEN BEGIN SBUFF(I):=space;I:=I+1;END; <<PAD TO EVEN>>  16930000
  SBUFF(I):="d";I:=I+1; << ADD SUFFIX >>                                16932000
  IF UCN=0 THEN                                                         16934000
    BEGIN                                                               16936000
    MOVE SBUFF(I):=("0P");                                     <<04434>>16938000
    I:=I+2;                                                    <<04434>>16940000
    END ELSE                                                            16942000
    BEGIN                                                               16944000
    K:=B08'ASCII(UCN,10,SBUFF(I));                                      16946000
    I:=I+K;                                                             16948000
    IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END;                  16950000
    SBUFF(I):="W";I:=I+1;                                               16952000
    END;                                                                16954000
  END;                                                                  16956000
                                                                        16958000
                                                                        16960000
  BEGIN    <<FUNCTION CODE 65 >>                                        16962000
  P1 := P1 + 1;  << Increment because margin base is zero >>   <<04422>>16964000
  MOVE SBUFF(I):=(%33,"&a ");                                           16966000
  I:=I+4;                                                               16968000
  K:=B08'ASCII(P1,10,SBUFF(I));                                         16970000
  I:=I+K;                                                               16972000
  IF K.(15:1)=0 THEN BEGIN SBUFF(I):=%40;I:=I+1;END; <<PAD TO EVEN>>    16974000
  SBUFF(I):="L";I:=I+1;  << ADD SEQUENCE TERMINATOR >>                  16976000
  END;                                                                  16978000
                                                                        16980000
                                                                        16982000
  RETURN;  <<FUNCTION CODE 66 >>                                        16984000
                                                                        16986000
                                                                        16988000
  RETURN;  <<FUNCTION CODE 67 >>                                        16990000
                                                                        16992000
                                                                        16994000
  RETURN;  <<FUNCTION CODE 68 >>                                        16996000
                                                                        16998000
                                                                        17000000
  RETURN;  <<FUNCTION CODE 69 >>                                        17002000
                                                                        17004000
                                                                        17006000
  RETURN;  <<FUNCTION CODE 70 >>                                        17008000
                                                                        17010000
                                                                        17012000
  BEGIN    <<FUNCTION CODE 71 >>                                        17014000
  MOVE SBUFF(I):=(%33,"Z");                                             17016000
  I:=I+2;                                                               17018000
  END;                                                                  17020000
                                                                        17022000
                                                                        17024000
  RETURN;  <<FUNCTION CODE 72 >>                                        17026000
                                                                        17028000
                                                                        17030000
  RETURN;  <<FUNCTION CODE 73 >>                                        17032000
                                                                        17034000
                                                                        17036000
  RETURN;  <<FUNCTION CODE 74 >>                                        17038000
                                                                        17040000
                                                                        17042000
  RETURN;  <<FUNCTION CODE 75 >>                                        17044000
                                                                        17046000
                                                                        17048000
  RETURN;  <<FUNCTION CODE 76 >>                                        17050000
                                                                        17052000
                                                                        17054000
  RETURN;  <<FUNCTION CODE 77 >>                                        17056000
                                                                        17058000
                                                                        17060000
  RETURN;  <<FUNCTION CODE 78 >>                                        17062000
                                                                        17064000
                                                                        17066000
  RETURN;  <<FUNCTION CODE 79 >>                                        17068000
                                                                        17070000
                                                                        17072000
  RETURN;  <<FUNCTION CODE 80 >>                                        17074000
                                                                        17076000
                                                                        17078000
  RETURN;  <<FUNCTION CODE 81 >>                                        17080000
                                                                        17082000
                                                                        17084000
  RETURN;  <<FUNCTION CODE 82 >>                                        17086000
                                                                        17088000
                                                                        17090000
  RETURN;  <<FUNCTION CODE 83 >>                                        17092000
                                                                        17094000
                                                                        17096000
  RETURN;  <<FUNCTION CODE 84 >>                                        17098000
                                                                        17100000
                                                                        17102000
  RETURN;  <<FUNCTION CODE 85 >>                                        17104000
                                                                        17106000
                                                                        17108000
  RETURN;  <<FUNCTION CODE 86 >>                                        17110000
                                                                        17112000
                                                                        17114000
  RETURN;  <<FUNCTION CODE 87 >>                                        17116000
                                                                        17118000
                                                                        17120000
  RETURN;  <<FUNCTION CODE 88 >>                                        17122000
                                                                        17124000
                                                                        17126000
  RETURN;  <<FUNCTION CODE 89 >>                                        17128000
                                                                        17130000
                                                                        17132000
  RETURN;  <<FUNCTION CODE 90 >>                                        17134000
                                                                        17136000
                                                                        17138000
  RETURN;  <<FUNCTION CODE 91 >>                                        17140000
                                                                        17142000
                                                                        17144000
  RETURN;  <<FUNCTION CODE 92 >>                                        17146000
                                                                        17148000
                                                                        17150000
  RETURN;  <<FUNCTION CODE 93 >>                                        17152000
                                                                        17154000
                                                                        17156000
  RETURN;  <<FUNCTION CODE 94 >>                                        17158000
                                                                        17160000
                                                                        17162000
  RETURN;  <<FUNCTION CODE 95 >>                                        17164000
                                                                        17166000
                                                                        17168000
  RETURN;  <<FUNCTION CODE 96 >>                                        17170000
                                                                        17172000
                                                                        17174000
  RETURN;  <<FUNCTION CODE 97 >>                                        17176000
                                                                        17178000
                                                                        17180000
  RETURN;  <<FUNCTION CODE 98 >>                                        17182000
                                                                        17184000
                                                                        17186000
  RETURN;  <<FUNCTION CODE 99 >>                                        17188000
                                                                        17190000
                                                                        17192000
  RETURN;  <<FUNCTION CODE 100 >>                                       17194000
                                                                        17196000
                                                                        17198000
  RETURN;  <<FUNCTION CODE 101 >>                                       17200000
                                                                        17202000
                                                                        17204000
  RETURN;  <<FUNCTION CODE 102 >>                                       17206000
                                                                        17208000
                                                                        17210000
  RETURN;  <<FUNCTION CODE 103 >>                                       17212000
                                                                        17214000
                                                                        17216000
  RETURN;  <<FUNCTION CODE 104 >>                                       17218000
                                                                        17220000
                                                                        17222000
  RETURN;  <<FUNCTION CODE 105 >>                                       17224000
                                                                        17226000
                                                                        17228000
  RETURN;  <<FUNCTION CODE 106 >>                                       17230000
                                                                        17232000
                                                                        17234000
  RETURN;  <<FUNCTION CODE 107 >>                                       17236000
                                                                        17238000
                                                                        17240000
  RETURN;  <<FUNCTION CODE 108 >>                                       17242000
                                                                        17244000
                                                                        17246000
  RETURN;  <<FUNCTION CODE 109 >>                                       17248000
                                                                        17250000
                                                                        17252000
  RETURN;  <<FUNCTION CODE 110 >>                                       17254000
                                                                        17256000
                                                                        17258000
  RETURN;  <<FUNCTION CODE 111 >>                                       17260000
                                                                        17262000
                                                                        17264000
  RETURN;  <<FUNCTION CODE 112 >>                                       17266000
                                                                        17268000
                                                                        17270000
  RETURN;  <<FUNCTION CODE 113 >>                                       17272000
                                                                        17274000
                                                                        17276000
  RETURN;  <<FUNCTION CODE 114 >>                                       17278000
                                                                        17280000
                                                                        17282000
  RETURN;  <<FUNCTION CODE 115 >>                                       17284000
                                                                        17286000
                                                                        17288000
  RETURN;  <<FUNCTION CODE 116 >>                                       17290000
                                                                        17292000
                                                                        17294000
  RETURN;  <<FUNCTION CODE 117 >>                                       17296000
                                                                        17298000
                                                                        17300000
  RETURN;  <<FUNCTION CODE 118 >>                                       17302000
                                                                        17304000
                                                                        17306000
  RETURN;  <<FUNCTION CODE 119 >>                                       17308000
                                                                        17310000
                                                                        17312000
  RETURN;  <<FUNCTION CODE 120 >>                                       17314000
                                                                        17316000
                                                                        17318000
  RETURN;  <<FUNCTION CODE 121 >>                                       17320000
                                                                        17322000
                                                                        17324000
  RETURN;  <<FUNCTION CODE 122 >>                                       17326000
                                                                        17328000
                                                                        17330000
  RETURN;  <<FUNCTION CODE 123 >>                                       17332000
                                                                        17334000
                                                                        17336000
  RETURN;  <<FUNCTION CODE 124 >>                                       17338000
                                                                        17340000
                                                                        17342000
  RETURN;  <<FUNCTION CODE 125 >>                                       17344000
                                                                        17346000
                                                                        17348000
  RETURN;  <<FUNCTION CODE 126 >>                                       17350000
                                                                        17352000
                                                                        17354000
  RETURN;  <<FUNCTION CODE 127 >>                                       17356000
                                                                        17358000
                                                                        17360000
  BEGIN    <<FUNCTION CODE 128 >>                                       17362000
  MOVE SBUFF(I):=(%33,"(");                                             17364000
  I:=I+2;                                                               17366000
  k:=p1.(12:4);l:=language'code(k);                                     17368000
  sbuff(i):=bl(0);i:=i+1;                                               17370000
  sbuff(i):=bl(1);i:=i+1;                                               17372000
  MOVE SBUFF(I):=(%33,")");I:=I+2;                                      17374000
  k:=p2.(12:4);l:=language'code(k);                                     17376000
  sbuff(i):=bl(0);i:=i+1;                                               17378000
  sbuff(i):=bl(1);i:=i+1;                                               17380000
  END;                                                                  17382000
                                                                        17384000
                                                                        17386000
  RETURN;  <<FUNCTION CODE 129 >>                                       17388000
                                                                        17390000
                                                                        17392000
  RETURN;  <<FUNCTION CODE 130 >>                                       17394000
                                                                        17396000
                                                                        17398000
  RETURN;  <<FUNCTION CODE 131 >>                                       17400000
                                                                        17402000
                                                                        17404000
  RETURN;  <<FUNCTION CODE 132 >>                                       17406000
                                                                        17408000
                                                                        17410000
  RETURN;  <<FUNCTION CODE 133 >>                                       17412000
                                                                        17414000
                                                                        17416000
  RETURN;  <<FUNCTION CODE 134 >>                                       17418000
                                                                        17420000
                                                                        17422000
  RETURN;  <<FUNCTION CODE 135 >>                                       17424000
                                                                        17426000
                                                                        17428000
  RETURN;  <<FUNCTION CODE 136 >>                                       17430000
                                                                        17432000
                                                                        17434000
  RETURN;  <<FUNCTION CODE 137 >>                                       17436000
                                                                        17438000
                                                                        17440000
  RETURN;  <<FUNCTION CODE 138 >>                                       17442000
                                                                        17444000
                                                                        17446000
  RETURN;  <<FUNCTION CODE 139 >>                                       17448000
                                                                        17450000
                                                                        17452000
  RETURN;  <<FUNCTION CODE 140 >>                                       17454000
                                                                        17456000
                                                                        17458000
  BEGIN    <<FUNCTION CODE 141 >>                                       17460000
  MOVE SBUFF(I):=(%33,"E");                                             17462000
  I:=I+2;                                                               17464000
  END;                                                                  17466000
                                                                        17468000
                                                                        17470000
  BEGIN    <<FUNCTION CODE 142 >>                              <<04472>>17472000
    P2save := 0;                                               <<04472>>17474000
    old'tof := 1;                                              <<04472>>17476000
  END;                                                         <<04472>>17478000
                                                                        17480000
                                                                        17482000
  BEGIN    <<FUNCTION CODE 143 >>                                       17484000
  MOVE SBUFF(I):=(%33,"E");                                             17486000
  I:=I+2;                                                               17488000
  END;                                                                  17490000
                                                                        17492000
                                                                        17494000
  RETURN;  <<FUNCTION CODE 144 >>                                       17496000
END;  << of case statement >>                                           17498000
                                                                        17500000
                                                                        17502000
<< Make certain that the ones requested odd are odd. >>                 17504000
IF PRESODD=1 AND I>0 THEN                                               17506000
  BEGIN                                                                 17508000
  K:=0;                                                                 17510000
  WHILE SBUFF(K)<>%40 DO K:=K+1;                                        17512000
  IF K<I THEN                                                           17514000
    BEGIN                                                               17516000
    MOVE SBUFF(K):=SBUFF(K+1),(I-K);                                    17518000
    I:=I-1;                                                             17520000
    END;                                                                17522000
  END;                                                                  17524000
                                                                        17526000
                                                                        17528000
IF UCN.(15:1)=1 AND J>0 THEN                                            17530000
  BEGIN                                                                 17532000
  K:=0;                                                                 17534000
  WHILE EBUFF(K)<>%40 DO K:=K+1;                                        17536000
  IF K<J THEN                                                           17538000
    BEGIN                                                               17540000
    MOVE EBUFF(K):=EBUFF(K+1),(J-K);                                    17542000
    J:=J-1;                                                             17544000
    END;                                                                17546000
  END;                                                                  17548000
                                                                        17550000
                                                                        17552000
<< make sure the goods are sent back >>                                 17554000
  SCNT:=I;                                                              17556000
   ECNT:=J;                                                             17558000
  ERR:=no'errors;                                                       17560000
                                                                        17562000
cpr'xlate:=rtnvalue;                                                    17564000
end; <<cpr'xlate>>                                                      17566000
                                                                        17568000
  << CIPER level 7 >>                                                   17570000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS"                               17572000
procedure b08'clean'comp'status( cb'info );                             17574000
                                                                        17576000
  value                          cb'info  ;                             17578000
                                                                        17580000
  integer pointer                cb'info  ;                             17582000
                                                                        17584000
  option privileged, uncallable           ;                             17586000
                                                                        17588000
                                                                        17590000
COMMENT                                                                 17592000
                                                                        17594000
  PURPOSE:                                                              17596000
                                                                        17598000
    This procedure will zero out the cbix area known as the             17600000
    composite status area.  This region will contain a 'logical         17602000
    or' of all device status reports that are received during           17604000
    a single call to the logical driver.  The contents of this          17606000
    area are returned if a calling program requests buffered            17608000
    composite status.                                                   17610000
                                                                        17612000
    The area is zeroed out at the start of every call to the            17614000
    logical driver, or after the contents are returned to the           17616000
    calling program.                                                    17618000
                                                                        17620000
                                                                        17622000
  INPUT PARAMETERS:                                                     17624000
                                                                        17626000
    CB'INFO, which points to the control block information              17628000
      (CBI) area of the logical driver.  This area contains             17630000
      the pointer to the composite status area, as well as a            17632000
      flag which is set true to indicate that some composite            17634000
      status is available.                                              17636000
                                                                        17638000
                                                                        17640000
  OUTPUT PARAMETERS:                                                    17642000
                                                                        17644000
    None.                                                               17646000
                                                                        17648000
                                                                        17650000
  SIDE-EFFECTS:                                                         17652000
                                                                        17654000
    None.                                                               17656000
                                                                        17658000
                                                                        17660000
  SPECIAL CONSIDERATIONS:                                               17662000
                                                                        17664000
    When called, DB must be pointing to the CIPER data segment.         17666000
                                                                        17668000
                                                                        17670000
  CHANGE HISTORY:                                                       17672000
                                                                        17674000
    As issued.                                                          17676000
                                                                        17678000
;                                                                       17680000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS -- LOCAL DECLARATIONS"         17682000
begin                                                                   17684000
                                                                        17686000
  integer pointer                                                       17688000
                                                                        17690000
    comp'status                                                         17692000
      << points to the composite status area of the CBIX >>             17694000
                                                                        17696000
  ;                                                                     17698000
$PAGE "PROCEDURE:  B08'CLEAN'COMP'STATUS -- PROCEDURE BODY"             17700000
  << Initialize the pointer to the composite status area >>             17702000
                                                                        17704000
  @comp'status := cb'info(composite'status'base)                        17706000
                + cb'info(cds'area'base);                               17708000
                                                                        17710000
                                                                        17712000
  << Turn off the flag that indicates some composite status >>          17714000
  << is available.                                          >>          17716000
                                                                        17718000
  cb'info(comp'stat'available) := false;                                17720000
                                                                        17722000
                                                                        17724000
  << Zero out the area. >>                                              17726000
                                                                        17728000
  x := comp'status'length - 1;                                          17730000
                                                                        17732000
  do                                                                    17734000
    begin                                                               17736000
      comp'status(x) := 0;                                              17738000
    end                                                                 17740000
  until (x := x - 1) < 0;                                               17742000
                                                                        17744000
                                                                        17746000
  << All done >>                                                        17748000
                                                                        17750000
end;  << of procedure b08'clean'comp'status >>                          17752000
                                                                        17754000
$PAGE "PROCEDURE:  B08'GET'BUFFER"                                      17756000
logical procedure b08'get'buffer(cb'info, override'option);             17758000
                                                                        17760000
  value                          cb'info, override'option ;             17762000
                                                                        17764000
  integer pointer                cb'info                  ;             17766000
                                                                        17768000
  integer                                 override'option ;             17770000
                                                                        17772000
  option privileged, uncallable                           ;             17774000
                                                                        17776000
                                                                        17778000
COMMENT                                                                 17780000
                                                                        17782000
  PURPOSE:                                                              17784000
                                                                        17786000
    This procedure will delink and allocate a record buffer             17788000
    area, if one is available from the free-list.  If no area           17790000
    is available, zero is returned, otherwise the DB-relative           17792000
    address of the area is returned.                                    17794000
                                                                        17796000
                                                                        17798000
  INPUT PARAMETERS:                                                     17800000
                                                                        17802000
    CB'INFO, which points to the control block information              17804000
      area of level 7.  The free-list pointer is maintained in          17806000
      this global area.                                                 17808000
                                                                        17810000
    OVERRIDE'OPTION, which describes what the caller wants              17812000
      done if there are no buffer areas in the freelist.  If            17814000
      a value of zero is specified, a nil pointer will be re-           17816000
      turned.  A value of one will cause the dedicated output           17818000
      buffer to be returned.  A value of two will cause the             17820000
      dedicated input buffer to be used.                                17822000
                                                                        17824000
                                                                        17826000
  OUTPUT PARAMETERS:                                                    17828000
                                                                        17830000
    B08'GET'BUFFER, which is the function return, will be nil           17832000
      if no buffer was available, otherwise it will return the          17834000
      DB-relative address of the buffer.                                17836000
                                                                        17838000
                                                                        17840000
  SIDE-EFFECTS:                                                         17842000
                                                                        17844000
    None.                                                               17846000
                                                                        17848000
                                                                        17850000
  SPECIAL CONSIDERATIONS:                                               17852000
                                                                        17854000
    When called, DB must be set to the base of the CIPER data           17856000
    segment.                                                            17858000
                                                                        17860000
                                                                        17862000
  CHANGE HISTORY:                                                       17864000
                                                                        17866000
    As issued.                                                          17868000
                                                                        17870000
                                                                        17872000
;                                                                       17874000
$PAGE "PROCEDURE:  B08'GET'BUFFER -- LOCAL VARIABLES"                   17876000
begin                                                                   17878000
                                                                        17880000
  integer pointer                                                       17882000
                                                                        17884000
    new'buffer                                                          17886000
      << points to buffer acquired from free-list >>                    17888000
                                                                        17890000
  ;                                                                     17892000
$PAGE "PROCEDURE:  B08'GET'BUFFER -- PROCEDURE BODY"                    17894000
                                                                        17896000
  if cb'info(free'buff'list) = nil then                                 17898000
    begin                                                               17900000
      << No buffers are available from the freelist.  The >>            17902000
      << override option will tell us what to do.         >>            17904000
                                                                        17906000
      case override'option of                                           17908000
        begin                                                           17910000
                                                                        17912000
          << No override, return nil >>                                 17914000
          begin                                                         17916000
            @new'buffer := nil;                                         17918000
          end;                                                          17920000
                                                                        17922000
          << Use the dedicated output buffer >>                         17924000
          begin                                                         17926000
            @new'buffer := cb'info(o'r'base)                            17928000
                         + cb'info(cds'area'base);                      17930000
                                                                        17932000
            if logical( new'buffer(active) ) then                       17934000
              begin                                                     17936000
                new'buffer(active) := free;                             17938000
                cb'info(out'recs'overwritten) :=                        17940000
                    cb'info(out'recs'overwritten) + 1;                  17942000
              end;                                                      17944000
          end;                                                          17946000
                                                                        17948000
          << Use the dedicated input buffer >>                          17950000
          begin                                                         17952000
            @new'buffer := cb'info(i'r'base)                            17954000
                         + cb'info(cds'area'base);                      17956000
                                                                        17958000
            if logical( new'buffer(active) ) then                       17960000
              begin                                                     17962000
                new'buffer(active) := free;                             17964000
                cb'info(in'recs'overwritten) :=                         17966000
                    cb'info(in'recs'overwritten) + 1;                   17968000
              end;                                                      17970000
          end;                                                          17972000
                                                                        17974000
        end;  << of case override'option >>                             17976000
                                                                        17978000
    end                                                                 17980000
  else                                                                  17982000
    begin                                                               17984000
      << There is a buffer available.  Delink it and init >>            17986000
      << ialize.                                           >>           17988000
                                                                        17990000
      @new'buffer := cb'info(free'buff'list)                            17992000
                   + cb'info(cds'area'base);                            17994000
                                                                        17996000
      cb'info(free'buff'list) := new'buffer(forward'link);              17998000
                                                                        18000000
      new'buffer(forward'link) := nil;                                  18002000
      new'buffer(allocated) := in'use;                                  18004000
    end;                                                                18006000
                                                                        18008000
  b08'get'buffer := @new'buffer;                                        18010000
                                                                        18012000
end;  << of procedure b08'get'buffer >>                                 18014000
                                                                        18016000
$PAGE "PROCEDURE:  B08'RELEASE'BUFFER"                                  18018000
logical procedure b08'release'buffer(cb'info, old'buffer);              18020000
                                                                        18022000
  value                              cb'info, old'buffer ;              18024000
                                                                        18026000
  integer pointer                    cb'info, old'buffer ;              18028000
                                                                        18030000
  option privileged, uncallable                          ;              18032000
                                                                        18034000
                                                                        18036000
COMMENT                                                                 18038000
                                                                        18040000
  PURPOSE:                                                              18042000
                                                                        18044000
    This procedure will deallocate (relink into free-list)              18046000
    the record buffer area pointed to by old'buffer.  When              18048000
    placed in the free-list, the pointer is converted from              18050000
    DB-relative to cds area relative.                                   18052000
                                                                        18054000
                                                                        18056000
  INPUT PARAMETERS:                                                     18058000
                                                                        18060000
    CB'INFO, a pointer to the control block information area,           18062000
      where the free-list head is maintained.                           18064000
                                                                        18066000
    OLD'BUFFER, the DB-relative pointer to the buffer area to           18068000
      be placed in the free-list.                                       18070000
                                                                        18072000
                                                                        18074000
  OUTPUT PARAMETERS:                                                    18076000
                                                                        18078000
    None.                                                               18080000
                                                                        18082000
                                                                        18084000
  SIDE-EFFECTS:                                                         18086000
                                                                        18088000
    None.                                                               18090000
                                                                        18092000
                                                                        18094000
  SPECIAL CONSIDERATIONS:                                               18096000
                                                                        18098000
    When called, DB must be pointing to the CIPER data segment.         18100000
                                                                        18102000
                                                                        18104000
  CHANGE HISTORY:                                                       18106000
                                                                        18108000
    As issued.                                                          18110000
                                                                        18112000
                                                                        18114000
;                                                                       18116000
$PAGE "PROCEDURE:  B08'RELEASE'BUFFER -- PROCEDURE BODY"                18118000
begin                                                                   18120000
                                                                        18122000
  << Determine if the buffer is to actually be released, or >>          18124000
  << just marked free.                                      >>          18126000
                                                                        18128000
  if @old'buffer = (cb'info(o'r'base) + cb'info(cds'area'base))         18130000
  or @old'buffer = (cb'info(i'r'base) + cb'info(cds'area'base))         18132000
  then                                                                  18134000
    begin                                                               18136000
      old'buffer(active) := free;                                       18138000
      old'buffer(ready) := false;                                       18140000
    end                                                                 18142000
  else                                                                  18144000
    begin                                                               18146000
      << First, tie in the rest of the list. >>                         18148000
                                                                        18150000
      old'buffer(forward'link) := cb'info(free'buff'list);              18152000
                                                                        18154000
      << Next, mark buffer as 'not allocated' >>                        18156000
                                                                        18158000
      x := ready + 1;                                                   18160000
      while dxbz do old'buffer(x) := free;                              18162000
                                                                        18164000
      << Add buffer into head of free-list. >>                          18166000
                                                                        18168000
      cb'info(free'buff'list) := @old'buffer                            18170000
                               - cb'info(cds'area'base);                18172000
    end;                                                                18174000
                                                                        18176000
  << All done!! >>                                                      18178000
                                                                        18180000
end;  << of procedure b08'release'buffer >>                             18182000
                                                                        18184000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS"                                   18186000
integer procedure b08'device'status(cb'info, i'r'control);              18188000
                                                                        18190000
  value                             cb'info, i'r'control ;              18192000
                                                                        18194000
  integer pointer                   cb'info, i'r'control ;              18196000
                                                                        18198000
  option privileged, uncallable                          ;              18200000
                                                                        18202000
                                                                        18204000
                                                                        18206000
COMMENT                                                                 18208000
                                                                        18210000
  PURPOSE:                                                              18212000
                                                                        18214000
    This procedure will evaluate the device status report re-           18216000
    turned by the 2608B printer.  If necessary, messages will           18218000
    be sent to the system console to alert the operator of              18220000
    the state of the device.  The latest copy of the status             18222000
    report will be stored in the cbix for comparison against            18224000
    a future status report.                                             18226000
                                                                        18228000
                                                                        18230000
  INPUT PARAMETERS:                                                     18232000
                                                                        18234000
    CB'INFO, which is a pointer to the control block informa-           18236000
      tion area of this particular device and level.                    18238000
                                                                        18240000
    I'R'CONTROL, which is a pointer to the input record buffer          18242000
      which contains the device status report to be processed.          18244000
                                                                        18246000
                                                                        18248000
  OUTPUT PARAMETERS:                                                    18250000
                                                                        18252000
    B08'DEVICE'STATUS, which is an integer function return.             18254000
      This will contain the completion status of the call.  A           18256000
      value of one is returned if no errors were detected.              18258000
      Other values will be defined as required.                         18260000
                                                                        18262000
                                                                        18264000
  SIDE-EFFECTS:                                                         18266000
                                                                        18268000
    This procedure may cause messages to be sent to the system          18270000
    console.  In addition, its function return value may in-            18272000
    dicate exceptional conditions, such as device powerfail,            18274000
    which will have to be reported back to the calling process          18276000
    for potential error recovery.                                       18278000
                                                                        18280000
                                                                        18282000
  SPECIAL CONSIDERATIONS:                                               18284000
                                                                        18286000
    When called, DB must be set to the base of the CIPER data           18288000
    segment.                                                            18290000
                                                                        18292000
                                                                        18294000
  CHANGE HISTORY:                                                       18296000
                                                                        18298000
    As issued.                                                          18300000
                                                                        18302000
                                                                        18304000
;                                                                       18306000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- LOCAL VARIABLES"                18308000
begin                                                                   18310000
                                                                        18312000
  << DECLARATION OF LOCAL VARIABLES >>                                  18314000
                                                                        18316000
                                                                        18318000
  integer                                                               18320000
                                                                        18322000
    return'status                 = b08'device'status                   18324000
      << Function return status >>                                      18326000
                                                               <<04446>>18328000
   ,dc'results                                                 <<04446>>18330000
      << Status return from device clear, if one is done >>    <<04446>>18332000
                                                                        18334000
  ;                                                                     18336000
                                                                        18338000
                                                                        18340000
  logical pointer                                                       18342000
                                                                        18344000
    old'status                                                          18346000
      << points to base of old (previous) status report con- >>         18348000
      << tained in the cbix.                                 >>         18350000
                                                                        18352000
   ,new'status                                                          18354000
      << points to base of new status report which, when     >>         18356000
      << this procedure is called, will still be located in  >>         18358000
      << an input record buffer area.                        >>         18360000
                                                                        18362000
  ;                                                                     18364000
                                                                        18366000
                                                                        18368000
  byte pointer                                                          18370000
                                                                        18372000
    move'from                                                           18374000
      << points to first byte of device status while it is   >>         18376000
      << still in an input record buffer area.  Used to move >>         18378000
      << the status report into the permanent status area.   >>         18380000
                                                                        18382000
   ,move'to                                                             18384000
      << Points to the region of the permanent status area   >>         18386000
      << where the status report is to be moved, when taken  >>         18388000
      << out of the input record buffer area.                >>         18390000
                                                                        18392000
  ;                                                                     18394000
                                                                        18396000
                                                                        18398000
  logical                                                               18400000
                                                                        18402000
    delta'status                                                        18404000
      << contains bit map of status bits that have changed >>           18406000
                                                                        18408000
   ,do'device'clear                                                     18410000
      << Set true to indicate that a device clear should be >>          18412000
      << performed before exiting because of certain device >>          18414000
      << failures (such as power fail, protocol errors, etc >>          18416000
                                                                        18418000
                                                                        18420000
  ;                                                                     18422000
                                                                        18424000
  logical array                                                         18426000
                                                                        18428000
    message'map(0:31)             = pb :=                               18430000
                                                                        18432000
      << ps'on base starts here >>                                      18434000
                                                                        18436000
      on'line'msg                                                       18438000
     ,paper'out'msg                                                     18440000
     ,paper'jam'msg                                                     18442000
     ,platen'open'msg                                                   18444000
     ,ribbon'error'msg                                                  18446000
     ,0                                                                 18448000
     ,0                                                                 18450000
     ,0                                                                 18452000
                                                                        18454000
      << ps'off base starts here >>                                     18456000
                                                                        18458000
     ,off'line'msg                                                      18460000
     ,0                                                                 18462000
     ,0                                                                 18464000
     ,0                                                                 18466000
     ,0                                                                 18468000
     ,0                                                                 18470000
     ,0                                                                 18472000
     ,0                                                                 18474000
                                                                        18476000
      << cpe'base starts here >>                                        18478000
                                                                        18480000
     ,msg'illegal'header'length                                         18482000
     ,msg'record'sequence'error                                         18484000
     ,msg'illegal'creator'of'record                                     18486000
     ,msg'undef'record'opcode                                           18488000
     ,msg'undef'data'type                                               18490000
     ,msg'bad'esb'format'number                                         18492000
     ,0                                                                 18494000
     ,msg'bad'block'label'length                                        18496000
     ,msg'transport'error                                               18498000
     ,msg'data'overrun                                                  18500000
     ,0                                                                 18502000
     ,0                                                                 18504000
     ,0                                                                 18506000
     ,0                                                                 18508000
     ,0                                                                 18510000
     ,0                                                                 18512000
                                                                        18514000
  ;                                                                     18516000
                                                                        18518000
                                                                        18520000
  equate                                                                18522000
                                                                        18524000
    pson'base                     = 0                                   18526000
      << message'map base for peripheral status bits set >>             18528000
                                                                        18530000
   ,psoff'base                    = 8                                   18532000
      << message'map base for peripheral status bits clear >>           18534000
                                                                        18536000
   ,cpe'base                      = 16                                  18538000
      << message'map base for ciper protocol error bits set >>          18540000
                                                                        18542000
  ;                                                                     18544000
                                                                        18546000
                                                                        18548000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- SUBROUTINE: EVALUATE"           18550000
subroutine evaluate(range, message'base, bit'set);                      18552000
                                                                        18554000
  value             range, message'base, bit'set ;                      18556000
                                                                        18558000
  integer           range, message'base, bit'set ;                      18560000
                                                                        18562000
                                                                        18564000
COMMENT                                                                 18566000
                                                                        18568000
;                                                                       18570000
                                                                        18572000
begin                                                                   18574000
                                                                        18576000
  if range = 8 then bit'set := bit'set & lsl(8);                        18578000
                                                                        18580000
  do                                                                    18582000
    begin                                                               18584000
      if bit'set < 0 and message'map(message'base) <> 0 then            18586000
        begin                                                           18588000
          cpr'genmsg(ciper'set,                                         18590000
                     message'map(message'base),                         18592000
                     %10000,cb'info(logical'device),,,,,0);             18594000
        end;                                                            18596000
      bit'set := bit'set & lsl(1);                                      18598000
      message'base := message'base + 1;                                 18600000
      range := range - 1;                                               18602000
    end                                                                 18604000
  until range = 0;                                                      18606000
                                                                        18608000
end;  << of subroutine evaluate >>                                      18610000
                                                                        18612000
                                                                        18614000
                                                                        18616000
                                                                        18618000
                                                                        18620000
$PAGE "PROCEDURE:  B08'DEVICE'STATUS -- PROCEDURE BODY"                 18622000
  << Initialize the flag that indicates whether or not a >>             18624000
  << device clear needs to be performed.                 >>             18626000
                                                                        18628000
  do'device'clear := false;                                             18630000
                                                                        18632000
                                                                        18634000
  << Set error return to initial value >>                               18636000
                                                                        18638000
  b08'device'status := successful;                                      18640000
                                                                        18642000
                                                                        18644000
  << Set up pointers for the permanent status area >>                   18646000
                                                                        18648000
  @old'status := cb'info(dev'status'base)                               18650000
               + cb'info(cds'area'base);                                18652000
  @new'status := @old'status + (device'status'length to'word);          18654000
                                                                        18656000
                                                                        18658000
  << Move the new status from the input record buffer, so it >>         18660000
  << will be aligned on a word boundary.  Then set the re-   >>         18662000
  << cord buffer area free.                                  >>         18664000
                                                                        18666000
  @move'from := i'r'control(current'position)                           18668000
              + @i'r'control to'byte;                                   18670000
  @move'to := @new'status to'byte;                                      18672000
  move move'to := move'from,(device'status'length);                     18674000
  i'r'control(active) := integer(free);                                 18676000
                                                                        18678000
                                                                        18680000
  << Now, start moving the new information in bit by bit, so >>         18682000
  << any change can be detected.  Under certain circumstan-  >>         18684000
  << ses, a message will have to sent to the console.        >>         18686000
                                                                        18688000
  << Evaluate the self test failure bit.  If it is >>                   18690000
  << set, send the failure message, incorporating the fail- >>          18692000
  << ure code as part of the message.                       >>          18694000
                                                                        18696000
  old'status(self'test'failed) := new'status(self'test'failed);         18698000
  old'status(self'test'code) := new'status(self'test'code);             18700000
                                                                        18702000
  if old'status(self'test'failed) then                                  18704000
    begin                                                               18706000
                                                                        18708000
      cpr'genmsg( ciper'set                                             18710000
                 ,self'test'msg                                         18712000
                 ,%11000  << parm mask >>                               18714000
                 ,cb'info(logical'device)                               18716000
                 ,old'status(self'test'code)                            18718000
                 ,  << parm 3 >>                                        18720000
                 ,  << parm 4 >>                                        18722000
                 ,  << parm 5 >>                                        18724000
                 ,0  << destination:  console >>  );                    18726000
                                                                        18728000
      return'status := error'so'read'status;                            18730000
                                                                        18732000
    end;                                                                18734000
                                                                        18736000
                                                                        18738000
                                                                        18740000
  << Now check the CIPER protocol error byte. >>                        18742000
                                                                        18744000
  old'status(ciper'protocol'errors) :=                                  18746000
      new'status(ciper'protocol'errors);                                18748000
                                                                        18750000
  if old'status(ciper'protocol'errors) is'not'zero then                 18752000
    begin                                                               18754000
      << A protocol error has occurred, so evaluate bit >>              18756000
      << by bit.                                        >>              18758000
                                                                        18760000
      evaluate(16,cpe'base,old'status(ciper'protocol'errors));          18762000
                                                                        18764000
      do'device'clear := true;                                          18766000
                                                                        18768000
      b08'device'status := error'so'read'status;                        18770000
                                                                        18772000
    end;  << of new ciper protocol errors >>                            18774000
                                                                        18776000
                                                                        18778000
  << Next, check the powerfail information >>                           18780000
                                                                        18782000
  old'status(peripheral'errors) :=                                      18784000
      new'status(peripheral'errors);                                    18786000
                                                                        18788000
  if old'status(power'fail) then                                        18790000
    begin                                                               18792000
                                                                        18794000
        << send the power fail message to the console  >>               18796000
                                                                        18798000
      cpr'genmsg( ciper'set                                             18800000
                 ,power'up'msg                                          18802000
                 ,%10000  << parm mask >>                               18804000
                 ,cb'info(logical'device)                               18806000
                 ,  << parm 2 >>                                        18808000
                 ,  << parm 3 >>                                        18810000
                 ,  << parm 4 >>                                        18812000
                 ,  << parm 5 >>                                        18814000
                 ,0  << destination:  console >> );                     18816000
                                                                        18818000
      do'device'clear := true;                                          18820000
                                                                        18822000
      << set the error return to reflect a power fail >>                18824000
                                                                        18826000
      b08'device'status := pf'error;                                    18828000
    end                                                                 18830000
  else                                                                  18832000
    begin                                                               18834000
                                                                        18836000
      if old'status(possible'data'loss) then                            18838000
        begin                                                           18840000
                                                                        18842000
          cpr'genmsg( ciper'set                                         18844000
                     ,msg'data'lost                                     18846000
                     ,%10000  << parm mask >>                           18848000
                     ,cb'info(logical'device)                           18850000
                     ,  << parm 2 >>                                    18852000
                     ,  << parm 3 >>                                    18854000
                     ,  << parm 4 >>                                    18856000
                     ,  << parm 5 >>                                    18858000
                     ,0  << destination:  console >>  );                18860000
                                                                        18862000
          return'status := error'so'read'status;                        18864000
                                                                        18866000
        end;                                                            18868000
    end;                                                                18870000
                                                                        18872000
                                                                        18874000
  << Next, evaluate the peripheral status byte, which con-   >>         18876000
  << tains on-line/off-line, paper out, paper jam, platen    >>         18878000
  << open, ribbon error, and mechanical error information.   >>         18880000
                                                                        18882000
  if old'status(peripheral'status) <>                                   18884000
      new'status(peripheral'status) then                                18886000
    begin                                                               18888000
                                                                        18890000
      delta'status := old'status(peripheral'status) xor                 18892000
          new'status(peripheral'status);                                18894000
                                                                        18896000
      evaluate(8,pson'base,(delta'status land                           18898000
          new'status(peripheral'status)));                              18900000
                                                                        18902000
      evaluate(8,psoff'base,(delta'status land                          18904000
          old'status(peripheral'status)));                              18906000
                                                                        18908000
      old'status(peripheral'status) :=                                  18910000
          new'status(peripheral'status);                                18912000
                                                                        18914000
      if return'status = successful then                                18916000
        begin                                                           18918000
          << Nothing serious has been detected yet, so look >>          18920000
          << for minor errors that the user/spooler might   >>          18922000
          << want to know about.                            >>          18924000
                                                                        18926000
          if old'status(paper'jam)                                      18928000
          or old'status(platen'open)                                    18930000
          or old'status(ribbon'error) then                              18932000
            begin                                                       18934000
                                                                        18936000
              return'status := error'so'read'status;                    18938000
                                                                        18940000
            end;                                                        18942000
        end;                                                            18944000
                                                                        18946000
                                                                        18948000
    end;  << of changes in peripheral status byte >>                    18950000
                                                                        18952000
                                                                        18954000
  << Now merge the new status received into the composite >>            18956000
  << status area.  This area only reflects status reports >>            18958000
  << received during this call to the logical driver.     >>            18960000
                                                                        18962000
  @new'status := cb'info(composite'status'area)                         18964000
               + cb'info(cds'area'base);                                18966000
                                                                        18968000
  x := comp'status'length - 1;                                          18970000
                                                                        18972000
  do                                                                    18974000
    begin                                                               18976000
      new'status(x) := new'status(x) lor old'status(x);                 18978000
    end                                                                 18980000
  until (x := x - 1) < 0;                                               18982000
                                                                        18984000
  cb'info(comp'stat'available) := true;                                 18986000
                                                                        18988000
                                                                        18990000
  << Set status management bits to reflect the fact that >>             18992000
  << some new status is available.                       >>             18994000
                                                                        18996000
  cb'info(status'received).dev'stat'bit := set'bit;                     18998000
  cb'info(status'reported).dev'stat'bit := clear'bit;                   19000000
                                                                        19002000
                                                                        19004000
  << If the flag to perform a device clear has been set, >>             19006000
  << now is the time to execute the command.             >>             19008000
                                                                        19010000
  if do'device'clear then                                               19012000
    begin                                                               19014000
                                                                        19016000
      dc'results := b08'device'clear( cb'info, 1 );            <<04446>>19018000
                                                               <<04446>>19020000
      << A powerfail is about the only thing that could hap- >><<04446>>19022000
      << pen that is worse than what caused us to do the de- >><<04446>>19024000
      << vice clear in the first place so return that status >><<04446>>19026000
                                                               <<04446>>19028000
      if dc'results = pf'error then                            <<04446>>19030000
        begin                                                  <<04446>>19032000
          return'status := dc'results;                         <<04446>>19034000
        end;                                                   <<04446>>19036000
                                                                        19038000
    end;                                                                19040000
                                                                        19042000
                                                                        19044000
end;  << of b08'device'status >>                                        19046000
                                                                        19048000
$PAGE "PROCEDURE:  B08'JOB'REPORT"                                      19050000
integer procedure B08'job'report(cb'info, i'r'control);                 19052000
                                                                        19054000
  value                          cb'info, i'r'control ;                 19056000
                                                                        19058000
  integer pointer                cb'info, i'r'control ;                 19060000
                                                                        19062000
  option privileged, uncallable                       ;                 19064000
                                                                        19066000
                                                                        19068000
COMMENT                                                                 19070000
                                                                        19072000
  PURPOSE:                                                              19074000
                                                                        19076000
    This procedure will evaluate the contents of a device's             19078000
    JOB REPORT, which is returned when the device completes             19080000
    the processing associated with a particular job.  The               19082000
    format of the report is device dependent, but in the case           19084000
    of the 2608B printer, the following information is re-              19086000
    turned:                                                             19088000
                                                                        19090000
      word 0 - number of physical sheets printed during job             19092000
                                                                        19094000
                                                                        19096000
  INPUT PARAMETERS:                                                     19098000
                                                                        19100000
    CB'INFO, which is a pointer to the control block informa-           19102000
      tion area of the logical driver for this device.                  19104000
                                                                        19106000
    I'R'CONTROL, which is a pointer to the input record buffer          19108000
      that contains the job report to be processed.                     19110000
                                                                        19112000
                                                                        19114000
  OUTPUT PARAMETERS:                                                    19116000
                                                                        19118000
    B08'JOB'REPORT, which is the function completion code.  A           19120000
      value of one is returned if no errors occurred during the         19122000
      processing of the job report.  Other values will be de-           19124000
      fined as required.                                                19126000
                                                                        19128000
                                                                        19130000
  SIDE-EFFECTS:                                                         19132000
                                                                        19134000
    The job report area will be updated with the information            19136000
    returned by the device.  The input record buffer will be            19138000
    released to the free list when finished.                            19140000
                                                                        19142000
                                                                        19144000
  SPECIAL CONSIDERATIONS:                                               19146000
                                                                        19148000
    When called, DB must be set to the base of the CIPER data           19150000
    segment.  The record pointed to by i'r'control must be              19152000
    marked as active, or the procedure will return an error.            19154000
                                                                        19156000
                                                                        19158000
  CHANGE HISTORY:                                                       19160000
                                                                        19162000
    As issued.                                                          19164000
                                                                        19166000
;                                                                       19168000
                                                                        19170000
$PAGE "PROCEDURE:  B08'JOB'REPORT -- LOCAL DECLARATIONS"                19172000
begin                                                                   19174000
                                                                        19176000
  << Declaration of local variables and constants >>                    19178000
                                                                        19180000
  byte pointer                                                          19182000
                                                                        19184000
    input'position                                                      19186000
      << points to current position in input buffer >>                  19188000
                                                                        19190000
   ,report'base                                                         19192000
      << points to base of job report area of CDS >>                    19194000
                                                                        19196000
  ;                                                                     19198000
                                                                        19200000
                                                                        19202000
$PAGE "PROCEDURE:  B08'JOB'REPORT -- PROCEDURE BODY"                    19204000
  << First, set up the pointer to the job report area and >>            19206000
  << the input data.                                      >>            19208000
                                                                        19210000
  @report'base := ( cb'info(job'report'base)                            19212000
                    + cb'info(cds'area'base) ) to'byte;                 19214000
                                                                        19216000
  @input'position := i'r'control(current'position)                      19218000
                   + @i'r'control to'byte;                              19220000
                                                                        19222000
  << Now move the information into the job report area. >>              19224000
                                                                        19226000
  move report'base := input'position,(job'report'length);               19228000
                                                                        19230000
  << Set the input record free. >>                                      19232000
                                                                        19234000
  i'r'control(active) := free;                                          19236000
                                                                        19238000
  << All done! >>                                                       19240000
                                                                        19242000
  b08'job'report := no'errors;                                          19244000
                                                                        19246000
end;  << of b08'job'report >>                                           19248000
                                                                        19250000
$PAGE "PROCEDURE B08'RCV'RDY"                                           19252000
integer procedure B08'rcv'rdy(cb'info, i'r'control);                    19254000
                                                                        19256000
  value                       cb'info, i'r'control ;                    19258000
                                                                        19260000
  integer pointer             cb'info, i'r'control ;                    19262000
                                                                        19264000
  option privileged, uncallable                    ;                    19266000
                                                                        19268000
                                                                        19270000
COMMENT                                                                 19272000
                                                                        19274000
  PURPOSE:                                                              19276000
                                                                        19278000
    This procedure evaluates RECEIVE READY responces from the           19280000
    peripheral, and adds the reported buffer count to the               19282000
    count of available peripheral buffers maintained in the             19284000
    control block information area.                                     19286000
                                                                        19288000
                                                                        19290000
  INPUT PARAMETERS:                                                     19292000
                                                                        19294000
    CB'INFO, the pointer to the control block information area,         19296000
      where the receive ready count is maintained.                      19298000
                                                                        19300000
    I'R'CONTROL, which points to the input record buffer area           19302000
      that contains the RECEIVE READY report to evaluate.               19304000
                                                                        19306000
                                                                        19308000
  OUTPUT PARAMETERS:                                                    19310000
                                                                        19312000
    B08'RCV'RDY, which will take on the completion status of            19314000
      the call.  A value of one is returned if no errors were           19316000
      encountered.  Other values will be defined as required.           19318000
                                                                        19320000
                                                                        19322000
  SIDE-EFFECTS:                                                         19324000
                                                                        19326000
    The receive ready count will be incremented by the amount           19328000
    contained in the RECEIVE READY report.                              19330000
                                                                        19332000
                                                                        19334000
  SPECIAL CONSIDERATIONS:                                               19336000
                                                                        19338000
    When called, DB must be set to the base of the CIPER data           19340000
    segment.                                                            19342000
                                                                        19344000
                                                                        19346000
  CHANGE HISTORY:                                                       19348000
                                                                        19350000
    As issued.                                                          19352000
                                                                        19354000
;                                                                       19356000
$PAGE "PROCEDURE:  B08'RCV'RDY -- LOCAL DECLARATIONS"                   19358000
                                                                        19360000
begin                                                                   19362000
                                                                        19364000
  integer pointer                                                       19366000
                                                                        19368000
    input'record                                                        19370000
      << points to base of data area of input record >>                 19372000
                                                                        19374000
  ;                                                                     19376000
                                                                        19378000
$PAGE "PROCEDURE:  B08'RCV'RDY -- PROCEDURE BODY"                       19380000
  << Set up pointer to data area of record >>                           19382000
                                                                        19384000
  @input'record := i'r'control(start) + @i'r'control;                   19386000
                                                                        19388000
  << Update receive ready count >>                                      19390000
                                                                        19392000
  cb'info(receive'ready'count) := cb'info(receive'ready'count)          19394000
      + input'record(parm'byte'1);                                      19396000
                                                                        19398000
  << Release the input record >>                                        19400000
                                                                        19402000
  i'r'control(active) := free;                                          19404000
                                                                        19406000
  << All done!! >>                                                      19408000
                                                                        19410000
  b08'rcv'rdy := no'errors;                                             19412000
                                                                        19414000
end;  << of procedure b08'rcv'rdy >>                                    19416000
                                                                        19418000
$PAGE "PROCEDURE:  B08'ENV'STATUS"                                      19420000
integer procedure b08'env'status(cb'info, i'r'control);                 19422000
                                                                        19424000
  value                          cb'info, i'r'control ;                 19426000
                                                                        19428000
  integer pointer                cb'info, i'r'control ;                 19430000
                                                                        19432000
  option privileged, uncallable                       ;                 19434000
                                                                        19436000
                                                                        19438000
COMMENT                                                                 19440000
                                                                        19442000
  PURPOSE:                                                              19444000
                                                                        19446000
    This procedure will move the environmental status block             19448000
    from an input buffer to the appropriate status tank within          19450000
    the CIPER data segment.                                             19452000
                                                                        19454000
                                                                        19456000
  INPUT PARAMETERS:                                                     19458000
                                                                        19460000
    CB'INFO, a pointer to the control block information area            19462000
      of Level 7 for this ldev.  The pointer to the status              19464000
      tank is contained in the cbix.                                    19466000
                                                                        19468000
    I'R'CONTROL, which points to the input record containing            19470000
      the new environmental status block.                               19472000
                                                                        19474000
                                                                        19476000
  OUTPUT PARAMETERS:                                                    19478000
                                                                        19480000
    B08'ENV'STATUS, which is the completion status of the               19482000
      procedure call.  A value of one is returned if no errors          19484000
      occurred.  Other values will be defined as required.              19486000
                                                                        19488000
                                                                        19490000
  SIDE-EFFECTS:                                                         19492000
                                                                        19494000
    After moving the data from the input record to the status           19496000
    tank, the input record will be set free.  Also, the flag            19498000
    in the cbix that indicates new status is available will be          19500000
    set.                                                                19502000
                                                                        19504000
                                                                        19506000
  SPECIAL CONSIDERATIONS:                                               19508000
                                                                        19510000
    When called, DB must be set to the base of the CIPER data           19512000
    segment.                                                            19514000
                                                                        19516000
                                                                        19518000
  CHANGE HISTORY:                                                       19520000
                                                                        19522000
    As issued.                                                          19524000
                                                                        19526000
;                                                                       19528000
                                                                        19530000
$PAGE "PROCEDURE:  B08'ENV'STATUS -- LOCAL DECLARATIONS"                19532000
begin                                                                   19534000
                                                                        19536000
  byte pointer                                                          19538000
                                                                        19540000
    old'status                                                          19542000
      << points to status tank >>                                       19544000
                                                                        19546000
   ,new'status                                                          19548000
      << points to new status in input record buffer >>                 19550000
                                                                        19552000
  ;                                                                     19554000
                                                                        19556000
                                                                        19558000
$PAGE "PROCEDURE:  B08'ENV'STATUS -- PROCEDURE BODY"                    19560000
  << First, set up the pointer to old and new status >>                 19562000
                                                                        19564000
  @old'status := ( cb'info(env'status'base)                             19566000
                   + cb'info(cds'area'base) ) to'byte;                  19568000
  @new'status := ( @i'r'control to'byte )                               19570000
               + i'r'control(current'position);                         19572000
                                                                        19574000
                                                                        19576000
  << Now move the information to the status tank >>                     19578000
                                                                        19580000
  move old'status := new'status,                                        19582000
                     (cb'info(device'env'status'size));                 19584000
                                                                        19586000
                                                                        19588000
  << Set the input record free >>                                       19590000
                                                                        19592000
  i'r'control(active) := free;                                          19594000
                                                                        19596000
                                                                        19598000
  << Set the new status available flag in the cbix >>                   19600000
                                                                        19602000
  cb'info(status'received).env'stat'bit := 1;                           19604000
  cb'info(status'reported).env'stat'bit := 0;                           19606000
                                                                        19608000
  << All done !! >>                                                     19610000
                                                                        19612000
  b08'env'status := successful;                                         19614000
                                                                        19616000
end;  << of procedure b08'env'status >>                                 19618000
                                                                        19620000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS"                                  19622000
integer procedure b08'process'status(cb'info, i'r'control);             19624000
                                                                        19626000
  value                              cb'info, i'r'control ;             19628000
                                                                        19630000
  integer pointer                    cb'info, i'r'control ;             19632000
                                                                        19634000
  option privileged, uncallable                           ;             19636000
                                                                        19638000
                                                                        19640000
COMMENT                                                                 19642000
                                                                        19644000
  PURPOSE:                                                              19646000
                                                                        19648000
    This procedure determines if the current input record is            19650000
    any type of status, and if so, calls the appropriate status         19652000
    processing routine.  If the information is not status, it           19654000
    is ignored.                                                         19656000
                                                                        19658000
                                                                        19660000
  INPUT PARAMETERS:                                                     19662000
                                                                        19664000
    CB'INFO, which is a pointer to the control block informa-           19666000
      tion area.                                                        19668000
                                                                        19670000
    I'R'CONTROL, a pointer to the input record containing the           19672000
      data to be processed.                                             19674000
                                                                        19676000
                                                                        19678000
  OUTPUT PARAMETERS:                                                    19680000
                                                                        19682000
    B08'PROCESS'STATUS, which is a completion status for the            19684000
      call.  A value of one is returned if no errors occured.           19686000
      Other values will be defined as required.                         19688000
                                                                        19690000
                                                                        19692000
  SPECIAL CONSIDERATIONS:                                               19694000
                                                                        19696000
    None.                                                               19698000
                                                                        19700000
                                                                        19702000
  SPECIAL CONSIDERATIONS:                                               19704000
                                                                        19706000
    When called, DB must be set to the base of the CIPER data           19708000
    segment.                                                            19710000
                                                                        19712000
                                                                        19714000
  CHANGE HISTORY:                                                       19716000
                                                                        19718000
    As issued.                                                          19720000
                                                                        19722000
;                                                                       19724000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS -- LOCAL DECLARATIONS"            19726000
begin                                                                   19728000
  << Declaration of local variables >>                                  19730000
                                                                        19732000
  integer pointer                                                       19734000
                                                                        19736000
    input'record                                                        19738000
      << points to base of input buffer area >>                         19740000
                                                                        19742000
  ;                                                                     19744000
                                                                        19746000
  integer                                                               19748000
    record'opcode                                                       19750000
   ,error'parm                                                          19752000
  ;                                                                     19754000
                                                                        19756000
$PAGE "PROCEDURE:  B08'PROCESS'STATUS -- PROCEDURE BODY"                19758000
  << Initialize local variables >>                                      19760000
                                                                        19762000
  @input'record := i'r'control(start) + @i'r'control;                   19764000
                                                                        19766000
  << get the opcode from the record >>                                  19768000
                                                                        19770000
  record'opcode := input'record(header'opcode);                         19772000
  i'r'control(current'position) :=                                      19774000
      i'r'control(current'position)                                     19776000
      + input'record(header'length);                                    19778000
                                                                        19780000
  if record'opcode = lgl'receive'ready then                             19782000
    begin                                                               19784000
      error'parm := b08'rcv'rdy(cb'info,i'r'control);                   19786000
    end                                                                 19788000
  else if record'opcode = lgl'status'report then                        19790000
    begin                                                               19792000
      error'parm := b08'device'status(cb'info,i'r'control);             19794000
    end                                                                 19796000
  else if record'opcode = lgl'job'report then                           19798000
    begin                                                               19800000
      error'parm := b08'job'report(cb'info, i'r'control);               19802000
    end                                                                 19804000
  else if record'opcode = lgl'esb'report then                           19806000
    begin                                                               19808000
      error'parm := b08'env'status(cb'info,i'r'control);                19810000
    end                                                                 19812000
  else                                                                  19814000
    begin                                                               19816000
      i'r'control(active) := integer(free);                             19818000
      error'parm := no'errors;                                          19820000
    end;                                                                19822000
                                                                        19824000
  b08'process'status := error'parm;                                     19826000
  return;                                                               19828000
                                                                        19830000
end;  << b08'process'status >>                                          19832000
                                                                        19834000
$PAGE "PROCEDURE:  CPR'GET'RECORD"                                      19836000
integer procedure cpr'get'record(cb'info, i'r'control,                  19838000
                                 expected'record'type);                 19840000
                                                                        19842000
  value                          cb'info, i'r'control,                  19844000
                                 expected'record'type ;                 19846000
                                                                        19848000
  integer pointer                cb'info, i'r'control ;                 19850000
                                                                        19852000
  integer                        expected'record'type ;                 19854000
                                                                        19856000
  option privileged, uncallable                       ;                 19858000
                                                                        19860000
                                                                        19862000
COMMENT                                                                 19864000
                                                                        19866000
  PURPOSE:                                                              19868000
                                                                        19870000
    This procedure will call the network level to obtain a              19872000
    logical record from the device.  The caller specifies the           19874000
    type of record desired, and cpr'get'record will not return          19876000
    anything else.  If the caller specifies a data record of            19878000
    some type, and a status record is received, then this               19880000
    procedure will call cpr'process'status to evaluate the              19882000
    status information, and will then issue another request to          19884000
    the transport service to get another record.  This will             19886000
    continue until the caller's request is satisfied.                   19888000
                                                                        19890000
                                                                        19892000
  INPUT PARAMETERS:                                                     19894000
                                                                        19896000
    CB'INFO, which is a pointer to the Level 7 control block            19898000
      information area of the CIPER data segment.                       19900000
                                                                        19902000
    I'R'CONTROL, which is a pointer to the input record to be           19904000
      used for the input transfer.                                      19906000
                                                                        19908000
    EXPECTED'RECORD'TYPE, which indicates the type of record            19910000
      the caller desires.                                               19912000
                                                                        19914000
                                                                        19916000
  OUTPUT PARAMETERS:                                                    19918000
                                                                        19920000
    ERROR'RETURN, which is the completion status of the call.           19922000
      If no errors occurred, then zero will be returned.  Other         19924000
      values will be defined as required.                               19926000
                                                                        19928000
                                                                        19930000
  SIDE-EFFECTS:                                                         19932000
                                                                        19934000
    Cpr'get'record will modify the control information of the           19936000
    input record buffer area.  It will also update the contents         19938000
    of the input'sequence'count contained in the control block.         19940000
                                                                        19942000
                                                                        19944000
  SPECIAL CONSIDERATIONS:                                               19946000
                                                                        19948000
    When called, DB must be set to the CIPER data segment that          19950000
    contains the Level 7 control block for the desired device.          19952000
                                                                        19954000
                                                                        19956000
  CHANGE HISTORY:                                                       19958000
                                                                        19960000
    As issued.                                                          19962000
                                                                        19964000
;                                                                       19966000
                                                                        19968000
                                                                        19970000
begin                                                                   19972000
$PAGE "PROCEDURE:  CPR'GET'RECORD -- LOCAL VARIABLES"                   19974000
  << DECLARATION OF LOCAL VARIABLES >>                                  19976000
                                                                        19978000
                                                                        19980000
  integer pointer                                                       19982000
                                                                        19984000
    input'record                                                        19986000
      << pointer to base of input record buffer area >>                 19988000
                                                                        19990000
   ,control'table                                                       19992000
      << gets the address of our control table >>                       19994000
                                                                        19996000
  ;                                                                     19998000
                                                                        20000000
  double                                                                20002000
                                                                        20004000
    return'information                                                  20006000
      << Completion status from function calls >>                       20008000
                                                                        20010000
  ;                                                                     20012000
                                                                        20014000
  integer                                                               20016000
                                                                        20018000
    error'parm                    = return'information                  20020000
      << returns error information from other procedures >>             20022000
                                                                        20024000
   ,transfer'log                  = return'information + 1              20026000
      << Count on physical I/O >>                                       20028000
                                                                        20030000
  ;                                                                     20032000
                                                                        20034000
  logical                                                               20036000
                                                                        20038000
    got'expected                  := false                              20040000
      << flags reception of desired record type >>                      20042000
                                                                        20044000
  ;                                                                     20046000
$PAGE "PROCEDURE:  CPR'GET'RECORD -- PROCEDURE BODY"                    20048000
  << Set up local variables >>                                          20050000
                                                                        20052000
  @input'record := i'r'control(start) + @i'r'control;                   20054000
  @control'table := cb'info(ct'ptr);                                    20056000
                                                                        20058000
                                                                        20060000
  << Check to see if the input record buffer area is clean. >>          20062000
  << If it is not, there is an internal problem that must   >>          20064000
  << be flagged.                                            >>          20066000
                                                                        20068000
  if logical(i'r'control(active)) then                                  20070000
    begin                                                               20072000
      << The buffer area was already in use when this re- >>            20074000
      << quest came in.  Flag an error and return.        >>            20076000
                                                                        20078000
      cpr'get'record := record'active'error;                            20080000
      return;                                                           20082000
    end                                                                 20084000
  else                                                                  20086000
    begin                                                               20088000
      << Since we are going to use it, set the active flag. >>          20090000
      << Also initialize certain control variables. >>                  20092000
                                                                        20094000
      i'r'control(active) := integer(in'use);                           20096000
    end;                                                                20098000
                                                                        20100000
  << Now start requesting records until the type we want     >>         20102000
  << comes in.  If the record we get is not what we want but >>         20104000
  << is some sort of device status, we will process it and   >>         20106000
  << then ask for another record.                            >>         20108000
                                                                        20110000
  do                                                                    20112000
    begin                                                               20114000
                                                                        20116000
      i'r'control(current'position) :=                                  20118000
          i'r'control(start) to'byte;                                   20120000
                                                                        20122000
      return'information :=                                             20124000
          b08'network'protocol( control'table,                          20126000
                                transport'read,                         20128000
                                @input'record,                          20130000
                                i'r'control(maximum'size),              20132000
                                cb'info(ciper'dst),                     20134000
                                cb'info(logical'device)    );           20136000
                                                                        20138000
                                                                        20140000
      << Update the current record length with the value >>             20142000
      << returned by Level 4                             >>             20144000
                                                                        20146000
      i'r'control(current'length) := transfer'log;                      20148000
                                                                        20150000
      << check the error'parm >>                                        20152000
      if error'parm.general <> no'errors then                           20154000
        begin                                                           20156000
          << transport service could not deliver a good  >>             20158000
          << record, so report that to a higher level    >>             20160000
                                                                        20162000
          cpr'get'record := error'parm;                                 20164000
          return;                                                       20166000
        end                                                             20168000
      else                                                              20170000
        begin                                                           20172000
          << transport service gave us a complete record, >>            20174000
          << now we need to check its validity.           >>            20176000
                                                                        20178000
          if not logical( cb'info(dev'clr'in'progress) ) then           20180000
            begin                                                       20182000
              << Not doing a device clear, so check the seq- >>         20184000
              << uence number for validity.                  >>         20186000
                                                                        20188000
              if input'record(header'sequence'number)                   20190000
               = cb'info(input'sequence'count) then                     20192000
                begin                                                   20194000
                  << No error, update the counter >>                    20196000
                                                                        20198000
                  cb'info(input'sequence'count) :=                      20200000
                    (logical(cb'info(input'sequence'count)+1)           20202000
                    land 255);                                          20204000
                end                                                     20206000
              else                                                      20208000
                begin                                                   20210000
                  << There is an error.  If the device has   >>         20212000
                  << been reset and is sending status, ignor >>         20214000
                  << the error, as the status processor will >>         20216000
                  << take care of it.  Otherwise, do a       >>         20218000
                  << device clear to get back in synch.     >>          20220000
                                                                        20222000
                  if input'record(header'opcode) <>                     20224000
                     lgl'status'report                                  20226000
                  or (logical( input'record(parm'byte'2) )              20228000
                     land 1) <> 1 then                                  20230000
                    begin                                               20232000
                      b08'device'clear(cb'info, 1);                     20234000
                      cpr'get'record := record'sequence'error;          20236000
                      return;                                           20238000
                    end;                                                20240000
                end;                                                    20242000
            end;                                                        20244000
                                                                        20246000
                                                                        20248000
          << Check the creator bit to ensure that the device >>         20250000
          << sent this record.                               >>         20252000
                                                                        20254000
          if input'record(header'creator) <> device then                20256000
            begin                                                       20258000
              << It appears that a host record wound up in  >>          20260000
              << the input buffer, so something is definit- >>          20262000
              << ly screwed up here!                        >>          20264000
                                                                        20266000
              cpr'get'record := wrong'creator;                          20268000
              return;                                                   20270000
            end;                                                        20272000
        end;  << of transport gave us a complete record ... >>          20274000
                                                                        20276000
                                                                        20278000
                                                                        20280000
      << We now have a valid record in the buffer.  If it   >>          20282000
      << belongs to the caller, return.  If it is not the   >>          20284000
      << caller's, but is status, process it.  If neither,  >>          20286000
      << throw it away and try again.                       >>          20288000
                                                                        20290000
      if expected'record'type = dont'care then                          20292000
        begin                                                           20294000
          << Caller wanted to look at anything that came in, >>         20296000
          << so return this record.                          >>         20298000
                                                                        20300000
          got'expected := true;                                         20302000
        end                                                             20304000
      else                                                              20306000
        begin                                                           20308000
          << Caller desired a particular type of record.     >>         20310000
          << Extract the record header information to deter- >>         20312000
          << mine if we have a match or not.                 >>         20314000
                                                                        20316000
          if input'record(header'opcode)                                20318000
              = expected'record'type then                               20320000
            begin                                                       20322000
              << We got what the caller asked for.  Return  >>          20324000
              << the record as is.                          >>          20326000
                                                                        20328000
              i'r'control(current'position) :=                          20330000
                  i'r'control(current'position) +                       20332000
                  input'record(header'length);                          20334000
              got'expected := true;                                     20336000
            end                                                         20338000
          else                                                          20340000
            begin                                                       20342000
              << The record is not what the caller wanted.  >>          20344000
              << See if it is status.                       >>          20346000
                                                                        20348000
              error'parm := B08'process'status(cb'info,                 20350000
                                i'r'control);                           20352000
                                                                        20354000
              << check the error'parm >>                                20356000
              if error'parm <> no'errors then                           20358000
                begin                                                   20360000
                  << Could not process the status.  Return >>           20362000
                  << appropriate error code.               >>           20364000
                                                                        20366000
                  cpr'get'record := error'parm;                         20368000
                  return;                                               20370000
                end;                                                    20372000
            end;  << of if opcode = expected'record'type >>             20374000
          end;  << of expected'record'type = dont'care ... >>           20376000
    end                                                                 20378000
  until got'expected;                                                   20380000
                                                                        20382000
  cpr'get'record := error'parm;                                         20384000
                                                                        20386000
end;  << of cpr'get'record >>                                           20388000
                                                                        20390000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD"                                    20392000
integer procedure cpr'force'record(cb'info, o'r'control);               20394000
                                                                        20396000
  value                            cb'info, o'r'control ;               20398000
                                                                        20400000
  integer pointer                  cb'info, o'r'control ;               20402000
                                                                        20404000
  option privileged, uncallable                         ;               20406000
                                                                        20408000
                                                                        20410000
COMMENT                                                                 20412000
                                                                        20414000
  PURPOSE:                                                              20416000
                                                                        20418000
    Cpr'send'record provides a common interface for the logical         20420000
    driver to access the transport service by.  It maintains            20422000
    the information regarding the protocol between the logical          20424000
    driver and the logical device.  It always attempts to send          20426000
    the data contained in the output buffer area (that could            20428000
    change for the full blown implementation merely by passing          20430000
    a pointer to the desired record).                                   20432000
                                                                        20434000
                                                                        20436000
  INPUT PARAMETERS:                                                     20438000
                                                                        20440000
    CB'INFO, which is a pointer to the Level 7 control                  20442000
      block area of the CIPER data segment,                             20444000
                                                                        20446000
    O'R'CONTROL, which points to the output record to be sent.          20448000
                                                                        20450000
                                                                        20452000
  OUTPUT PARAMETERS:                                                    20454000
                                                                        20456000
    CPR'SEND'RECORD, which passes back the completion status of         20458000
      the call.  If no errors occurred, a value of zero will            20460000
      be returned.  Other values will be defined as required.           20462000
                                                                        20464000
                                                                        20466000
  SIDE-EFFECTS:                                                         20468000
                                                                        20470000
    CPR'SEND'RECORD will update certain information concerning          20472000
    the state of the Level 7 protocol.  This includes, but is           20474000
    not limited to, the RECEIVE READY count.  After a record            20476000
    is successfully sent, the output record buffer area will            20478000
    be cleaned up and initialized.                                      20480000
                                                                        20482000
                                                                        20484000
  SPECIAL CONSIDERATIONS:                                               20486000
                                                                        20488000
    When called, DB must be set to the CIPER data segment               20490000
    containing the Level 7 control block for the desired                20492000
    device.                                                             20494000
                                                                        20496000
                                                                        20498000
  CHANGE HISTORY:                                                       20500000
                                                                        20502000
    As issued.                                                          20504000
                                                                        20506000
;                                                                       20508000
                                                                        20510000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD -- LOCAL VARIABLES"                 20512000
begin                                                                   20514000
  << DECLARATION OF LOCAL VARIABLES >>                                  20516000
                                                                        20518000
  integer pointer                                                       20520000
                                                                        20522000
    i'r'control                                                         20524000
      << pointer to input record control information >>                 20526000
      << only used if we need to get a Receive Ready before >>          20528000
      << we can send the data.                              >>          20530000
                                                                        20532000
   ,output'record                                                       20534000
      << pointer to output record buffer area >>                        20536000
                                                                        20538000
   ,control'table                                                       20540000
      << gets the address of the base of our control table >>           20542000
                                                                        20544000
  ;                                                                     20546000
                                                                        20548000
  double                                                                20550000
                                                                        20552000
    return'information                                                  20554000
      << Used for function value returns >>                             20556000
  ;                                                                     20558000
                                                                        20560000
  integer                                                               20562000
                                                                        20564000
    error'parm                    = return'information                  20566000
      << used to obtain error info from procedures called >>            20568000
                                                                        20570000
   ,transfer'log                  = return'information + 1              20572000
      << Transfer log of physical I/O >>                                20574000
                                                                        20576000
  ;                                                                     20578000
                                                                        20580000
  entry                                                                 20582000
                                                                        20584000
    cpr'send'record                                                     20586000
      << alternate entry point for normal protocol >>                   20588000
                                                                        20590000
  ;                                                                     20592000
                                                                        20594000
                                                                        20596000
$PAGE "PROCEDURE:  CPR'FORCE'RECORD -- PROCEDURE BODY"                  20598000
  << If I/O is to be forced (can only be done for DEVICE    >>          20600000
  << CLEAR) then set RECEIVE READY count to one, so it will  >>         20602000
  << go to zero after this record is sent                    >>         20604000
                                                                        20606000
      cb'info(receive'ready'count) := 1;                                20608000
                                                                        20610000
cpr'send'record:                                                        20612000
                                                                        20614000
  << INITIALIZE LOCAL VARIABLES >>                                      20616000
                                                                        20618000
  @output'record := o'r'control(start) + @o'r'control;                  20620000
  @control'table := cb'info(ct'ptr);                                    20622000
                                                                        20624000
  << Make sure there is an active record to send.  If there >>          20626000
  << isn't, an internal error has occurred.                 >>          20628000
                                                                        20630000
  if not logical(o'r'control(active)) then                              20632000
    begin                                                               20634000
      << No active record. Call cpr'internal'error. >>                  20636000
                                                                        20638000
      cpr'force'record := record'active'error;                          20640000
      return;                                                           20642000
    end;                                                                20644000
                                                                        20646000
                                                                        20648000
  << now see if we can send the record to the device >>                 20650000
                                                                        20652000
  if cb'info(receive'ready'count) <= 0 then                             20654000
    begin                                                               20656000
      << no buffers available in the device.  Wait for a >>             20658000
      << RECEIVE READY to come in.                       >>             20660000
                                                                        20662000
      << Get an input record buffer >>                                  20664000
                                                                        20666000
      @i'r'control := cb'info(i'r'base)                                 20668000
                    + cb'info(cds'area'base);                           20670000
      if logical( i'r'control(active) ) then                            20672000
        begin                                                           20674000
          @i'r'control := b08'get'buffer( cb'info,                      20676000
                                      input'overwrite );                20678000
        end;                                                            20680000
                                                                        20682000
                                                                        20684000
      << Get a record from the transport service >>                     20686000
                                                                        20688000
      error'parm := cpr'get'record(cb'info,i'r'control,                 20690000
                                   lgl'receive'ready);                  20692000
                                                                        20694000
      << check the error'parm >>                                        20696000
      if error'parm <> no'errors then                                   20698000
        begin                                                           20700000
                                                                        20702000
                                                                        20704000
          << Free the record buffer area >>                             20706000
                                                                        20708000
          o'r'control(active) := integer(free);                         20710000
                                                                        20712000
                                                                        20714000
          b08'release'buffer(cb'info, i'r'control);                     20716000
          cpr'force'record := error'parm;                               20718000
          return;                                                       20720000
        end;                                                            20722000
                                                                        20724000
      << if no errors occurred, process the RECEIVE READY >>            20726000
      << report.                                          >>            20728000
      error'parm := b08'rcv'rdy(cb'info,i'r'control);                   20730000
      b08'release'buffer(cb'info, i'r'control);                         20732000
                                                                        20734000
      << check error'parm >>                                            20736000
      if error'parm <> no'errors then                                   20738000
        begin                                                           20740000
                                                                        20742000
                                                                        20744000
          << Free the record buffer area >>                             20746000
                                                                        20748000
          o'r'control(active) := integer(free);                         20750000
                                                                        20752000
                                                                        20754000
          cpr'force'record := error'parm;                               20756000
          return;                                                       20758000
        end;                                                            20760000
    end;  << of while receive'ready'count <= 0 ... >>                   20762000
                                                                        20764000
  << now that the device has buffers available, send the >>             20766000
  << output record.                                      >>             20768000
                                                                        20770000
  << Plug in the current value of the output sequence count >>          20772000
                                                                        20774000
  output'record(header'sequence'number) :=                              20776000
      cb'info(output'sequence'count);                                   20778000
                                                                        20780000
  return'information := b08'network'protocol(control'table,             20782000
      transport'write,@output'record,                                   20784000
      o'r'control(current'length),cb'info(ciper'dst),                   20786000
      cb'info(logical'device)  );                                       20788000
                                                                        20790000
  << check the error'parm >>                                            20792000
  if error'parm = no'errors then                                        20794000
    begin                                                               20796000
      << Record was sent successfully, so decrement the >>              20798000
      << receive ready count and mark the record buffer >>              20800000
      << as available.  Also increment the record se-   >>              20802000
      << quence number for the next record.             >>              20804000
                                                                        20806000
      cb'info(receive'ready'count) :=                                   20808000
          cb'info(receive'ready'count) - 1;                             20810000
                                                                        20812000
      cb'info(output'sequence'count) :=                                 20814000
          ( logical( cb'info(output'sequence'count) + 1 )               20816000
            land 255 );                                                 20818000
                                                                        20820000
    end;                                                                20822000
                                                                        20824000
                                                                        20826000
  << Free the record buffer area >>                                     20828000
                                                                        20830000
  o'r'control(active) := integer(free);                                 20832000
                                                                        20834000
                                                                        20836000
  << Set up the error return information >>                             20838000
                                                                        20840000
  cpr'force'record := error'parm;                                       20842000
                                                                        20844000
end;  << cpr'force'record >>                                            20846000
                                                                        20848000
$PAGE "PROCEDURE:  B08'BUILD'HEADER"                                    20850000
procedure b08'build'header( o'r'control, opcode,                        20852000
                            data'type,                         <<04422>>20854000
                            block'start, block'end);           <<04422>>20856000
                                                                        20858000
  value                     o'r'control, opcode,                        20860000
                            data'type,                         <<04422>>20862000
                            block'start, block'end ;           <<04422>>20864000
  integer pointer           o'r'control           ;                     20866000
                                                                        20868000
  integer                                opcode,                        20870000
                            data'type,                         <<04422>>20872000
                            block'start, block'end ;           <<04422>>20874000
                                                               <<04422>>20876000
  option privileged, uncallable, variable          ;           <<04422>>20878000
                                                                        20880000
                                                                        20882000
                                                                        20884000
COMMENT                                                                 20886000
                                                                        20888000
  PURPOSE:                                                              20890000
                                                                        20892000
    This procedure will build the record header for all types           20894000
    of records.  Currently, we are using a four byte header:            20896000
                                                                        20898000
        byte 0 ==> header length                                        20900000
        byte 1 ==> record sequence number                               20902000
        byte 2 ==> record opcode                                        20904000
        byte 3 ==> host/peripheral flag, start of block flag,           20906000
                   end of block flag, and data type code.               20908000
                                                                        20910000
    In addition, for debugging purposes, the entire record              20912000
    buffer area will be zeroed out so new data will be easier           20914000
    to see as it gets filled in.                                        20916000
                                                                        20918000
                                                                        20920000
  INPUT PARAMETERS:                                                     20922000
                                                                        20924000
    O'R'CONTROL, which points to the control portion of the             20926000
      record buffer area currently in use.  The control portion         20928000
      maintains the maximum size of the output record, its              20930000
      current size, next available byte location, and other             20932000
      information.                                                      20934000
                                                                        20936000
    OPCODE, which is the record opcode to be inserted into the          20938000
      record header.                                                    20940000
                                                                        20942000
    DATA'TYPE, which is the associated data type of the record.         20944000
      Many of the record types do not use this field, so a              20946000
      zero is passed in in its place.                                   20948000
                                                               <<04422>>20950000
    BLOCK'START, which is an optional parameter that, if pre-  <<04422>>20952000
      sent, indicates the value that the start of block flag   <<04422>>20954000
      will take on.  If not present, the start of block bit in <<04422>>20956000
      the header is cleared.                                   <<04422>>20958000
                                                               <<04422>>20960000
    BLOCK'END, which is an optional parameter that, if present,<<04422>>20962000
      indicates the value that the end of block bit in the re- <<04422>>20964000
      cord header will take on.  If not present, the end of    <<04422>>20966000
      block bit is cleared.                                    <<04422>>20968000
                                                                        20970000
                                                                        20972000
  OUTPUT PARAMETERS:                                                    20974000
                                                                        20976000
    None.                                                               20978000
                                                                        20980000
                                                                        20982000
  SIDE-EFFECTS:                                                         20984000
                                                                        20986000
    The entire record buffer data area will be set to zero.             20988000
    The current length will be set to three, and the current            20990000
    position (next available byte) will be set past the head-           20992000
    er.                                                                 20994000
                                                                        20996000
                                                                        20998000
  SPECIAL CONSIDERATIONS:                                               21000000
                                                                        21002000
    None.                                                               21004000
                                                                        21006000
                                                                        21008000
  CHANGE HISTORY:                                                       21010000
                                                                        21012000
    As issued.                                                          21014000
                                                                        21016000
;                                                                       21018000
$PAGE "PROCEDURE:  B08'BUILD'HEADER -- LOCAL VARIABLES"                 21020000
begin                                                                   21022000
                                                                        21024000
  integer pointer                                                       21026000
                                                                        21028000
    o'r'data                                                            21030000
      << points to data portion of the output record >>                 21032000
                                                                        21034000
  ;                                                                     21036000
                                                               <<04422>>21038000
                                                               <<04422>>21040000
  define                                                       <<04422>>21042000
                                                               <<04422>>21044000
    block'start'flag              = (14: 1) #                  <<04422>>21046000
                                                               <<04422>>21048000
   ,block'end'flag                = (15: 1) #                  <<04422>>21050000
                                                               <<04422>>21052000
   ,data'type'                    = (13: 1) #                  <<04422>>21054000
                                                               <<04422>>21056000
  ;                                                            <<04422>>21058000
$PAGE "PROCEDURE:  B08'BUILD'HEADER -- PROCEDURE BODY"                  21060000
                                                                        21062000
  << First, initialize the pointer to the data area >>                  21064000
                                                                        21066000
  @o'r'data := o'r'control(start) + @o'r'control;                       21068000
                                                                        21070000
                                                                        21072000
  << Mark the record buffer active and initialize the >>                21074000
  << length and current position indicators           >>                21076000
                                                                        21078000
  o'r'control(active) := in'use;                                        21080000
  o'r'control(current'length) := rec'head'length;                       21082000
  o'r'control(current'position) :=                                      21084000
      ( o'r'control(start) to'byte ) + rec'head'length;                 21086000
                                                                        21088000
$IF X9 = ON  << ON = INCLUDE DEBUGGING CODE >>                          21090000
                                                                        21092000
  << Clear out the record buffer data area.  This will >>               21094000
  << make it easier to determine where new data is going. >>            21096000
                                                                        21098000
  o'r'data := 0;                                                        21100000
  move o'r'data(1) := o'r'data(0),(o'r'control(maximum'size)/2-1);      21102000
                                                                        21104000
$IF                                                                     21106000
                                                                        21108000
                                                                        21110000
  << Fill in the record header information, including the  >>           21112000
  << opcode passed in.                                     >>           21114000
                                                                        21116000
  o'r'data(header'length) := rec'head'length;                           21118000
  o'r'data(header'creator) := host;                                     21120000
  o'r'data(header'opcode) := opcode;                                    21122000
                                                               <<04422>>21124000
  o'r'data(type'of'data) := if parm'mask.data'type'            <<04422>>21126000
                               then data'type                  <<04422>>21128000
                               else no'data'type'used;         <<04422>>21130000
                                                                        21132000
                                                                        21134000
  << Set up the start of block and end of block as required >> <<04422>>21136000
                                                                        21138000
  o'r'data(sob'flag) := if parm'mask.block'start'flag          <<04422>>21140000
                          then block'start                     <<04422>>21142000
                          else clear'bit;                      <<04422>>21144000
                                                               <<04422>>21146000
  o'r'data(eob'flag) := if parm'mask.block'end'flag            <<04422>>21148000
                          then block'end                       <<04422>>21150000
                          else clear'bit;                      <<04422>>21152000
                                                                        21154000
                                                                        21156000
  << All finished >>                                                    21158000
                                                                        21160000
end;  << of procedure b08'build'header >>                               21162000
                                                                        21164000
$PAGE "  PROCEDURE:  B08'READ'DATA"                                     21166000
double procedure b08'read'data( cb'info, dst'num, address,              21168000
                                count, parm1, parm2, flags);            21170000
                                                                        21172000
  value                         cb'info, dst'num, address,              21174000
                                count, parm1, parm2, flags ;            21176000
                                                                        21178000
  integer pointer               cb'info                    ;            21180000
                                                                        21182000
  integer                                dst'num, address,              21184000
                                count, parm1, parm2, flags ;            21186000
                                                                        21188000
  option privileged, uncallable                            ;            21190000
                                                                        21192000
                                                                        21194000
COMMENT                                                                 21196000
                                                                        21198000
    This procedure has not been implemented for the 2608S               21200000
    line printer.  The function of 'read data' is not fully             21202000
    defined as yet by the CIPER task force.  This procedure             21204000
    stub has been used merely as a place holder for a future            21206000
    full implementation.                                                21208000
                                                                        21210000
;                                                                       21212000
                                                                        21214000
                                                                        21216000
                                                                        21218000
begin                                                                   21220000
                                                                        21222000
  double                                                                21224000
                                                                        21226000
    return'information             = b08'read'data                      21228000
                                                                        21230000
  ;                                                                     21232000
                                                                        21234000
                                                                        21236000
  integer                                                               21238000
                                                                        21240000
    return'status                  = b08'read'data                      21242000
                                                                        21244000
   ,transfer'log                   = b08'read'data + 1                  21246000
                                                                        21248000
  ;                                                                     21250000
                                                                        21252000
                                                                        21254000
  return'status := invalid'function;                                    21256000
                                                                        21258000
end;  << of procedure b08'read'data >>                                  21260000
                                                                        21262000
$PAGE "PROCEDURE:  B08'WRITE'DATA"                                      21264000
double  procedure b08'write'data(cb'info, dst'num, address,             21266000
                                 function, count, parm1, parm2,         21268000
                                 flags, output'data'type,               21270000
                                 expanded'features'flag,                21272000
                                 translate'flag              );         21274000
                                                                        21276000
  value                          cb'info, dst'num, address,             21278000
                                 function, count, parm1, parm2,         21280000
                                 flags, output'data'type,               21282000
                                 expanded'features'flag ,               21284000
                                 translate'flag               ;         21286000
                                                                        21288000
  integer pointer                cb'info                      ;         21290000
                                                                        21292000
  integer                                 dst'num, address,             21294000
                                 function, count, parm1, parm2,         21296000
                                 flags, output'data'type      ;         21298000
                                                                        21300000
  logical                        expanded'features'flag,                21302000
                                 translate'flag               ;         21304000
                                                                        21306000
  option privileged, uncallable                               ;         21308000
                                                                        21310000
                                                                        21312000
                                                                        21314000
COMMENT                                                                 21316000
                                                                        21318000
  PURPOSE:                                                              21320000
                                                                        21322000
    This procedure will cause the conversion of parm1 and parm2         21324000
    parameters into device escape sequences.  These commands            21326000
    are then merged with any data the caller has provided.              21328000
    This information is placed in the output record buffer, and         21330000
    when that buffer is full it will be sent to the device.             21332000
                                                                        21334000
                                                                        21336000
  INPUT PARAMETERS:                                                     21338000
                                                                        21340000
                                                                        21342000
    CB'INFO, which is a pointer to the Level 7 control block            21344000
      information area of the CIPER data segment.                       21346000
                                                                        21348000
    DST'NUM, which is the data segment number of the source             21350000
      of the caller's data, if it is not located in a system            21352000
      buffer.                                                           21354000
                                                                        21356000
    ADDRESS, which is either an offset into the source data             21358000
      segment, or a system buffer index, depending on the sys-          21360000
      tem buffer bit in the flags parameter.                            21362000
                                                                        21364000
    COUNT, which is the length of the caller's data, if any.            21366000
      If count is positive, it specifies a word count, if neg-          21368000
      ative, it specifies a byte count.                                 21370000
                                                                        21372000
    PARM1, which is a request dependent (for example, with              21374000
      'write' requests, it specifies the carriage control).             21376000
                                                                        21378000
    PARM2, which is a second request dependent parameter.               21380000
                                                                        21382000
    FLAGS, which contain control and specification fields.              21384000
                                                                        21386000
    OUTPUT'DATA'TYPE, which specifies the type of data record           21388000
      to build and/or append to with the data generated by the          21390000
      call.                                                             21392000
                                                                        21394000
    EXPANDED'FEATURES'FLAG, which specifies the access mode             21396000
      of the user.  If true, the caller can access the features         21398000
      of the device via commands imbedded in the data.  If              21400000
      false, any commands imbedded in the caller's data will be         21402000
      ignored by the device.                                            21404000
                                                                        21406000
    TRANSLATE'FLAG, which control whether or not the function           21408000
      code translator will be called.                                   21410000
                                                                        21412000
                                                                        21414000
  OUTPUT PARAMETERS:                                                    21416000
                                                                        21418000
    B08'WRITE'DATA, which is a double word function return.             21420000
      The most significant word is the completion status of the         21422000
      call.  The least significant word is the transfer log of          21424000
      data moved from the caller to the record buffer.                  21426000
                                                                        21428000
                                                                        21430000
  SIDE-EFFECTS:                                                         21432000
                                                                        21434000
    B08'write'data modifies the output record buffer directly           21436000
      as it moves information into the buffer.  In addition,            21438000
      if a record is sent to the device, then other status in-          21440000
      formation may be altered, as status reports, etc. come            21442000
      in from the device.                                               21444000
                                                                        21446000
                                                                        21448000
  SPECIAL CONSIDERATIONS:                                               21450000
                                                                        21452000
    When called, DB must be pointing to the CIPER data segment.         21454000
                                                                        21456000
                                                                        21458000
  CHANGE HISTORY:                                                       21460000
                                                                        21462000
    As issued.                                                          21464000
                                                                        21466000
                                                                        21468000
;                                                                       21470000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- LOCAL VARIABLES"                   21472000
begin                                                                   21474000
                                                                        21476000
  << DECLARATION OF LOCAL VARIABLES >>                                  21478000
                                                                        21480000
  integer pointer                                                       21482000
                                                                        21484000
    o'r'control                                                         21486000
      << points to output record control information >>                 21488000
                                                                        21490000
   ,output'record                                                       21492000
      << base of output record buffer area >>                           21494000
                                                                        21496000
   ,next'word                                                           21498000
      << address of next word of buffer to move data into >>            21500000
  ;                                                                     21502000
  byte pointer                                                          21504000
    output'position                                                     21506000
      << current position in output record >>                           21508000
   ,seq'1'buff                                                          21510000
      << byte array for leading escape sequence(s) >>                   21512000
   ,seq'2'buff                                                          21514000
      << byte array for trailing escape sequence(s) >>                  21516000
  ;                                                                     21518000
                                                                        21520000
                                                                        21522000
  << Function return subparameters: >>                                  21524000
                                                                        21526000
  integer                                                               21528000
                                                                        21530000
    return'status                 = b08'write'data                      21532000
      << Completion status of procedure execution >>                    21534000
                                                                        21536000
   ,transfer'log                  = b08'write'data + 1                  21538000
      << Final count of data moved from caller's buffer >>              21540000
                                                                        21542000
  ;                                                                     21544000
                                                                        21546000
                                                                        21548000
                                                                        21550000
  double                                                                21552000
                                                                        21554000
    return'information                                                  21556000
      << Used for return variable from procedure calls. >>              21558000
  ;                                                                     21560000
                                                                        21562000
  integer                                                               21564000
                                                                        21566000
    error'parm                    = return'information                  21568000
      << Contains error return information from procedure >>            21570000
      << calls.                                           >>            21572000
                                                                        21574000
   ,sequence'counts               = return'information + 1              21576000
      << Contains the byte counts of the leading escape se-  >>         21578000
      << quence (upper byte) and trailing escape sequence    >>         21580000
      << (lower byte) returned from cpr'xlate.               >>         21582000
                                                                        21584000
  ;                                                                     21586000
                                                                        21588000
  define                                                                21590000
                                                                        21592000
    upper'byte                    = ( 0: 8) #                           21594000
   ,lower'byte                    = ( 8: 8) #                           21596000
  ;                                                                     21598000
                                                                        21600000
  integer                                                               21602000
                                                                        21604000
    seq'1'count                                                         21606000
      << byte count of leading escape sequence(s) >>                    21608000
                                                                        21610000
   ,seq'2'count                                                         21612000
      << byte count of trailing escape sequence(s) >>                   21614000
                                                                        21616000
   ,move'count                                                          21618000
      << word count for move from user's data segment >>                21620000
                                                                        21622000
   ,byte'count                                                          21624000
      << user's count converted to number of bytes >>                   21626000
                                                                        21628000
   ,what'fits                                                           21630000
      << amount of space left in record >>                              21632000
                                                                        21634000
   ,offset                                                              21636000
      << number of bytes to compact out, if any, after data >>          21638000
      << has been moved out of the caller's data segment.   >>          21640000
                                                                        21642000
   ,total'moved                                                         21644000
      << tally of all bytes moved into record buffer >>                 21646000
                                                                        21648000
  ;                                                                     21650000
                                                                        21652000
                                                                        21654000
  logical                                                               21656000
                                                                        21658000
    cctl                                                                21660000
      << flag that user specified first column carriage con- >>         21662000
      << trol (carriage control is first byte of data).      >>         21664000
                                                                        21666000
   ,address'odd                                                         21668000
      << used to flag that record buffer address is on an >>            21670000
      << odd byte boundary -- important for mfds and mtds >>            21672000
      << instructions                                     >>            21674000
                                                                        21676000
  ;                                                                     21678000
                                                                        21680000
                                                                        21682000
  declare'move'from'data'segment;                                       21684000
                                                                        21686000
$PAGE "PROCEDURE:  B08'WRITE'DATA --  SUBROUTINE:  BUILD'DATA'RECORD"   21688000
integer subroutine build'data'record(requested'data'type);              21690000
                                                                        21692000
  value                              requested'data'type ;              21694000
                                                                        21696000
  integer                            requested'data'type ;              21698000
                                                                        21700000
begin                                                                   21702000
                                                                        21704000
COMMENT                                                                 21706000
                                                                        21708000
  PURPOSE:                                                              21710000
                                                                        21712000
    This subroutine will initialize the output record area              21714000
    and build a record header for a data record.  In addition,          21716000
    the data type parameter will be set to the type passed in           21718000
    by the caller.                                                      21720000
                                                                        21722000
                                                                        21724000
  INPUT PARAMETERS:                                                     21726000
                                                                        21728000
    REQUESTED'DATA'TYPE, which is a code for the type of data.          21730000
      This value will be plugged in as the first parameter              21732000
      byte of the data record.                                          21734000
                                                                        21736000
                                                                        21738000
  OUTPUT PARAMETERS:                                                    21740000
                                                                        21742000
    ERROR'RETURN, which returns the results of this call to             21744000
      build'data'record.  A value of zero indicates no                  21746000
      errors.  Other values will be defined as required.                21748000
                                                                        21750000
                                                                        21752000
  SIDE-EFFECTS:                                                         21754000
                                                                        21756000
    Build'data'record initializes all associated output record          21758000
    parameters as it sets up a new record.                              21760000
                                                                        21762000
                                                                        21764000
  SPECIAL CONSIDERATIONS:                                               21766000
                                                                        21768000
    None.                                                               21770000
                                                                        21772000
  CHANGE HISTORY:                                                       21774000
                                                                        21776000
    As issued.                                                          21778000
                                                                        21780000
;                                                                       21782000
                                                                        21784000
$PAGE                                                                   21786000
  << BODY OF SUBROUTINE >>                                              21788000
                                                                        21790000
  << First check to make sure the output record is not >>               21792000
  << active.  If it is, then the previous record was   >>               21794000
  << not successfully sent, and this subroutine should >>               21796000
  << not try to initialize the area.                   >>               21798000
                                                                        21800000
  if logical(o'r'control(active)) then                                  21802000
    begin                                                               21804000
      << previous record not sent, return with error >>                 21806000
                                                                        21808000
      build'data'record := record'active'error;                         21810000
      return;                                                           21812000
                                                                        21814000
    end;                                                                21816000
                                                                        21818000
  << If the record area is inactive, then build the record >>           21820000
  << header.                                               >>           21822000
                                                                        21824000
  b08'build'header( o'r'control,                                        21826000
                    lgl'write,                                          21828000
                    requested'data'type );                              21830000
                                                                        21832000
                                                                        21834000
  @output'position := o'r'control(current'position)                     21836000
                    + (@o'r'control to'byte);                           21838000
                                                                        21840000
                                                                        21842000
  << All done, so set return code and exit >>                           21844000
                                                                        21846000
  build'data'record := no'errors;                                       21848000
                                                                        21850000
end; << of subroutine build'data'record >>                              21852000
                                                                        21854000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- SUBROUTINE:  SEND'THEN'BUILD"      21856000
integer subroutine send'then'build(requested'data'type);                21858000
                                                                        21860000
  value                            requested'data'type ;                21862000
                                                                        21864000
  integer                          requested'data'type ;                21866000
                                                                        21868000
                                                                        21870000
COMMENT                                                                 21872000
                                                                        21874000
  PURPOSE:                                                              21876000
                                                                        21878000
    This subroutine will call cpr'send'record to flush out a            21880000
    full record buffer, and then build a new record of the              21882000
    same data type as the previous record.  If any errors               21884000
    occur, the error'parm is returned to the caller for eval-           21886000
    uation.                                                             21888000
                                                                        21890000
                                                                        21892000
  INPUT PARAMETERS:                                                     21894000
                                                                        21896000
    REQUESTED'DATA'TYPE, which is the data type of the new              21898000
      record.                                                           21900000
                                                                        21902000
                                                                        21904000
  OUTPUT PARAMETERS:                                                    21906000
                                                                        21908000
    ERROR'RETURN, which is a status return variable.  A value           21910000
      of zero indicates no errors.  Other values will be defined        21912000
      as required.                                                      21914000
                                                                        21916000
                                                                        21918000
  SIDE-EFFECTS:                                                         21920000
                                                                        21922000
    Causes transmission of output record data, with attendent           21924000
    updating of certain device status information.                      21926000
                                                                        21928000
                                                                        21930000
  SPECIAL CONSIDERATIONS:                                               21932000
                                                                        21934000
    None.                                                               21936000
                                                                        21938000
  CHANGE HISTORY:                                                       21940000
                                                                        21942000
    As issued.                                                          21944000
                                                                        21946000
                                                                        21948000
  ;                                                                     21950000
                                                                        21952000
$PAGE                                                                   21954000
begin  << subroutine send'then'build >>                                 21956000
                                                                        21958000
  x := cpr'send'record(cb'info,o'r'control);                            21960000
                                                                        21962000
  << check the error return >>                                          21964000
  if x = no'errors then                                                 21966000
    begin                                                               21968000
      << if no errors, try to build a new record >>                     21970000
                                                                        21972000
      send'then'build := build'data'record(requested'data'type);        21974000
    end                                                                 21976000
  else                                                                  21978000
    begin                                                               21980000
      << There was an error.  Store the value in x back >>              21982000
      << into the return variable.                        >>            21984000
                                                                        21986000
      send'then'build := x;                                             21988000
    end;                                                                21990000
end;  << of subroutine send'then'build >>                               21992000
                                                                        21994000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- SUBROUTINE:  MOVE'INTERNAL'DATA"   21996000
integer subroutine move'internal'data(data'address,data'count);         21998000
                                                                        22000000
  value                               data'address,data'count ;         22002000
                                                                        22004000
  byte pointer                        data'address            ;         22006000
                                                                        22008000
  integer                                          data'count ;         22010000
                                                                        22012000
COMMENT                                                                 22014000
                                                                        22016000
  PURPOSE:                                                              22018000
                                                                        22020000
    This subroutine will move internal data (i.e. xlator                22022000
    generated escape sequences) into the output record buffer           22024000
    area.  If the size of that data causes the record to be-            22026000
    come full, send'then'build will be called to transfer the           22028000
    record to the device and construct a new record.                    22030000
                                                                        22032000
                                                                        22034000
  INPUT PARAMETERS:                                                     22036000
                                                                        22038000
    DATA'ADDRESS, which is a byte pointer to the starting               22040000
      position of the data to be moved into the output record.          22042000
                                                                        22044000
    DATA'COUNT, which is the byte count of the data to be               22046000
      moved.                                                            22048000
                                                                        22050000
                                                                        22052000
  OUTPUT PARAMETERS:                                                    22054000
                                                                        22056000
    None.                                                               22058000
                                                                        22060000
                                                                        22062000
  SIDE-EFFECTS:                                                         22064000
                                                                        22066000
    This subroutine will always modify the record control               22068000
    variables current'position, current'length, and the record          22070000
    pointer output'position.  In addition, since it is possible         22072000
    that a record may become full and have to be sent to the            22074000
    device, other information concerning the state of the de-           22076000
    vice and the communication protocol may be altered.                 22078000
                                                                        22080000
                                                                        22082000
  SPECIAL CONSIDERATIONS:                                               22084000
                                                                        22086000
    None.                                                               22088000
                                                                        22090000
                                                                        22092000
  CHANGE HISTORY:                                                       22094000
                                                                        22096000
    As issued.                                                          22098000
                                                                        22100000
                                                                        22102000
;                                                                       22104000
                                                                        22106000
$PAGE                                                                   22108000
begin  << subroutine move'internal'data >>                              22110000
                                                                        22112000
  while data'count > 0 do                                               22114000
    begin                                                               22116000
      << There is some data to be moved.  First determine >>            22118000
      << how much (if any) will fit into the currently    >>            22120000
      << active record.                                   >>            22122000
                                                                        22124000
      if o'r'control(current'length) + data'count >                     22126000
          o'r'control(maximum'size) then                                22128000
        begin                                                           22130000
          << only part of the data will fit.  Calculate how >>          22132000
          << much we can move this pass.                    >>          22134000
                                                                        22136000
          what'fits := o'r'control(maximum'size) -                      22138000
              o'r'control(current'length);                              22140000
        end                                                             22142000
      else                                                              22144000
        begin                                                           22146000
          << the entire thing will fit, so set up to move it >>         22148000
          << all this time                                   >>         22150000
                                                                        22152000
          what'fits := data'count;                                      22154000
        end;                                                            22156000
                                                                        22158000
      << now reduce data'count by what we are going to move >>          22160000
      data'count := data'count - what'fits;                             22162000
                                                                        22164000
      << move the data into the record >>                               22166000
      move output'position := data'address,(what'fits);                 22168000
      @data'address := @data'address + what'fits;                       22170000
      @output'position := @output'position + what'fits;                 22172000
                                                                        22174000
      << update the record control information >>                       22176000
      o'r'control(current'position) := @output'position                 22178000
                                     - @o'r'control to'byte;            22180000
      o'r'control(current'length) := o'r'control                        22182000
          (current'length) + what'fits;                                 22184000
                                                                        22186000
      << now see if the record should be sent or not >>                 22188000
      if o'r'control(current'length) = o'r'control                      22190000
          (maximum'size) then                                           22192000
        begin                                                           22194000
          << time to send the record to the device >>                   22196000
                                                                        22198000
          x := send'then'build(output'data'type);                       22200000
                                                                        22202000
          << check the error'parm >>                                    22204000
          if x <> no'errors then                                        22206000
            begin                                                       22208000
              move'internal'data := x;                                  22210000
              return;                                                   22212000
            end;                                                        22214000
        end;  << of current'length = maximum'size ... >>                22216000
                                                                        22218000
    end;  << of while data'count > 0 ... >>                             22220000
                                                                        22222000
    move'internal'data := no'errors;                                    22224000
                                                                        22226000
end;  << of subroutine move'internal'data  >>                           22228000
                                                                        22230000
$PAGE "PROCEDURE:  B08'WRITE'DATA -- PROCEDURE BODY"                    22232000
  << First, initialize the local variables used >>                      22234000
                                                                        22236000
  total'moved := 0;                                                     22238000
                                                                        22240000
  @o'r'control := cb'info(o'r'base) + cb'info(cds'area'base);           22242000
  @output'record := o'r'control(start) + @o'r'control;                  22244000
  @output'position := o'r'control(current'position)                     22246000
                    + @o'r'control to'byte;                             22248000
  @seq'1'buff := cb'info(sequence'1'buffer)                             22250000
               + cb'info(cds'area'base) to'byte;                        22252000
  @seq'2'buff := @seq'1'buff + xlator'buff'size;                        22254000
                                                                        22256000
  << Next, determine if there is a record already under >>              22258000
  << construction, and if so, is it of the proper data >>               22260000
                                                                        22262000
  if logical(o'r'control(active)) then                                  22264000
    begin                                                               22266000
      << there is a record in the process of assembly. >>               22268000
      << check to see if it is of the same data type as >>              22270000
      << this request.                                 >>               22272000
                                                                        22274000
      if output'record(type'of'data) <> output'data'type then           22276000
        begin                                                           22278000
          << new request is not of same type as current >>              22280000
          << record, so we must send the existing record >>             22282000
          << and build a new one for this request        >>             22284000
                                                                        22286000
          error'parm := cpr'send'record(cb'info,o'r'control);           22288000
                                                                        22290000
          << check error'parm for problems >>                           22292000
          if error'parm <> no'errors then                               22294000
            begin                                                       22296000
              return'status := error'parm;                              22298000
              return;                                                   22300000
            end;                                                        22302000
                                                                        22304000
          << now create new record header for this type of >>           22306000
          << data.                                         >>           22308000
          error'parm := build'data'record(output'data'type);            22310000
                                                                        22312000
          << check error'parm for problems >>                           22314000
          if error'parm <> no'errors then                               22316000
            begin                                                       22318000
              return'status := error'parm;                              22320000
              return;                                                   22322000
            end;                                                        22324000
        end;                                                            22326000
    end  << of logical(output'record(active)) = true >>                 22328000
  else                                                                  22330000
    begin                                                               22332000
      << there is no record active, so create a new one >>              22334000
                                                                        22336000
      error'parm := build'data'record(output'data'type);                22338000
                                                                        22340000
      << check error'parm for problems >>                               22342000
      if error'parm <> no'errors then                                   22344000
        begin                                                           22346000
          return'status := error'parm;                                  22348000
          return;                                                       22350000
        end;                                                            22352000
                                                                        22354000
    end;  << of logical(output'record(active)) <> true >>               22356000
                                                                        22358000
                                                                        22360000
                                                                        22362000
  << Convert the count the caller specified to a byte >>                22364000
  << count (positive, of course)                      >>                22366000
                                                                        22368000
  if count < 0 then                                                     22370000
    begin                                                               22372000
      << user specified bytes, so just negate >>                        22374000
                                                                        22376000
      byte'count := -count;                                             22378000
    end                                                                 22380000
  else                                                                  22382000
    begin                                                               22384000
      << user specified words, so convert >>                            22386000
                                                                        22388000
      byte'count := count to'byte;                                      22390000
    end;                                                                22392000
                                                                        22394000
                                                                        22396000
  << If the caller specified system buffers, then set up >>             22398000
  << the initial information in sbuf'info.               >>             22400000
                                                                        22402000
  if logical( flags.system'buffers ) then                               22404000
    begin                                                               22406000
      dst'num := sbuf'dst;                                              22408000
      if byte'count > 256 then byte'count := 256;                       22410000
    end;                                                                22412000
                                                                        22414000
                                                                        22416000
                                                                        22418000
  << If the function is a write, and the user specified that >>         22420000
  << the carriage control character is in the data buffer,   >>         22422000
  << then that word must be moved in and the upper byte used >>         22424000
  << as parm1 for the translator procedure.                  >>         22426000
                                                                        22428000
  if function = write and parm1 = 1 then                                22430000
    begin                                                               22432000
                                                                        22434000
      << Set cctl true, so we can remember later that the >>            22436000
      << first byte of the data is to be removed.         >>            22438000
                                                                        22440000
      cctl := true;                                                     22442000
                                                                        22444000
      << Temporarily use the pointer next'word and the    >>            22446000
      << translator buffer to move the first word of the  >>            22448000
      << caller's buffer in.                              >>            22450000
                                                                        22452000
      @next'word := @seq'1'buff to'word;                                22454000
                                                                        22456000
      mfds(next'word, dst'num, address, 1);                             22458000
                                                                        22460000
      parm1 := next'word.upper'byte;                                    22462000
                                                                        22464000
    end                                                                 22466000
  else                                                                  22468000
    begin                                                               22470000
                                                                        22472000
      << Carriage control is not via the first byte of the >>           22474000
      << record, so set cctl false.                        >>           22476000
                                                                        22478000
      cctl := false;                                                    22480000
                                                                        22482000
    end;                                                                22484000
                                                                        22486000
                                                                        22488000
  << Now translate the function code into escape sequences, >>          22490000
  << if the translate flag passed in is true.               >>          22492000
                                                                        22494000
                                                                        22496000
  if translate'flag then                                                22498000
    begin                                                               22500000
                                                                        22502000
      return'information := cpr'xlate(cb'info(xlate'flags),             22504000
        seq'1'buff, seq'2'buff, function, parm1, parm2,                 22506000
        if cctl then byte'count-1 else byte'count,                      22508000
        @output'position.bit'15,                                        22510000
        (not expanded'features'flag));                                  22512000
                                                                        22514000
      << check error'parm from translation process >>                   22516000
      if error'parm <> no'errors then                                   22518000
        begin                                                           22520000
          return'status := error'parm;                                  22522000
          return;                                                       22524000
        end                                                             22526000
      else                                                              22528000
        begin                                                           22530000
        << The function was successfully translated.  Ex-    >>         22532000
        << tract the lengths of the sequence(s) from the re- >>         22534000
        << turn information.                                 >>         22536000
                                                                        22538000
          seq'1'count := sequence'counts.upper'byte;                    22540000
          seq'2'count := sequence'counts.lower'byte;                    22542000
        end;                                                            22544000
    end                                                                 22546000
  else                                                                  22548000
    begin                                                               22550000
      << No translation needed, so set the counts to zero. >>           22552000
                                                                        22554000
      seq'1'count := seq'2'count := 0;                                  22556000
    end;                                                                22558000
                                                                        22560000
                                                                        22562000
  << If there is a leading sequence, move it into the  >>               22564000
  << output record.                                    >>               22566000
                                                                        22568000
  if seq'1'count > 0 then                                               22570000
    begin                                                               22572000
      error'parm := move'internal'data(seq'1'buff,seq'1'count);         22574000
                                                                        22576000
      << check the error'parm >>                                        22578000
      if error'parm <> no'errors then                                   22580000
        begin                                                           22582000
          return'status := error'parm;                                  22584000
          return;                                                       22586000
        end;                                                            22588000
                                                                        22590000
    end;  << of if seq'1'count > 0 >>                                   22592000
                                                                        22594000
                                                                        22596000
                                                                        22598000
  << Now move the user's data (if any) into the record buf- >>          22600000
  << fer from the data segment specified by ATTACHIO.       >>          22602000
                                                                        22604000
                                                                        22606000
      while byte'count > 0 do                                           22608000
        begin                                                           22610000
          << there is some data to move.  Initialize cer- >>            22612000
          << tain flags                                   >>            22614000
                                                                        22616000
          << see what will fit into the current record >>               22618000
          if o'r'control(current'length) + byte'count >                 22620000
              o'r'control(maximum'size) then                            22622000
            begin                                                       22624000
              << It won't all fit, so determine what will >>            22626000
                                                                        22628000
              what'fits := o'r'control(maximum'size) -                  22630000
                  o'r'control(current'length);                          22632000
              if logical( what'fits.bit'15 ) then                       22634000
                begin                                                   22636000
                  << back off to an even number >>                      22638000
                  what'fits := what'fits - 1;                           22640000
                end;                                                    22642000
            end                                                         22644000
          else                                                          22646000
            begin                                                       22648000
              << it will all fit, so move it all >>                     22650000
                                                                        22652000
              what'fits := byte'count;                                  22654000
            end;                                                        22656000
                                                                        22658000
                                                                        22660000
        if what'fits > 0 then                                           22662000
          begin                                                         22664000
                                                                        22666000
          << reduce byte count by the amount that will be >>            22668000
          << moved from the data segment                  >>            22670000
          byte'count := byte'count - what'fits;                         22672000
                                                                        22674000
          << change byte count to word count for move >>                22676000
                                                                        22678000
              move'count := (what'fits + 1) to'word;                    22680000
                                                                        22682000
                                                                        22684000
          << now determine if the next position in the    >>            22686000
          << record buffer is on an odd or even byte      >>            22688000
          << boundary, and set up the appropriate address >>            22690000
          address'odd := logical( @output'position.bit'15 );            22692000
                                                                        22694000
          @next'word := (@output'position + 1) to'word;                 22696000
                                                                        22698000
                                                                        22700000
          << Move the user's data into the record buffer >>             22702000
                                                                        22704000
          mfds(next'word,dst'num,address,move'count);                   22706000
                                                                        22708000
          address := address + move'count;                              22710000
                                                                        22712000
          total'moved := total'moved + what'fits;                       22714000
                                                                        22716000
                                                                        22718000
                                                                        22720000
          << if starting address in buffer was odd, shuffle >>          22722000
          << the data up one byte.  In either case, update  >>          22724000
          << the buffer pointer.                            >>          22726000
                                                                        22728000
          if address'odd or cctl then                                   22730000
            begin                                                       22732000
              << One or two bytes will have to be compressed >>         22734000
              << out of the buffer.                          >>         22736000
                                                                        22738000
              offset := if address'odd then 1 else 0;                   22740000
              if cctl then                                              22742000
                begin                                                   22744000
                  offset := offset + 1;                                 22746000
                  what'fits := what'fits - 1;                           22748000
                  cctl := false;                                        22750000
                end;                                                    22752000
                                                                        22754000
              move output'position := output'position(offset),          22756000
                                      (what'fits),2;                    22758000
                                                                        22760000
              @output'position := tos;                                  22762000
                                                                        22764000
            end                                                         22766000
          else                                                          22768000
            begin                                                       22770000
              << don't move the data, just adjust pointers >>           22772000
                                                                        22774000
              @output'position := @output'position + what'fits;         22776000
            end;                                                        22778000
                                                                        22780000
          << update the record control information >>                   22782000
          o'r'control(current'position) := @output'position             22784000
              - @o'r'control to'byte;                                   22786000
          o'r'control(current'length) := o'r'control                    22788000
              (current'length) + what'fits;                             22790000
                                                                        22792000
          end;                                                          22794000
                                                                        22796000
                                                                        22798000
          << now determine if the record should be sent out >>          22800000
          << or if there is room for more data              >>          22802000
                                                                        22804000
          if o'r'control(current'length) >=                             22806000
             o'r'control(maximum'size) - 1 then                         22808000
            begin                                                       22810000
              << the record's full, so send it >>                       22812000
                                                                        22814000
              error'parm := send'then'build(output'data'type);          22816000
                                                                        22818000
              << check error'parm >>                                    22820000
              if error'parm <> no'errors then                           22822000
                begin                                                   22824000
                  return'status := error'parm;                          22826000
                  return;                                               22828000
                end;                                                    22830000
                                                                        22832000
            end;  << of send the record >>                              22834000
                                                                        22836000
        end;  << of while byte'count > 0 ... >>                         22838000
                                                                        22840000
                                                                        22842000
                                                                        22844000
  << Now buffer up the trailing escape sequence, if any >>              22846000
                                                                        22848000
  if seq'2'count > 0 then                                               22850000
    begin                                                               22852000
      << there is a trailing sequence, so move it into   >>             22854000
      << the buffer.                                     >>             22856000
                                                                        22858000
      error'parm := move'internal'data(seq'2'buff,seq'2'count);         22860000
                                                                        22862000
      << check error'parm >>                                            22864000
      if error'parm <> no'errors then                                   22866000
        begin                                                           22868000
          return'status := error'parm;                                  22870000
          return;                                                       22872000
        end;                                                            22874000
                                                                        22876000
                                                                        22878000
    end;  << of move trailing sequence, if any >>                       22880000
                                                                        22882000
                                                                        22884000
  << If we get here, there have been no errors that could >>            22886000
  << not be recovered, so return a good completion code   >>            22888000
  << to the caller.                                       >>            22890000
                                                                        22892000
  return'status := no'errors;                                           22894000
                                                                        22896000
  transfer'log := if count < 0 then -total'moved                        22898000
                               else total'moved to'word;                22900000
                                                                        22902000
                                                                        22904000
end;  << of write'data procedure >>                                     22906000
                                                                        22908000
$PAGE "PROCEDURE:  B08'CONFIGURE"                                       22910000
integer procedure b08'configure(cb'info, sr'enable,                     22912000
                                esb'frequency        );                 22914000
                                                                        22916000
  value                         cb'info, sr'enable,                     22918000
                                esb'frequency         ;                 22920000
                                                                        22922000
  integer pointer               cb'info               ;                 22924000
                                                                        22926000
  integer                                sr'enable,                     22928000
                                esb'frequency         ;                 22930000
                                                                        22932000
  option privileged, uncallable                       ;                 22934000
                                                                        22936000
                                                                        22938000
COMMENT                                                                 22940000
                                                                        22942000
  PURPOSE:                                                              22944000
                                                                        22946000
    This procedure will build and send a configuration record           22948000
    to the peripheral.  For the 2608B, this record contains             22950000
    information controlling unsolicited status reports and              22952000
    frequency of environmental status reporting.                        22954000
                                                                        22956000
                                                                        22958000
  INPUT PARAMETERS:                                                     22960000
                                                                        22962000
    CB'INFO, which is a pointer to the control block information        22964000
      area for the logical driver of this ldev.                         22966000
                                                                        22968000
    SR'ENABLE, which allows the peripheral to send unsolicited          22970000
      status reports, if the least significant bit is set.              22972000
      Otherwise, the only unsolicited report that can be sent           22974000
      is the powerfail report.                                          22976000
                                                                        22978000
    ESB'FREQUENCY, which specifies the number of checkpoint             22980000
      occurances between reported environmental status'.  If            22982000
      set to zero, no environmental status reports will be sent         22984000
      unless specifically commanded to do so.                           22986000
                                                                        22988000
                                                                        22990000
  OUTPUT PARAMETERS:                                                    22992000
                                                                        22994000
    B08'CONFIGURE, which is the completion status of the                22996000
      procedure call.  A value of one is returned if no errors          22998000
      occurred.  Other values will be defined as required.              23000000
                                                                        23002000
                                                                        23004000
  SIDE-EFFECTS:                                                         23006000
                                                                        23008000
    None.                                                               23010000
                                                                        23012000
                                                                        23014000
  SPECIAL CONSIDERATIONS:                                               23016000
                                                                        23018000
    When called, DB must be set to the base of the CIPER data           23020000
    segment.                                                            23022000
                                                                        23024000
                                                                        23026000
  CHANGE HISTORY:                                                       23028000
                                                                        23030000
    As issued.                                                          23032000
                                                                        23034000
                                                                        23036000
;                                                                       23038000
$PAGE "PROCEDURE:  B08'CONFIGURE -- LOCAL DECLARATIONS"                 23040000
begin                                                                   23042000
                                                                        23044000
  define                                                                23046000
                                                                        23048000
    upper'byte                    = (0:8) #                             23050000
   ,lower'byte                    = (8:8) #                             23052000
                                                                        23054000
  ;                                                                     23056000
                                                                        23058000
                                                                        23060000
  integer pointer                                                       23062000
                                                                        23064000
    o'r'control                                                         23066000
      << points to control information for output record >>             23068000
                                                                        23070000
   ,o'r'data                                                            23072000
      << points to data portion of output record buffer area >>         23074000
                                                                        23076000
  ;                                                                     23078000
                                                                        23080000
  integer                                                               23082000
                                                                        23084000
    return'status                 = b08'configure                       23086000
      << completion status for procedure call >>                        23088000
                                                                        23090000
  ;                                                                     23092000
                                                                        23094000
$PAGE "PROCEDURE:  B08'CONFIGURE -- PROCEDURE BODY"                     23096000
  << First, initialize the output record pointers. >>                   23098000
                                                                        23100000
  @o'r'control := b08'get'buffer(cb'info, output'overwrite);            23102000
                                                                        23104000
  @o'r'data := @o'r'control + o'r'control(start);                       23106000
                                                                        23108000
                                                                        23110000
  << Build the configuration record >>                                  23112000
                                                                        23114000
  b08'build'header( o'r'control,                                        23116000
                    lgl'configuration,                                  23118000
                    status'mask,                               <<04422>>23120000
                    set'bit, << sob'flag >>                    <<04422>>23122000
                    set'bit  << eob'flag >> );                 <<04422>>23124000
                                                                        23126000
                                                                        23128000
  o'r'data(parm'byte'1) := sr'enable;                                   23130000
  o'r'data(parm'byte'2) := esb'frequency.upper'byte;                    23132000
  o'r'data(parm'byte'3) := esb'frequency.lower'byte;                    23134000
                                                                        23136000
  o'r'control(current'length) :=                                        23138000
      o'r'control(current'length) + 3;                                  23140000
                                                                        23142000
                                                                        23144000
  << Send the record to the peripheral >>                               23146000
                                                                        23148000
  return'status := cpr'send'record(cb'info, o'r'control);               23150000
                                                                        23152000
                                                                        23154000
  << Release the allocated buffer. >>                                   23156000
                                                                        23158000
  b08'release'buffer(cb'info, o'r'control);                             23160000
                                                                        23162000
                                                                        23164000
end;  << of procedure b08'configure >>                                  23166000
                                                                        23168000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR"                                    23170000
integer procedure b08'device'clear(cb'info, dev'clear'parm);            23172000
                                                                        23174000
  value                            cb'info, dev'clear'parm ;            23176000
                                                                        23178000
  integer pointer                  cb'info                 ;            23180000
                                                                        23182000
  integer                                   dev'clear'parm ;            23184000
                                                                        23186000
  option privileged, uncallable                            ;            23188000
                                                                        23190000
                                                                        23192000
COMMENT                                                                 23194000
                                                                        23196000
  PURPOSE:                                                              23198000
                                                                        23200000
    This procedure will issue a DEVICE CLEAR command to the             23202000
    peripheral.  It then waits for the peripheral to return a           23204000
    CLEAR RESPONSE, at which point the send and receive record          23206000
    counts are cleared (set to zero).  If other information is          23208000
    returned before the CLEAR RESPONSE, this procedure will             23210000
    determine if that information should be processed or ig-            23212000
    nored.                                                              23214000
                                                                        23216000
                                                                        23218000
  INPUT PARAMETERS:                                                     23220000
                                                                        23222000
    CB'INFO, which is a pointer to the base of the control              23224000
      block level dependent information area (used for global           23226000
      storage by the logical driver).                                   23228000
                                                                        23230000
    DEV'CLEAR'PARM, which will become the parameter byte of             23232000
      the DEVICE CLEAR command.  This parameter determines              23234000
      what information in the device will be cleared and what           23236000
      will remain intact.  Only the least significant bit               23238000
      meaning, the others should be set to zero.                        23240000
                                                                        23242000
                                                                        23244000
  OUTPUT PARAMETERS:                                                    23246000
                                                                        23248000
    B08'DEVICE'CLEAR, which returns the completion status of            23250000
      the call.  If no errors occured, a value of one is re-            23252000
      turned.  Other values will be defined as required.                23254000
                                                                        23256000
                                                                        23258000
  SIDE EFFECTS:                                                         23260000
                                                                        23262000
    This procedure will initialize several variables located in         23264000
    the control block information area, most notably the input          23266000
    and output receive ready counters.  In addition, the device         23268000
    status area may be updated if any device status reports are         23270000
    received while waiting for the CLEAR RESPONSE report.               23272000
                                                                        23274000
                                                                        23276000
  SPECIAL CONSIDERATIONS:                                               23278000
                                                                        23280000
    Before calling the procedure, the caller must have DB set           23282000
    data segment.  Any pending output records will                      23284000
    be overwritten when this procedure creates its device clear         23286000
    command.                                                            23288000
                                                                        23290000
                                                                        23292000
  CHANGE HISTORY:                                                       23294000
                                                                        23296000
    As issued.                                                          23298000
                                                                        23300000
                                                                        23302000
;                                                                       23304000
                                                                        23306000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR -- LOCAL VARIABLES"                 23308000
begin                                                                   23310000
  << DECLARATION OF LOCAL VARIABLES >>                                  23312000
                                                                        23314000
  integer pointer                                                       23316000
                                                                        23318000
    i'o'control                                                         23320000
      << points to input record control area >>                         23322000
                                                                        23324000
   ,i'o'record                                                          23326000
      << points to base of output record area >>                        23328000
                                                                        23330000
  ;                                                                     23332000
                                                                        23334000
  byte pointer                                                          23336000
                                                                        23338000
    destination                                                         23340000
      << temporary destination address for moving bytes out >>          23342000
      << of the Clear Response fields into the control block >>         23344000
      << information area.                                   >>         23346000
                                                                        23348000
   ,input'position                                                      23350000
      << byte pointer into the input record buffer area.    >>          23352000
      << Used for moving bytes out of various fields of the >>          23354000
      << Clear Response.                                    >>          23356000
                                                                        23358000
  ;                                                                     23360000
                                                                        23362000
  integer                                                               23364000
                                                                        23366000
    seq'number'sent                                                     23368000
      << contains the sequence number sent in the device >>             23370000
      << clear record.  This number should be returned in >>            23372000
      << the peripheral's clear response.                >>             23374000
                                                                        23376000
   ,error'parm                                                          23378000
      << Used for completion status from other procedures >>            23380000
                                                                        23382000
   ,stat'error                                                          23384000
      << Used to hold status error returns during evaluation >>         23386000
                                                                        23388000
  ;                                                                     23390000
                                                                        23392000
  equate                                                                23394000
                                                                        23396000
    dev'clear'length              = 1                                   23398000
      << length of device clear parameter field(s) >>                   23400000
                                                                        23402000
  ;                                                                     23404000
                                                                        23406000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR -- SUBROUTINE:  RETURN'BUFFERS"     23408000
subroutine return'buffers;                                              23410000
                                                                        23412000
COMMENT                                                                 23414000
                                                                        23416000
  PURPOSE:                                                              23418000
    This subroutine will return the input and output buffers            23420000
    to the free-list, if they came from there.  If the normal           23422000
    i/o buffer(s) had to be overwritten to accomplish the               23424000
    device clear, they will merely be marked free.                      23426000
                                                                        23428000
;                                                                       23430000
                                                                        23432000
begin                                                                   23434000
                                                                        23436000
  b08'release'buffer(cb'info, i'o'control);                             23438000
                                                                        23440000
  cb'info(dev'clr'count) := cb'info(dev'clr'count) - 1;                 23442000
                                                                        23444000
  if cb'info(dev'clr'count) = 0 then                                    23446000
    begin                                                               23448000
      cb'info(dev'clr'in'progress) := false;                            23450000
    end;                                                                23452000
                                                                        23454000
end;  << of subroutine return'buffers >>                                23456000
$PAGE "PROCEDURE:  B08'DEVICE'CLEAR -- PROCEDURE BODY"                  23458000
  << If we are attempting to do more than three device >>               23460000
  << clears recursively, there is obviously something  >>               23462000
  << very peculiar with the device.  Give up and return >>              23464000
  << a catastrophic error.                              >>              23466000
                                                                        23468000
  if cb'info(dev'clr'count) = 3 then                                    23470000
    begin                                                               23472000
                                                                        23474000
      b08'device'clear := fatal'error;                                  23476000
      return;                                                           23478000
                                                                        23480000
    end;                                                                23482000
                                                                        23484000
                                                                        23486000
  << Increment the count of device clear recursions, and >>             23488000
  << mark true the device clear in progress indicator.   >>             23490000
                                                                        23492000
  cb'info(dev'clr'count) := cb'info(dev'clr'count) + 1;                 23494000
                                                                        23496000
  cb'info(dev'clr'in'progress) := true;                                 23498000
                                                                        23500000
                                                                        23502000
  << Set up pointers to output record buffer area >>                    23504000
                                                                        23506000
  @i'o'control := b08'get'buffer(cb'info, output'overwrite);            23508000
                                                                        23510000
  @i'o'record := i'o'control(start) + @i'o'control;                     23512000
                                                                        23514000
                                                                        23516000
  << Build a DEVICE CLEAR record, such that the device will >>          23518000
  << clear all input and output buffers, abort all pending  >>          23520000
  << reads, and clear all programmable features.            >>          23522000
                                                                        23524000
  b08'build'header( i'o'control,                                        23526000
                    lgl'device'clear,                                   23528000
                    , << no data'type used >>                  <<04422>>23530000
                    set'bit, << sob'flag >>                    <<04422>>23532000
                    set'bit  << eob'flag >>    );              <<04422>>23534000
                                                                        23536000
  i'o'record(parm'byte'1) := dev'clear'parm.bit'15;                     23538000
                                                                        23540000
  i'o'control(current'length) :=                                        23542000
      i'o'control(current'length) + dev'clear'length;                   23544000
                                                                        23546000
  << Save the sequence number sent to the peripheral.  It >>            23548000
  << should return that value in the CLEAR RESPONSE as an >>            23550000
  << error checking mechanism.                            >>            23552000
                                                                        23554000
  seq'number'sent := cb'info(output'sequence'count);                    23556000
                                                                        23558000
  << Send the record to the peripheral.  Set the 'force'  >>            23560000
  << mode so normal protocol will be overridden for this >>             23562000
  << transfer.                                            >>            23564000
                                                                        23566000
  error'parm := cpr'force'record(cb'info,i'o'control);                  23568000
                                                                        23570000
  << check the error'parm >>                                            23572000
  if error'parm = no'errors then                                        23574000
    begin                                                               23576000
      << Clear command was successfully sent.  Now wait for >>          23578000
      << peripheral to respond with the Clear Response.  If >>          23580000
      << anything else comes in first, ignor it.            >>          23582000
                                                                        23584000
                                                                        23586000
      do                                                                23588000
        begin                                                           23590000
          << Loop until the correct response is received. >>            23592000
          << First set the input record inactive. >>                    23594000
                                                                        23596000
          i'o'control(active) := free;                                  23598000
                                                                        23600000
          << Now get a record from the transport service >>             23602000
                                                                        23604000
          error'parm := cpr'get'record(cb'info,i'o'control,             23606000
                                       dont'care);                      23608000
                                                                        23610000
          << check the error'parm >>                                    23612000
          if error'parm = no'errors then                                23614000
            begin                                                       23616000
              << Something came in without transport     >>             23618000
              << errors.  If it is not a clear response, >>             23620000
              << let the status processor handle it.     >>             23622000
                                                                        23624000
              if i'o'record(header'opcode) <>                           23626000
                  lgl'clear'response then                               23628000
                begin                                                   23630000
                  stat'error := b08'process'status(cb'info              23632000
                                   ,i'o'control);                       23634000
                  if stat'error.general <> successful then              23636000
                   begin                                                23638000
                    B08'device'clear:=stat'error;                       23640000
                    return'buffers;                                     23642000
                    return;                                             23644000
                   end;                                                 23646000
                end;                                                    23648000
            end                                                         23650000
          else                                                          23652000
            begin                                                       23654000
              << A transport serivce error occurred. >>                 23656000
              << Return with an error.               >>                 23658000
                                                                        23660000
              return'buffers;                                           23662000
              b08'device'clear := error'parm;                           23664000
              return;                                                   23666000
            end;                                                        23668000
        end                                                             23670000
      until i'o'record(header'opcode) = lgl'clear'response              23672000
        and i'o'record(parm'byte'1) = seq'number'sent;                  23674000
                                                                        23676000
      << Now that we have the Clear Response desired, update >>         23678000
      << the appropriate information in the control block    >>         23680000
      << information area.                                   >>         23682000
                                                                        23684000
      cb'info(output'sequence'count) := 0;                              23686000
      cb'info(input'sequence'count) := 1;                               23688000
      cb'info(receive'ready'count) := 0;                                23690000
                                                                        23692000
      cb'info(dev'clr'in'progress) := false;                            23694000
                                                                        23696000
                                                                        23698000
      << Extract the information from the clear responce >>             23700000
                                                                        23702000
      @input'position := ( @i'o'record to'byte )                        23704000
          + rec'head'length + 1;                                        23706000
                                                                        23708000
      if i'o'control(current'length) >= 12 then                         23710000
        begin                                                           23712000
          @destination := ( cb'info(product'number)                     23714000
                          + cb'info(cds'area'base) ) to'byte;           23716000
          move destination :=                                           23718000
               input'position,(product'id'length),1;                    23720000
          @input'position := tos;  del;                                 23722000
        end;                                                            23724000
                                                                        23726000
      if i'o'control(current'length) >= 14 then                         23728000
        begin                                                           23730000
                                                                        23732000
                                                                        23734000
          @destination := @cb'info(device'buffer'size) to'byte;         23736000
          move destination := input'position,(2),1;                     23738000
          @input'position := tos;  del;                                 23740000
                                                                        23742000
          << Multiply the buffer size by 128 (Device reports >>         23744000
          << size/128                                        >>         23746000
                                                                        23748000
          cb'info(device'buffer'size) :=                                23750000
           (  cb'info(device'buffer'size) & lsl(4) );                   23752000
        end;                                                            23754000
                                                                        23756000
      if i'o'control(current'length) >= 16 then                         23758000
        begin                                                           23760000
          << Move the environmental status size >>                      23762000
                                                                        23764000
          @destination := @cb'info(device'env'status'size)&lsl(1);      23766000
          move destination := input'position,(2);                       23768000
        end                                                             23770000
      else                                                              23772000
        begin                                                           23774000
          << Did not get environmental status size, so >>               23776000
          << set a default size of 32.                 >>               23778000
                                                                        23780000
          cb'info(device'env'status'size) := 32;                        23782000
        end;                                                            23784000
                                                                        23786000
                                                                        23788000
      << Mark the input record as available >>                          23790000
                                                                        23792000
      return'buffers;                                                   23794000
                                                                        23796000
                                                                        23798000
      << Now send the peripheral configuration command to >>            23800000
      << establish status reporting and set the requested >>            23802000
      << environmental status reporting frequency.        >>            23804000
                                                                        23806000
      error'parm := b08'configure( cb'info                              23808000
                                  ,true  << sr'enable >>                23810000
                                  ,cb'info(esb'frequency) );            23812000
                                                                        23814000
      b08'device'clear := error'parm;                                   23816000
                                                                        23818000
                                                                        23820000
                                                                        23822000
    end                                                                 23824000
  else                                                                  23826000
    begin                                                               23828000
      << Device Clear command could not be sent to the de-   >>         23830000
      << vice.  Free up both buffers and return to the       >>         23832000
      << caller with an error.                               >>         23834000
                                                                        23836000
      return'buffers;                                                   23838000
      b08'device'clear := error'parm;                                   23840000
    end;                                                                23842000
                                                                        23844000
                                                                        23846000
                                                                        23848000
end;  << of b08'device'clear >>                                         23850000
                                                                        23852000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT"                               23854000
double procedure B08'return'job'report(cb'info, dst'num,                23856000
                                       address, count,                  23858000
                                       new'status'flag   );             23860000
                                                                        23862000
  value                                cb'info, dst'num,                23864000
                                       address, count,                  23866000
                                       new'status'flag    ;             23868000
                                                                        23870000
  integer pointer                      cb'info            ;             23872000
                                                                        23874000
  integer                                    dst'num,                   23876000
                                       address, count     ;             23878000
                                                                        23880000
  logical                              new'status'flag    ;             23882000
                                                                        23884000
  option privileged, uncallable                           ;             23886000
                                                                        23888000
                                                                        23890000
                                                                        23892000
                                                                        23894000
COMMENT                                                                 23896000
                                                                        23898000
  PURPOSE:                                                              23900000
    This procedure will return the job report information               23902000
    buffered in the CIPER data segment to the caller.  The              23904000
    caller must specify the data segment number and offset of           23906000
    the destination buffer, as well as the buffer size.                 23908000
                                                                        23910000
                                                                        23912000
  INPUT PARAMETERS:                                                     23914000
                                                                        23916000
    CB'INFO, a pointer to the control block information area            23918000
      for this ldev's level 7.                                          23920000
                                                                        23922000
    DST'NUM, which is the data segment number where the caller          23924000
      would like the status information moved.                          23926000
                                                                        23928000
    ADDRESS, which is the offset within the specified data              23930000
      segment where the data is to be moved.                            23932000
                                                                        23934000
    COUNT, which is the maximum amount of data the caller               23936000
      wishes moved.  If positive, the count specifies words.            23938000
      If negative, the count specifies bytes.                           23940000
                                                                        23942000
    NEW'STATUS'FLAG, which if false indicates that any status           23944000
      currently in the job report status area should be moved.          23946000
      If true, then a new copy of the job report status should          23948000
      be requested from the device.                                     23950000
                                                                        23952000
                                                                        23954000
                                                                        23956000
  OUTPUT PARAMETERS:                                                    23958000
                                                                        23960000
    B08'RETURN'JOB'REPORT, which is a double word function re-          23962000
      turn.  The most significant word is the completion sta-           23964000
      tus for the call.  The least significant word is the              23966000
      transfer count of data actually moved (maintains the same         23968000
      sense (+/-) as the input parameter COUNT).                        23970000
                                                                        23972000
  SIDE-EFFECTS:                                                         23974000
                                                                        23976000
    None.                                                               23978000
                                                                        23980000
                                                                        23982000
  SPECIAL CONSIDERATIONS:                                               23984000
                                                                        23986000
    When called, this procedure assumes DB is pointing to the           23988000
    base of the appropriate CIPER data segment.                         23990000
                                                                        23992000
                                                                        23994000
  CHANGE HISTORY:                                                       23996000
                                                                        23998000
    As issued.                                                          24000000
                                                                        24002000
                                                                        24004000
;                                                                       24006000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT -- LOCAL VARIABLES"            24008000
                                                                        24010000
begin                                                                   24012000
                                                                        24014000
  << Declaration of local variables >>                                  24016000
                                                                        24018000
  integer pointer                                                       24020000
                                                                        24022000
    status'information                                                  24024000
      << points to data in status tank of CIPER dst >>                  24026000
                                                                        24028000
  ;                                                                     24030000
                                                                        24032000
                                                                        24034000
  logical                                                               24036000
                                                                        24038000
    count'was'negative                                                  24040000
      << flag to indicate need to convert transfer'log back >>          24042000
      << to bytes                                           >>          24044000
                                                                        24046000
  ;                                                                     24048000
                                                                        24050000
                                                                        24052000
  integer                                                               24054000
                                                                        24056000
    return'status                 = b08'return'job'report               24058000
      << completion status of procedure >>                              24060000
                                                                        24062000
   ,transfer'log                  = b08'return'job'report + 1           24064000
      << number of bytes/words returned to user >>                      24066000
                                                                        24068000
  ;                                                                     24070000
                                                                        24072000
                                                                        24074000
  integer pointer                                                       24076000
                                                                        24078000
    i'o'control                                                         24080000
      << Points to record buffer area used to request/re-  >>           24082000
      << ceive job report status if a new copy has been    >>           24084000
      << requested by the caller.                          >>           24086000
                                                                        24088000
  ;                                                                     24090000
                                                                        24092000
  declare'move'to'data'segment;                                         24094000
$PAGE "PROCEDURE:  B08'RETURN'JOB'REPORT -- PROCEDURE BODY"             24096000
  << If the caller requested a new copy of the job report,  >>          24098000
  << we should first send any pending data, so the job re-  >>          24100000
  << port will accurately reflect the number of pages the   >>          24102000
  << job has so far printed.                                >>          24104000
                                                                        24106000
  if new'status'flag then                                               24108000
    begin                                                               24110000
                                                                        24112000
      @i'o'control := cb'info(o'r'base)                                 24114000
                    + cb'info(cds'area'base);                           24116000
      if logical( i'o'control(active) ) then                            24118000
        begin                                                           24120000
          return'status := cpr'send'record( cb'info,                    24122000
                                            i'o'control );              24124000
          if return'status.general <> successful then                   24126000
            begin                                                       24128000
              return;                                                   24130000
            end;                                                        24132000
        end;                                                            24134000
                                                                        24136000
      b08'build'header( i'o'control,                                    24138000
                        lgl'report'job'status,                          24140000
                        , << no data'type used >>              <<04422>>24142000
                        set'bit, << sob'flag >>                <<04422>>24144000
                        set'bit  << eob'flag >>   );           <<04422>>24146000
                                                                        24148000
      return'status := cpr'send'record( cb'info,                        24150000
                                        i'o'control );                  24152000
                                                                        24154000
      if return'status.general <> successful then                       24156000
        begin                                                           24158000
          return;                                                       24160000
        end;                                                            24162000
                                                                        24164000
      return'status := cpr'get'record( cb'info,                         24166000
                                       i'o'control,                     24168000
                                       lgl'job'report );                24170000
                                                                        24172000
      if return'status.general <> successful then                       24174000
        begin                                                           24176000
          return;                                                       24178000
        end;                                                            24180000
                                                                        24182000
      b08'job'report( cb'info, i'o'control );                           24184000
                                                                        24186000
    end;  << of if new'status'flag >>                                   24188000
                                                                        24190000
                                                                        24192000
  << Initialize the status pointer >>                                   24194000
                                                                        24196000
  @status'information := cb'info(job'report'base)                       24198000
                       + cb'info(cds'area'base);                        24200000
                                                                        24202000
                                                                        24204000
  << Determine if requested count is greater than the length >>         24206000
  << of the status information.  If it is, move all of the   >>         24208000
  << status. If not, only move part of it.  Only an even     >>         24210000
  << number of bytes may be moved across the dst boundary.   >>         24212000
                                                                        24214000
  << First, we must make sure the requested count is words >>           24216000
                                                                        24218000
  if count < 0 then                                                     24220000
    begin                                                               24222000
      count := (-count) to'word;                                        24224000
      count'was'negative := true;                                       24226000
    end                                                                 24228000
  else                                                                  24230000
    begin                                                               24232000
      count'was'negative := false;                                      24234000
    end;                                                                24236000
                                                                        24238000
  << Determine which is larger, the requested count or the >>           24240000
  << status information.                                   >>           24242000
                                                                        24244000
  if count > (job'report'length to'word) then                           24246000
    begin                                                               24248000
      count := job'report'length to'word;                               24250000
    end;                                                                24252000
                                                                        24254000
  << Move the information to the caller's dst. >>                       24256000
                                                                        24258000
  if count > 0 then                                            <<04434>>24260000
    begin                                                      <<04434>>24262000
      mtds(dst'num,address,status'information,count);          <<04434>>24264000
    end;                                                       <<04434>>24266000
                                                                        24268000
  << Now adjust the return count information. >>                        24270000
                                                                        24272000
  if  count'was'negative then                                           24274000
    begin                                                               24276000
      transfer'log := -(count to'byte);                                 24278000
    end                                                                 24280000
  else                                                                  24282000
    begin                                                               24284000
      transfer'log := count;                                            24286000
    end;                                                                24288000
                                                                        24290000
  << Set up the error return >>                                         24292000
                                                                        24294000
  return'status := no'errors;                                           24296000
                                                                        24298000
end;  << of procedure b08'return'job'report >>                          24300000
                                                                        24302000
$PAGE "B08'END'JOB"                                                     24304000
double procedure b08'end'job( cb'info, dst'num, address,                24306000
                              count, flags              );              24308000
                                                                        24310000
  value                       cb'info, dst'num, address,                24312000
                              count, flags               ;              24314000
                                                                        24316000
  integer pointer             cb'info                    ;              24318000
                                                                        24320000
  integer                              dst'num, address,                24322000
                              count, flags               ;              24324000
                                                                        24326000
  option privileged, uncallable                          ;              24328000
                                                                        24330000
                                                                        24332000
COMMENT                                                                 24334000
                                                                        24336000
  PURPOSE:                                                              24338000
                                                                        24340000
    This procedure will send the END OF JOB command to the              24342000
    peripheral, then clean up and job related information in            24344000
    the control block information area.  If any output record           24346000
    buffers were pending transmission, they will be sent to             24348000
    the peripheral before the job end command is sent.                  24350000
                                                                        24352000
    Additionally, if the caller has specified a destination             24354000
    buffer, the contents of the job report record, if any is            24356000
    received from the peripheral, will be moved to that buffer.         24358000
                                                                        24360000
                                                                        24362000
  INPUT PARAMETERS:                                                     24364000
                                                                        24366000
    CB'INFO, which points to the control block information area         24368000
      of the logical driver.                                            24370000
                                                                        24372000
                                                                        24374000
    DST'NUM, which is the index of a data segment the caller            24376000
      has provided a data buffer in for reception of the job            24378000
      report information.  It will be non-zero for a dst index,         24380000
      but could be passed as zero if system buffers are spe-            24382000
      cified, or the job report information is not desired.             24384000
                                                                        24386000
    ADDRESS, which, depending on the system buffer bit of FLAGS         24388000
      will be either an offset to the data segment specified by         24390000
      DST'NUM, or the sysdb relative index of a system buffer.          24392000
                                                                        24394000
    COUNT, which specifies the maximum amount of job report             24396000
      information to return to the specified buffer.  If the            24398000
      count is zero, no information is returned.  If positive,          24400000
      the request is in words.  If negative, the request is in          24402000
      bytes.                                                            24404000
                                                                        24406000
    FLAGS, which contain the system buffer flag (12:1) that             24408000
      indicates whether ADDRESS is a system buffer index (set)          24410000
      or an offset to a data segment (clear).                           24412000
                                                                        24414000
                                                                        24416000
  OUTPUT PARAMETERS:                                                    24418000
                                                                        24420000
    B08'END'JOB, a two word (double) function return.  The              24422000
      first word is the completion status of the call.  The             24424000
      second word is the transfer count of the job report               24426000
      status moved to a caller specified buffer.                        24428000
                                                                        24430000
                                                                        24432000
  SIDE-EFFECTS:                                                         24434000
                                                                        24436000
    Causes job to be closed, if one was active on the device.           24438000
    When the peripheral is finished with the job, a job status          24440000
    report will be returned.  If the caller has specified a             24442000
    destination buffer, the contents of the job report status           24444000
    will be moved to that buffer.                                       24446000
                                                                        24448000
                                                                        24450000
  SPECIAL CONSIDERATIONS:                                               24452000
                                                                        24454000
    When called, DB must be set to the base of the CIPER data           24456000
    segment.                                                            24458000
                                                                        24460000
                                                                        24462000
  CHANGE HISTORY:                                                       24464000
                                                                        24466000
    As issued.                                                          24468000
                                                                        24470000
;                                                                       24472000
                                                                        24474000
$PAGE "B08'END'JOB -- LOCAL DECLARATIONS"                               24476000
begin                                                                   24478000
                                                                        24480000
  << Completion status subparameters >>                                 24482000
                                                                        24484000
  integer                                                               24486000
                                                                        24488000
    return'status                 = b08'end'job                         24490000
      << contains procedure call completion status >>                   24492000
                                                                        24494000
   ,transfer'log                  = b08'end'job + 1                     24496000
      << Amount of data moved to caller specified buffer, >>            24498000
      << if any.                                          >>            24500000
                                                                        24502000
  ;                                                                     24504000
                                                                        24506000
                                                                        24508000
                                                                        24510000
  << Input and output data record buffer pointers >>                    24512000
                                                                        24514000
  integer pointer                                                       24516000
                                                                        24518000
    o'r'control                                                         24520000
      << control portion of output record buffer area >>                24522000
                                                                        24524000
   ,o'r'data                                                            24526000
      << data portion of output record buffer area >>                   24528000
                                                                        24530000
   ,i'r'control                                                         24532000
      << control portion of input record buffer area >>                 24534000
                                                                        24536000
  ;                                                                     24538000
                                                                        24540000
                                                                        24542000
  << Miscellaneous >>                                                   24544000
                                                                        24546000
  logical                                                               24548000
                                                                        24550000
    buffers'cleared                                                     24552000
      << true if all output buffers are cleared before the >>           24554000
      << job end command is sent.                          >>           24556000
                                                                        24558000
  ;                                                                     24560000
                                                                        24562000
                                                                        24564000
                                                                        24566000
                                                                        24568000
$PAGE "B08'END'JOB -- PROCEDURE BODY"                                   24570000
  << Is there a job active?  If not, just set up a good >>              24572000
  << status return and exit.                            >>              24574000
                                                                        24576000
  if not logical( cb'info(job'active) ) then                            24578000
    begin                                                               24580000
      return'status.general := successful;                              24582000
      transfer'log := 0;                                                24584000
    end                                                                 24586000
  else                                                                  24588000
                                                                        24590000
    << A job is active on the device.  Clean out any pen- >>            24592000
    << ding buffers and send the end of job record.       >>            24594000
                                                                        24596000
    begin                                                               24598000
      << Initialize output record pointers >>                           24600000
                                                                        24602000
      @o'r'control := cb'info(o'r'base)                                 24604000
                    + cb'info(cds'area'base);                           24606000
                                                                        24608000
      @o'r'data := o'r'control(start) + @o'r'control;                   24610000
                                                                        24612000
                                                                        24614000
      << Check for active buffers, and send any that are >>             24616000
                                                                        24618000
      if logical( o'r'control(active) ) then                            24620000
        begin                                                           24622000
          return'status := cpr'send'record(cb'info,                     24624000
                                           o'r'control);                24626000
          if return'status.general = successful then                    24628000
            begin                                                       24630000
              buffers'cleared := true;                                  24632000
            end                                                         24634000
          else                                                          24636000
            begin                                                       24638000
              buffers'cleared := false;                                 24640000
            end;                                                        24642000
        end                                                             24644000
      else                                                              24646000
        begin                                                           24648000
          buffers'cleared := true;                                      24650000
        end;                                                            24652000
                                                                        24654000
                                                                        24656000
      << If buffers are now clear, build the job end command >>         24658000
      << record and complete the sequence.                   >>         24660000
                                                                        24662000
      if buffers'cleared then                                           24664000
        begin                                                           24666000
                                                                        24668000
          << Build the job end record >>                                24670000
                                                                        24672000
          b08'build'header( o'r'control,                                24674000
                            lgl'end'job,                                24676000
                            , << no data'type used >>          <<04422>>24678000
                            set'bit, << sob'flag >>            <<04422>>24680000
                            set'bit  << eob'flag >>    );      <<04422>>24682000
                                                                        24684000
                                                                        24686000
          << Send the completed record to the device >>                 24688000
                                                                        24690000
          return'status := cpr'send'record(cb'info,                     24692000
                                           o'r'control);                24694000
                                                                        24696000
                                                                        24698000
          << If the job end was successfully sent, wait for >>          24700000
          << the job report to come in.                     >>          24702000
                                                                        24704000
          if return'status.general = successful then                    24706000
            begin                                                       24708000
                                                                        24710000
              << Initialize the input record pointer >>                 24712000
                                                                        24714000
              @i'r'control := cb'info(i'r'base)                         24716000
                            + cb'info(cds'area'base);                   24718000
                                                                        24720000
                                                                        24722000
              << Wait for the report to come in >>                      24724000
                                                                        24726000
              return'status := cpr'get'record(cb'info,                  24728000
                                              i'r'control,              24730000
                                              lgl'job'report);          24732000
                                                                        24734000
              if return'status.general = successful then                24736000
                                                                        24738000
                << We got a job report.  Move it into the >>            24740000
                << job report status tank, and the caller's >>          24742000
                << buffer, if any.                          >>          24744000
                                                                        24746000
                begin                                                   24748000
                  << Mark the job inactive >>                           24750000
                                                                        24752000
                  cb'info(job'active) := false;                         24754000
                                                                        24756000
                                                                        24758000
                  b08'job'report(cb'info, i'r'control);                 24760000
                                                                        24762000
                  if count <> 0 then                                    24764000
                    begin                                               24766000
                      b08'end'job :=                                    24768000
                        b08'return'job'report(cb'info,                  24770000
                                              dst'num,                  24772000
                                              address,                  24774000
                                              count,                    24776000
                                              false   );                24778000
                    end;                                                24780000
                end;                                                    24782000
                                                                        24784000
            end;                                                        24786000
        end;                                                            24788000
    end;                                                                24790000
                                                                        24792000
                                                                        24794000
end;  << of procedure b08'end'job >>                                    24796000
                                                                        24798000
$PAGE "PROCEDURE:  B08'START'JOB"                                       24800000
double procedure b08'start'job( cb'info, start'of'job'parm );           24802000
                                                                        24804000
  value                         cb'info, start'of'job'parm  ;           24806000
                                                                        24808000
  integer pointer               cb'info                     ;           24810000
                                                                        24812000
  integer                                start'of'job'parm  ;           24814000
                                                                        24816000
  option privileged, uncallable                             ;           24818000
                                                                        24820000
COMMENT                                                                 24822000
                                                                        24824000
                                                                        24826000
  PURPOSE:                                                              24828000
                                                                        24830000
    This procedure will send the START OF JOB command to the            24832000
    peripheral, then clean up any job related information in            24834000
    the control block information area, and finally will set            24836000
    the job active flag true.                                           24838000
                                                                        24840000
                                                                        24842000
  INPUT PARAMETERS:                                                     24844000
                                                                        24846000
    CB'INFO, a pointer to the control block information area,           24848000
      which is the global storage area for the logical driver.          24850000
                                                                        24852000
    START'OF'JOB'PARM, which indicates whether any program-             24854000
      mable features are to be reset or not.  Only the least            24856000
      significant bit carries any meaning, the others are re-           24858000
      served for now.  A value of zero does not reset program-          24860000
      mable features, a value of one does cause a reset.                24862000
                                                                        24864000
                                                                        24866000
  OUTPUT PARAMETERS:                                                    24868000
                                                                        24870000
    B08'START'JOB, which is the completion status of this pro-          24872000
      cedure.  A value of zero is returned if no errors occurred.       24874000
      Other values will be defined as required.                         24876000
                                                                        24878000
                                                                        24880000
  SIDE-EFFECTS:                                                         24882000
                                                                        24884000
    This procedure will cause the modification of certain               24886000
    information contained in the control block information              24888000
    area.  Specifically, the job flag will get set or reset             24890000
    depending on the completion status.  Other information              24892000
    will be modified indirectly, since an output record will            24894000
    be sent to the peripheral.                                          24896000
                                                                        24898000
                                                                        24900000
  SPECIAL CONSIDERATIONS:                                               24902000
                                                                        24904000
    When called, DB must be set to the CIPER data segment.              24906000
                                                                        24908000
                                                                        24910000
  CHANGE HISTORY:                                                       24912000
                                                                        24914000
    As issued.                                                          24916000
                                                                        24918000
                                                                        24920000
;                                                                       24922000
$PAGE "PROCEDURE:  B08'START'JOB -- LOCAL VARIABLES"                    24924000
begin                                                                   24926000
                                                                        24928000
  << DECLARATION OF LOCAL VARIABLES >>                                  24930000
                                                                        24932000
  integer pointer                                                       24934000
                                                                        24936000
    o'r'control                                                         24938000
      << points to output record control area >>                        24940000
                                                                        24942000
   ,output'record                                                       24944000
      << points to output record buffer area >>                         24946000
                                                                        24948000
  ;                                                                     24950000
                                                                        24952000
  double                                                                24954000
                                                                        24956000
    return'info                   = b08'start'job                       24958000
      << Contains completion status and transfer log >>                 24960000
                                                                        24962000
  ;                                                                     24964000
                                                                        24966000
                                                                        24968000
                                                                        24970000
  integer                                                               24972000
                                                                        24974000
    error'parm                    = return'info                         24976000
      << used for completion information from other proc's >>           24978000
                                                                        24980000
   ,transfer'log                  = return'info + 1                     24982000
      << total data count sent to peripheral >>                         24984000
                                                                        24986000
                                                                        24988000
  ;                                                                     24990000
                                                                        24992000
                                                                        24994000
  integer pointer                                                       24996000
                                                                        24998000
    control'table                                                       25000000
      << Control table contains the access mode default >>              25002000
                                                                        25004000
  ;                                                                     25006000
                                                                        25008000
                                                                        25010000
  equate                                                                25012000
                                                                        25014000
    job'start'length              = 1                                   25016000
      << length of job start parameter information >>                   25018000
                                                                        25020000
  ;                                                                     25022000
                                                               <<04472>>25024000
                                                               <<04472>>25026000
  byte pointer                                                 <<04472>>25028000
                                                               <<04472>>25030000
    sequence'1'buffer   := 0                                   <<04472>>25032000
      << Dummy pointer used when calling cpr'xlate >>          <<04472>>25034000
                                                               <<04472>>25036000
   ,sequence'2'buffer   := 0                                   <<04472>>25038000
      << Dummy pointer used when calling cpr'xlate >>          <<04472>>25040000
                                                               <<04472>>25042000
  ;                                                            <<04472>>25044000
$PAGE "PROCEDURE:  B08'START'JOB -- PROCEDURE BODY"                     25046000
  << Set up the default feature access mode.  It is done  >>            25048000
  << At this point just in case something fails; then we  >>            25050000
  << will always end up the the correct mode.             >>            25052000
                                                                        25054000
  cb'info(expanded'features) :=                                         25056000
      cb'info(default'access'mode);                                     25058000
                                                                        25060000
                                                                        25062000
  << Check to see if a job is already active.  If there is, >>          25064000
  << call b08'job'end to complete that job, then start this >>          25066000
  << one.                                                   >>          25068000
                                                                        25070000
  if logical(cb'info(job'active)) then                                  25072000
    begin                                                               25074000
      << There is a job active.  Finish it up. >>                       25076000
                                                                        25078000
      return'info := b08'end'job(cb'info, 0, 0, 0, 0 );                 25080000
                                                                        25082000
      << Check the error'parm >>                                        25084000
                                                                        25086000
      if error'parm <> no'errors then                                   25088000
        begin                                                           25090000
          << Could not finish the last job.  Return an error >>         25092000
                                                                        25094000
          return;                                                       25096000
        end;                                                            25098000
    end;  << of previous job still active >>                            25100000
                                                                        25102000
  << Initialize local variables >>                                      25104000
                                                                        25106000
  @o'r'control := cb'info(o'r'base)                                     25108000
                + cb'info(cds'area'base);                               25110000
  @output'record := o'r'control(start) + @o'r'control;                  25112000
                                                                        25114000
  << Now we can start this job >>                                       25116000
  << First check to see if the output buffer area is free. >>           25118000
                                                                        25120000
  if logical(o'r'control(active)) then                                  25122000
    begin                                                               25124000
      << There was an active output record inbetween jobs. >>           25126000
      << Send it to the peripheral.                        >>           25128000
                                                                        25130000
      error'parm := cpr'send'record(cb'info,o'r'control);               25132000
                                                                        25134000
      << check for errors >>                                            25136000
      if error'parm = no'errors then                                    25138000
        begin                                                           25140000
          << Record was successfully sent.  Mark the record >>          25142000
          << buffer as available.                           >>          25144000
                                                                        25146000
          o'r'control(active) := integer(free);                         25148000
        end                                                             25150000
      else                                                              25152000
        begin                                                           25154000
          << Could not send the record for some reason.  Re- >>         25156000
          << turn the error information.                     >>         25158000
                                                                        25160000
          return;                                                       25162000
        end;                                                            25164000
                                                                        25166000
    end;                                                                25168000
                                                                        25170000
  << We now have a clean output buffer with which to work. >>           25172000
  << Build the job start record and send it to the device. >>           25174000
                                                                        25176000
  b08'build'header( o'r'control,                                        25178000
                    lgl'start'job,                                      25180000
                    , << no data'type used >>                  <<04422>>25182000
                    set'bit, << sob'flag >>                    <<04422>>25184000
                    set'bit  << eob'flag >>   );               <<04422>>25186000
                                                                        25188000
  output'record(parm'byte'1) := start'of'job'parm.bit'15;               25190000
                                                                        25192000
  o'r'control(current'position) :=                                      25194000
      o'r'control(current'position) + job'start'length;                 25196000
                                                                        25198000
  o'r'control(current'length) :=                                        25200000
      o'r'control(current'length) + job'start'length;                   25202000
                                                                        25204000
  error'parm := cpr'send'record(cb'info,o'r'control);                   25206000
                                                                        25208000
  << check the error'parm >>                                            25210000
                                                                        25212000
  if error'parm = no'errors then                                        25214000
    begin                                                               25216000
      << Job start was successful.  Set job active flag. >>             25218000
                                                                        25220000
      cpr'xlate( cb'info(xlate'flags)                          <<04472>>25222000
                ,sequence'1'buffer                             <<04472>>25224000
                ,sequence'2'buffer                             <<04472>>25226000
                ,start'job                                     <<04472>>25228000
                ,0  << parm1 >>                                <<04472>>25230000
                ,0  << parm2 >>                                <<04472>>25232000
                ,0  << byte count >>                           <<04472>>25234000
                ,false << no previous odd buffer address >>    <<04472>>25236000
                ,not logical( cb'info(expanded'features) )     <<04472>>25238000
               );                                              <<04472>>25240000
      cb'info(job'active) := true;                                      25242000
                                                                        25244000
    end                                                                 25246000
  else                                                                  25248000
    begin                                                               25250000
      << Job start failed.  Clear job active flag and  >>               25252000
      << report error condition.                       >>               25254000
                                                                        25256000
      cb'info(job'active) := false;                                     25258000
    end;                                                                25260000
                                                                        25262000
end;  << of b08'job'start >>                                            25264000
                                                                        25266000
$IF X9=ON                                                               25268000
$PAGE "TERMINAL SOFTKEY SETUP PROCEDURE"                                25270000
integer procedure b08'debug'softkeys(cb'info);                          25272000
                                                                        25274000
  value                              cb'info ;                          25276000
                                                                        25278000
  integer pointer                    cb'info ;                          25280000
                                                                        25282000
 option privileged, uncallable;                                         25284000
                                                                        25286000
                                                                        25288000
COMMENT                                                                 25290000
                                                                        25292000
  PURPOSE:                                                              25294000
    This procedure will load the softkeys of a 264X terminal            25296000
    with debug commands useful for observing the contents of            25298000
    critical CIPER data segment areas.  In particular, the              25300000
    softkey assignments are as follows:                                 25302000
                                                                        25304000
    f1 := display q-11,12  (calling parameters to procedures)           25306000
                                                                        25308000
    f2 := display cb'info  (control block information area)             25310000
                                                                        25312000
    f3 := display o'r'base (output record control info)                 25314000
                                                                        25316000
    f4 := display output record buffer for %50 words                    25318000
                                                                        25320000
    f5 := display i'r'base (input record control info)                  25322000
                                                                        25324000
    f6 := display input record buffer for %50 words                     25326000
                                                                        25328000
    f7 := disply ldtx entry for this logical device                     25330000
                                                                        25332000
    f8 := modify ldtx entry for this logical device                     25334000
                                                                        25336000
  INPUTS:                                                               25338000
                                                                        25340000
    CB'INFO, which is the DB relative address of the base of            25342000
      the control block information area of the CIPER dst.              25344000
      This area contains the information required to set up the         25346000
      various softkeys.                                                 25348000
                                                                        25350000
                                                                        25352000
  OUTPUTS:                                                              25354000
                                                                        25356000
    None.                                                               25358000
                                                                        25360000
                                                                        25362000
  SPECIAL CONSIDERATIONS:                                               25364000
                                                                        25366000
    This procedure uses a Q relative array to build the es-             25368000
    cape sequences needed to program the terminal's softkeys.           25370000
    Just before calling the PRINT intrinsic to send each                25372000
    escape sequence, EXCHANGEDB is called to put DB back to             25374000
    the user's stack.  After PRINT returns, DB will be set              25376000
    back to the CIPER dst.  THIS PROCEDURE ASSUMES DB IS SET            25378000
    TO THE CIPER DST UPON ENTRY.                                        25380000
                                                                        25382000
                                                                        25384000
  SIDE-EFFECT:                                                          25386000
                                                                        25388000
    None.                                                               25390000
                                                                        25392000
;                                                                       25394000
                                                                        25396000
begin                                                                   25398000
$PAGE "PROCEDURE:  B08'DEBUG'SOFTKEYS;  LOCAL DECLARATIONS"             25400000
  << DECLARATION OF LOCAL VARIABLES >>                                  25402000
                                                                        25404000
  equate                                                                25406000
                                                                        25408000
    debug'suptype'def             = [8/10,8/0]                          25410000
                                                                        25412000
  ;                                                                     25414000
                                                                        25416000
                                                                        25418000
  integer pointer                                                       25420000
    data'info                                                           25422000
      << used for pointing to various pieces of information >>          25424000
      << inside of the CIPER dst.                           >>          25426000
                                                                        25428000
   ,ldt                                                                 25430000
      << points to the base of the ldt >>                               25432000
                                                                        25434000
   ,sequence'buffer                                                     25436000
      << points to buffer where escape sequences are made >>            25438000
                                                                        25440000
  ;                                                                     25442000
                                                                        25444000
  integer                                                               25446000
                                                                        25448000
    seq'length                                                          25450000
      << total length of escape sequence in bytes >>                    25452000
                                                                        25454000
   ,our'dst                                                             25456000
      << contains the dst number of the CIPER dst. >>                   25458000
                                                                        25460000
   ,our'ldtx                                                            25462000
      << contains the ldtx address of the current ldev. >>              25464000
                                                                        25466000
   ,our'ldev                                                            25468000
      << contains the logical device number of the CIPER  >>            25470000
      << printer we are working on.                       >>            25472000
                                                                        25474000
   ,error'parm                                                          25476000
      << used for error reporting >>                                    25478000
                                                                        25480000
   ,file'number                                                         25482000
      << contains the file number of $stdin >>                          25484000
  ;                                                                     25486000
                                                                        25488000
  array sequence'header(0:3)      = PB :=                               25490000
      %15446,"f2","a8","d "                                             25492000
  ;                                                                     25494000
                                                                        25496000
  byte pointer                                                          25498000
                                                                        25500000
    next'byte                                                           25502000
      << points to next available byte in sequence buffer >>            25504000
                                                                        25506000
   ,b'sequence'buffer                                                   25508000
      << byte array pointing to sequence buffer >>                      25510000
                                                                        25512000
  ;                                                                     25514000
                                                                        25516000
$PAGE "UTILITY DECLARATIONS: TABLE HANDLING"                            25518000
equate                                                                  25520000
       table'entry'data    = 0                                          25522000
      ,table'entry'size    = -1 + table'entry'data                      25524000
      ,table'status        = -1 + table'entry'size                      25526000
      ,table'current'entry = -1 + table'status                          25528000
      ,table'base          = -1 + table'current'entry                   25530000
      ,table'dst           = -1 + table'base                            25532000
      ,table'sir           = -1 + table'dst                             25534000
      ,table'overhead      = -table'sir                                 25536000
;                                                                       25538000
define                                                                  25540000
       table'clean         = table'status).(0:1 #                       25542000
         << GETSIR -> get'entry -> put'entry -> RELSIR >>               25544000
      ,table'auto'sir      = table'status).(1:1 #                       25546000
      ,table'getsir'save   = table'status).(2:2 #                       25548000
      ,table'type          = table'status).(13:3 #                      25550000
;                                                                       25552000
                                                                        25554000
intrinsic                                                               25556000
                                                                        25558000
  fopen                                                                 25560000
 ,fwrite                                                                25562000
 ,fclose                                                                25564000
                                                                        25566000
;                                                                       25568000
                                                                        25570000
  declare'move'from'data'segment;                                       25572000
                                                                        25574000
  declare'move'to'data'segment;                                         25576000
                                                                        25578000
$PAGE "UTILITY SUBROUTINE: OPEN'TABLE"                                  25580000
subroutine open'table(T, dst, base, type, sir, auto'sir);               25582000
value                    dst, base, type, sir, auto'sir ;               25584000
logical pointer       T                                 ;               25586000
integer                  dst, base, type, sir           ;               25588000
logical                                        auto'sir ;               25590000
begin                                                 <<sxit return>>   25592000
<<S relative address:-6,  -5,   -4,   -3,  -2,       -1, -0>>           25594000
                                                                        25596000
COMMENT                                                                 25598000
                                                                        25600000
Purpose:                                                                25602000
                                                                        25604000
Error reporting:                                                        25606000
                                                                        25608000
External references:                                                    25610000
                                                                        25612000
Input:                                                                  25614000
                                                                        25616000
Output:                                                                 25618000
                                                                        25620000
Side effects:                                                           25622000
                                                                        25624000
Special considerations:  Must be called on the user's stack.            25626000
;                                                                       25628000
                                                                        25630000
  <<make some space on the stack directly under the calling             25632000
    parameters for the table'overhead area of table T of size           25634000
    table'overhead.>>                                                   25636000
assemble(lra s-0                                                        25638000
        ;stax                                                           25640000
        ;adds table'overhead <<the amount of space needed>>             25642000
        ;lra s-0  <<destination address>>                               25644000
        ;ldxa  <<source address>>                                       25646000
        ;ldni 7 <<the negative count of the parameter                   25648000
                  list size plus the return address  >>                 25650000
        ;move                                                           25652000
);                                                                      25654000
                                                                        25656000
  <<set the address of the table>>                                      25658000
assemble(lra s-6                                                        25660000
        ;stax                                                           25662000
);                                                                      25664000
@T:=x;                                                                  25666000
                                                                        25668000
  <<initialize the table's control area>>                               25670000
T(table'sir):=sir;                                                      25672000
T(table'dst):=dst;                                                      25674000
T(table'base):=base;                                                    25676000
T(table'current'entry):=0;                                              25678000
                                                                        25680000
  << T(table'status) variable >>                                        25682000
T(table'status) := 0;                                                   25684000
T(table'clean):=true;                                                   25686000
T(table'auto'sir):=auto'sir;                                            25688000
T(table'getsir'save):=0;                                                25690000
T(table'type):=type;                                                    25692000
                                                                        25694000
  << T(table'entry'size) >>                                             25696000
case T(table'type) of                                                   25698000
case'begin                                                              25700000
  << 0 := assume that the entry size is in T(table'entry'size).>>       25702000
  ;                                                                     25704000
  << 1 := MPE I/O tables (LPDT, LDT, LDTX).  The size of the table is   25706000
    the right byte of the first word.>>                                 25708000
  begin                                                                 25710000
  mfds(T(table'entry'size), T(table'dst), T(table'base), 1);            25712000
  T(table'entry'size):=T(table'entry'size).(8:8);                       25714000
  end                                                                   25716000
  ;                                                                     25718000
  << 2 := MPE memory management tables (DST, CST, XCST, PCB).  The      25720000
    size is the second word of the table.>>                             25722000
  mfds(T(table'entry'size), T(table'dst), T(table'base)+1, 1)           25724000
  ;                                                                     25726000
case'end;                                                               25728000
                                                                        25730000
  <<make some space on the stack directly under the calling             25732000
    parameters for the table'entry'data of size                         25734000
    = table(table'entry'size).>>                                        25736000
x:=T(table'entry'size);                                                 25738000
assemble(xax  <<exchange a & x, to put the size increment in s-0 &      25740000
                the return address in x.>>                              25742000
        ;adds 0 <<add the space to the stack.>>                         25744000
        ;ldxa  <<put the return address on the stack.>>                 25746000
);                                                                      25748000
                                                                        25750000
end;  <<open'table>>                                                    25752000
                                                                        25754000
$PAGE "UTILITY SUBROUTINE: PUT'ENTRY"                                   25756000
subroutine put'entry(T);                                                25758000
value                T ;                                                25760000
logical pointer      T ;                                                25762000
begin                                                                   25764000
                                                                        25766000
COMMENT                                                                 25768000
                                                                        25770000
Special considerations:  Must be called on the user's stack.            25772000
;                                                                       25774000
                                                                        25776000
if T(table'clean) then return;                                          25778000
                                                                        25780000
T(table'clean):=true;                                                   25782000
                                                                        25784000
mtds(T(table'dst),                     <<target'dseg'num>>              25786000
                                                                        25788000
     logical(integer(T(table'base)) +  <<target'offset>>                25790000
     integer(T(table'entry'size)) *                                     25792000
     integer(T(table'current'entry))),                                  25794000
                                                                        25796000
     T,                                <<source>>                       25798000
                                                                        25800000
     T(table'entry'size)               <<word'cnt>> );                  25802000
                                                                        25804000
if T(table'auto'sir) then                                               25806000
  relsir(T(table'sir), T(table'getsir'save));                           25808000
                                                                        25810000
end;  <<put'entry>>                                                     25812000
                                                                        25814000
$PAGE "UTILITY SUBROUTINE: GET'ENTRY"                                   25816000
subroutine get'entry(T, index);                                         25818000
value                T, index ;                                         25820000
logical pointer      T        ;                                         25822000
integer                 index ;                                         25824000
begin                                                                   25826000
                                                                        25828000
COMMENT                                                                 25830000
                                                                        25832000
Special considerations:  Must be called on the user's stack.            25834000
;                                                                       25836000
                                                                        25838000
if not T(table'clean) then put'entry(T);                                25840000
                                                                        25842000
if T(table'auto'sir) then                                               25844000
  T(table'getsir'save):=getsir(T(table'sir));                           25846000
                                                                        25848000
mfds(T,                                <<target>>                       25850000
                                                                        25852000
     T(table'dst),                     <<source'dseg'num>>              25854000
                                                                        25856000
     logical(integer(T(table'base)) +  <<source'offset>>                25858000
     integer(T(table'entry'size)) *                                     25860000
     index),                                                            25862000
                                                                        25864000
     T(table'entry'size)               <<word'cnt>>);                   25866000
                                                                        25868000
T(table'current'entry):=index;                                          25870000
T(table'clean):=false;                                                  25872000
                                                                        25874000
end;  <<get'entry>>                                                     25876000
$PAGE "PROCEDURE:  B08'DEBUG'SOFTKEYS;  PROCEDURE BODY"                 25878000
  << Start of procedure body >>                                         25880000
                                                                        25882000
  << Pull out our logical device number before switching >>             25884000
  << to the caller's stack.                              >>             25886000
                                                                        25888000
  our'ldev := cb'info(logical'device);                                  25890000
                                                                        25892000
  << Switch to the caller's stack, perform an fopen on >>               25894000
  << $stdlist.  If that doesn't work, switch back to the >>             25896000
  << CIPER dst and return with an error.  If it does   >>               25898000
  << work, get the head entry of the ldt to and com-   >>               25900000
  << pute where our ldtx entry is located.  Then go    >>               25902000
  << back to the CIPER dst.                            >>               25904000
                                                                        25906000
  our'dst := exchangedb(0);                                             25908000
  file'number := fopen(,%217,%301);                                     25910000
  if <> then                                                            25912000
    begin                                                               25914000
      exchangedb(our'dst);                                              25916000
      b08'debug'softkeys := 2;                                          25918000
      return;                                                           25920000
    end;                                                                25922000
  open'table(ldt, ldt'dst, 0 <<base>>, 1 <<type>>, ldt'sir, false);     25924000
  get'entry(ldt, 0);                                                    25926000
  our'ldtx := ldt(ldt0'ptr'1st'dct'ent) + ldt(ldt0'dct'size)            25928000
            + ( our'ldev * ldt(ldt0'ent'size) );                        25930000
  exchangedb(our'dst);                                                  25932000
                                                                        25934000
  << Set up the address in b'sequence'buffer to point >>                25936000
  << to the sequence buffer area.                     >>                25938000
                                                                        25940000
  @sequence'buffer := cpr'get'2ndary'cds'area(40,debug'suptype'def      25942000
                                       lor 7,0);                        25944000
  @b'sequence'buffer := @sequence'buffer to'byte;                       25946000
                                                                        25948000
  move sequence'buffer := sequence'header,(4);                          25950000
                                                                        25952000
                                                                        25954000
  << set up for softkey 1 >>                                            25956000
                                                                        25958000
  move b'sequence'buffer(8) := "1k 8LL4 parmsdq-11,12",2;               25960000
  @next'byte := tos;                                                    25962000
  seq'length := @next'byte - @b'sequence'buffer;                        25964000
  fwrite(file'number,sequence'buffer,-seq'length,0);                    25966000
                                                                        25968000
  << set up for softkey 2 >>                                            25970000
                                                                        25972000
  if = then                                                             25974000
    begin                                                               25976000
      move b'sequence'buffer(8) := "2k 23Lcb'info dda",2;               25978000
      @next'byte := tos;                                                25980000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        25982000
      next'byte := "+";                                                 25984000
      @next'byte := b08'ascii(@cb'info,8,next'byte(1))                  25986000
          + @next'byte + 1;                                             25988000
      next'byte := ",";                                                 25990000
      @next'byte := b08'ascii(cb'info'size,8,next'byte(1))              25992000
                  + @next'byte + 1;                                     25994000
      seq'length := @next'byte - @b'sequence'buffer;                    25996000
      fwrite(file'number,sequence'buffer,-seq'length,0);                25998000
    end;                                                                26000000
                                                                        26002000
                                                                        26004000
  << set up for softkey 3 >>                                            26006000
                                                                        26008000
  if = then                                                             26010000
    begin                                                               26012000
      @data'info := cb'info(o'r'base) + cb'info(cds'area'base);         26014000
      move b'sequence'buffer(8) := "3k 19Lo'r'basedda",2;               26016000
      @next'byte := tos;                                                26018000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        26020000
      next'byte := "+";                                                 26022000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                26024000
          + @next'byte + 1;                                             26026000
      move next'byte := ",10",2;                                        26028000
      @next'byte := tos;                                                26030000
      seq'length := @next'byte - @b'sequence'buffer;                    26032000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26034000
    end;                                                                26036000
                                                                        26038000
                                                                        26040000
  << set up for softkey 4 >>                                            26042000
                                                                        26044000
  if = then                                                             26046000
    begin                                                               26048000
      @data'info := @data'info + data'info(start);                      26050000
      move b'sequence'buffer(8) := "4k 19Lo bufferdda",2;               26052000
      @next'byte := tos;                                                26054000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        26056000
      next'byte := "+";                                                 26058000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                26060000
          + @next'byte + 1;                                             26062000
      move next'byte := ",50",2;                                        26064000
      @next'byte := tos;                                                26066000
      seq'length := @next'byte - @b'sequence'buffer;                    26068000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26070000
    end;                                                                26072000
                                                                        26074000
                                                                        26076000
  << set up for softkey 5 >>                                            26078000
                                                                        26080000
  if = then                                                             26082000
    begin                                                               26084000
      @data'info := cb'info(i'r'base) + cb'info(cds'area'base);         26086000
      move b'sequence'buffer(8) := "5k 19Li'r'basedda",2;               26088000
      @next'byte := tos;                                                26090000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        26092000
      next'byte := "+";                                                 26094000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                26096000
          + @next'byte + 1;                                             26098000
      move next'byte := ",10",2;                                        26100000
      @next'byte := tos;                                                26102000
      seq'length := @next'byte - @b'sequence'buffer;                    26104000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26106000
    end;                                                                26108000
                                                                        26110000
                                                                        26112000
  << set up for softkey 6 >>                                            26114000
                                                                        26116000
  if = then                                                             26118000
    begin                                                               26120000
      @data'info := @data'info + data'info(start);                      26122000
      move b'sequence'buffer(8) := "6k 19Li bufferdda",2;               26124000
      @next'byte := tos;                                                26126000
      @next'byte := b08'ascii(our'dst,8,next'byte) + @next'byte;        26128000
      next'byte := "+";                                                 26130000
      @next'byte := b08'ascii(@data'info,8,next'byte(1))                26132000
          + @next'byte + 1;                                             26134000
      move next'byte := ",50",2;                                        26136000
      @next'byte := tos;                                                26138000
      seq'length := @next'byte - @b'sequence'buffer;                    26140000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26142000
    end;                                                                26144000
                                                                        26146000
                                                                        26148000
  << set up for the last two softkeys >>                                26150000
                                                                        26152000
                                                                        26154000
  << set up for softkey 7 >>                                            26156000
                                                                        26158000
  if = then                                                             26160000
    begin                                                               26162000
      move b'sequence'buffer(8) := "7k 14Lsee ldtxdda16+",2;            26164000
      @next'byte := tos;                                                26166000
      @next'byte := b08'ascii(our'ldtx,8,next'byte) + @next'byte;       26168000
      move next'byte := ",5",2;                                         26170000
      @next'byte := tos;                                                26172000
      seq'length := @next'byte - @b'sequence'buffer;                    26174000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26176000
    end;                                                                26178000
                                                                        26180000
                                                                        26182000
  << set up for softkey 8 >>                                            26184000
                                                                        26186000
  if = then                                                             26188000
    begin                                                               26190000
      b'sequence'buffer(8) := "8";                                      26192000
      move b'sequence'buffer(14) := "fix";                              26194000
      b'sequence'buffer(22) := "m";                                     26196000
      fwrite(file'number,sequence'buffer,-seq'length,0);                26198000
    end;                                                                26200000
                                                                        26202000
                                                                        26204000
  << all done (for better or worse) so try to close the >>              26206000
  << terminal file.                                     >>              26208000
                                                                        26210000
  cpr'rel'cds'area(sequence'buffer);                                    26212000
                                                                        26214000
                                                                        26216000
  fclose(file'number,0,0);                                              26218000
  if = then                                                             26220000
    b08'debug'softkeys := 1                                             26222000
  else                                                                  26224000
    b08'debug'softkeys := 4                                             26226000
  ;                                                                     26228000
                                                                        26230000
                                                                        26232000
end;  << procedure b08'debug'softkeys >>                                26234000
$IF                                                                     26236000
                                                                        26238000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS"                               26240000
double procedure b08'buf'device'status( cb'info, dst'num,               26242000
                                        address, count,                 26244000
                                        status'type'flag    );          26246000
                                                                        26248000
  value                                 cb'info, dst'num,               26250000
                                        address, count,                 26252000
                                        status'type'flag     ;          26254000
                                                                        26256000
  integer pointer                       cb'info             ;           26258000
                                                                        26260000
  integer                                        dst'num,               26262000
                                        address, count      ;           26264000
                                                                        26266000
  logical                               status'type'flag     ;          26268000
                                                                        26270000
  option privileged, uncallable                             ;           26272000
                                                                        26274000
                                                                        26276000
                                                                        26278000
COMMENT                                                                 26280000
                                                                        26282000
  PURPOSE:                                                              26284000
                                                                        26286000
    This procedure will move the contents of the device status          26288000
    area to a user buffer specified by the calling parameters.          26290000
    Normally, the existing copy of status will be returned,             26292000
    but if the caller specifies, a new copy will be obtained            26294000
    from the device before returning to the caller.                     26296000
                                                                        26298000
  INPUTS:                                                               26300000
                                                                        26302000
    CB'INFO, a pointer to the control block information area            26304000
      for this ldev's level 7.                                          26306000
                                                                        26308000
    DST'NUM, the index of the data segment to which the en-             26310000
      vironmental status information will be moved.                     26312000
                                                                        26314000
    ADDRESS, the offset within dst'num where the data will be           26316000
      moved to.                                                         26318000
                                                                        26320000
    COUNT, the number of bytes/words to be moved.  If count is          26322000
      negative, then it is a byte count.  If it is positive,            26324000
      it is a word count.                                               26326000
                                                                        26328000
    STATUS'TYPE'FLAG, which indicates whether the caller                26330000
      wants the last status obtained (0), a new copy (1), or            26332000
      the composite copy obtained from the last call (2).               26334000
                                                                        26336000
                                                                        26338000
  OUTPUTS:                                                              26340000
                                                                        26342000
    B08'BUF'DEVICE'STATUS, a double word function return,               26344000
      contains the completion status for the call in the most           26346000
      significant word, and the transfer log in the least sig-          26348000
      nificant word.  The transfer log maintains the same               26350000
      sense as the input count parameter.                               26352000
                                                                        26354000
  SIDE-EFFECTS:                                                         26356000
                                                                        26358000
    None.                                                               26360000
                                                                        26362000
  SPECIAL CONSIDERATIONS:                                               26364000
                                                                        26366000
    When called, DB should be set to the base of the CIPER              26368000
    data segment.                                                       26370000
                                                                        26372000
                                                                        26374000
  CHANGE HISTORY:                                                       26376000
                                                                        26378000
                                                                        26380000
                                                                        26382000
;                                                                       26384000
                                                                        26386000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS -- LOCAL DECLARATIONS"         26388000
begin                                                                   26390000
                                                                        26392000
  << Declaration of local variables >>                                  26394000
                                                                        26396000
  integer pointer                                                       26398000
                                                                        26400000
    dev'status'info                                                     26402000
      << points to base of environmental status information >>          26404000
                                                                        26406000
  ;                                                                     26408000
                                                                        26410000
                                                                        26412000
  logical                                                               26414000
                                                                        26416000
    count'was'negative                                                  26418000
      << flag that transfer log must be converted to bytes >>           26420000
                                                                        26422000
  ;                                                                     26424000
                                                                        26426000
                                                                        26428000
  double                                                                26430000
                                                                        26432000
    return'information            = b08'buf'device'status               26434000
                                                                        26436000
  ;                                                                     26438000
                                                                        26440000
                                                                        26442000
  integer                                                               26444000
                                                                        26446000
    return'status                  = b08'buf'device'status              26448000
      << completion status of the call >>                               26450000
                                                                        26452000
   ,transfer'log                  = b08'buf'device'status + 1           26454000
      << byte/word count of data transferred to user >>                 26456000
                                                                        26458000
  ;                                                                     26460000
                                                                        26462000
                                                                        26464000
  integer pointer                                                       26466000
                                                                        26468000
    i'o'control                                                         26470000
      << points to control portion of record buffer area, >>            26472000
      << if one is allocated to request and receive a new >>            26474000
      << copy of the environmental status block.          >>            26476000
                                                                        26478000
  ;                                                                     26480000
                                                                        26482000
                                                                        26484000
  << Valid values for status'type'flag: >>                              26486000
                                                                        26488000
  equate                                                                26490000
                                                                        26492000
    buffered                      = 0                                   26494000
      << Requests whatever status is buffered >>                        26496000
                                                                        26498000
   ,immediate                     = 1                                   26500000
      << Requests a new copy from the device >>                         26502000
                                                                        26504000
   ,composite                     = 2                                   26506000
      << Requests the composite copy >>                                 26508000
                                                                        26510000
  ;                                                                     26512000
                                                                        26514000
  declare'move'to'data'segment;                                         26516000
$PAGE "PROCEDURE:  B08'BUF'DEVICE'STATUS -- PROCEDURE BODY"             26518000
  << If the caller requested a new copy of the environmental >>         26520000
  << status, allocate a record buffer, build the request,    >>         26522000
  << and get the reply back.                                 >>         26524000
                                                                        26526000
  if status'type'flag then                                              26528000
    begin                                                               26530000
                                                                        26532000
      @i'o'control := b08'get'buffer( cb'info, no'overwrite );          26534000
      if @i'o'control = nil then                                        26536000
        begin                                                           26538000
          return'status := fatal'error;                                 26540000
          return;                                                       26542000
        end;                                                            26544000
                                                                        26546000
      b08'build'header( i'o'control,                                    26548000
                        lgl'report'status,                              26550000
                       , << no data'type used >>               <<04422>>26552000
                       set'bit, << sob'flag >>                 <<04422>>26554000
                       set'bit  << eob'flag >>    );           <<04422>>26556000
                                                                        26558000
      return'status := cpr'send'record( cb'info,                        26560000
                                        i'o'control );                  26562000
                                                                        26564000
      if return'status.general <> successful then                       26566000
        begin                                                           26568000
          b08'release'buffer(cb'info, i'o'control);                     26570000
          return;                                                       26572000
        end;                                                            26574000
                                                                        26576000
      return'status := cpr'get'record( cb'info,                         26578000
                                       i'o'control,                     26580000
                                       lgl'status'report );             26582000
                                                                        26584000
      if return'status.general <> successful then                       26586000
        begin                                                           26588000
          b08'release'buffer(cb'info, i'o'control);                     26590000
          return;                                                       26592000
        end;                                                            26594000
                                                                        26596000
      b08'device'status( cb'info, i'o'control );                        26598000
                                                                        26600000
      b08'release'buffer(cb'info, i'o'control);                         26602000
                                                                        26604000
    end;  << of if status'type'flag >>                                  26606000
                                                                        26608000
                                                                        26610000
  << Initialize the pointer to the status info >>                       26612000
                                                                        26614000
  if status'type'flag = composite then                                  26616000
    begin                                                               26618000
      @dev'status'info := cb'info(composite'status'base)                26620000
                        + cb'info(cds'area'base);                       26622000
    end                                                                 26624000
  else                                                                  26626000
    begin                                                               26628000
      @dev'status'info := cb'info(dev'status'base)                      26630000
                        + cb'info(cds'area'base);                       26632000
  end;                                                                  26634000
                                                                        26636000
                                                                        26638000
  << First, make count into a word count if it is not >>                26640000
                                                                        26642000
  if count < 0 then                                                     26644000
    begin                                                               26646000
      count := (-count) to'word;                                        26648000
      count'was'negative := true;                                       26650000
    end                                                                 26652000
  else                                                                  26654000
    begin                                                               26656000
      count'was'negative := false;                                      26658000
    end;                                                                26660000
                                                                        26662000
                                                                        26664000
  << Now determine if the count is large enough to move all >>          26666000
  << of the status, or just a part of it.                   >>          26668000
                                                                        26670000
  if count > device'status'length to'word then                          26672000
    begin                                                               26674000
      count := device'status'length to'word;                            26676000
    end;                                                                26678000
                                                                        26680000
                                                                        26682000
  << Move the data to the user's dst >>                                 26684000
                                                                        26686000
  if count > 0 then                                            <<04434>>26688000
    begin                                                      <<04434>>26690000
      mtds(dst'num,address,dev'status'info,count);             <<04434>>26692000
    end;                                                       <<04434>>26694000
                                                                        26696000
                                                                        26698000
  << Adjust the transfer log count >>                                   26700000
                                                                        26702000
  if count'was'negative then                                            26704000
    begin                                                               26706000
      transfer'log := -(count to'byte);                                 26708000
    end                                                                 26710000
  else                                                                  26712000
    begin                                                               26714000
      transfer'log := count;                                            26716000
    end;                                                                26718000
                                                                        26720000
                                                                        26722000
  << Since we are returning the current available status, >>            26724000
  << clear the status'received and status'reported bits   >>            26726000
  << in cb'info.                                          >>            26728000
                                                                        26730000
  cb'info(status'received).dev'stat'bit := clear'bit;                   26732000
  cb'info(status'reported).dev'stat'bit := clear'bit;                   26734000
                                                                        26736000
  if status'type'flag = composite then                                  26738000
    begin                                                               26740000
      b08'clean'comp'status( cb'info );                                 26742000
    end;                                                                26744000
                                                                        26746000
                                                                        26748000
  << Set the completion code >>                                         26750000
                                                                        26752000
  return'status := no'errors;                                           26754000
                                                                        26756000
end;  << of procedure b08'buf'device'status >>                          26758000
                                                                        26760000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS"                             26762000
double procedure b08'buffered'env'status(cb'info, dst'num,              26764000
                                         address, count,                26766000
                                         new'status'flag    );          26768000
                                                                        26770000
  value                                  cb'info, dst'num,              26772000
                                         address, count,                26774000
                                         new'status'flag     ;          26776000
                                                                        26778000
  integer pointer                        cb'info             ;          26780000
                                                                        26782000
  integer                                         dst'num,              26784000
                                         address, count      ;          26786000
                                                                        26788000
  logical                                new'status'flag     ;          26790000
                                                                        26792000
  option privileged, uncallable                              ;          26794000
                                                                        26796000
                                                                        26798000
                                                                        26800000
COMMENT                                                                 26802000
                                                                        26804000
  PURPOSE:                                                              26806000
                                                                        26808000
    This procedure will move the contents of the device en-             26810000
    vironmental status area to a user buffer specified by the           26812000
    calling parameters.  Typically no new status will be re-            26814000
    quested from the peripheral, but if new'status'flag is non          26816000
    zero, then a fresh copy of the status will be obtained.             26818000
                                                                        26820000
                                                                        26822000
  INPUT PARAMETERS:                                                     26824000
                                                                        26826000
    CB'INFO, a pointer to the control block information area            26828000
      for this ldev's level 7.                                          26830000
                                                                        26832000
    DST'NUM, the index of the data segment to which the en-             26834000
      vironmental status information will be moved.                     26836000
                                                                        26838000
    ADDRESS, the offset within dst'num where the data will be           26840000
      moved to.                                                         26842000
                                                                        26844000
    COUNT, the number of bytes/words to be moved.  If count is          26846000
      negative, then it is a byte count.  If it is positive,            26848000
      it is a word count.                                               26850000
                                                                        26852000
    NEW'STATUS'FLAG, which indicates whether the caller wants           26854000
      the last status obtained (false) or a new copy (true).            26856000
                                                                        26858000
                                                                        26860000
  OUTPUT PARAMETERS:                                                    26862000
                                                                        26864000
    B08'BUFFERED'ENV'STATUS, a double word function return,             26866000
      contains the completion status for the call in the most           26868000
      significant word, and the transfer log in the least sig-          26870000
      nificant word.  The transfer log maintains the same               26872000
      sense as the input count parameter.                               26874000
                                                                        26876000
                                                                        26878000
  SIDE-EFFECTS:                                                         26880000
    None.                                                               26882000
                                                                        26884000
                                                                        26886000
                                                                        26888000
  SPECIAL CONSIDERATIONS:                                               26890000
                                                                        26892000
    When called, DB should be set to the base of the CIPER              26894000
    data segment.                                                       26896000
                                                                        26898000
                                                                        26900000
  CHANGE HISTORY:                                                       26902000
                                                                        26904000
                                                                        26906000
                                                                        26908000
;                                                                       26910000
                                                                        26912000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS -- LOCAL DECLARATIONS"       26914000
begin                                                                   26916000
                                                                        26918000
  << Declaration of local variables >>                                  26920000
                                                                        26922000
  integer pointer                                                       26924000
                                                                        26926000
    env'status'info                                                     26928000
      << points to base of environmental status information >>          26930000
                                                                        26932000
  ;                                                                     26934000
                                                                        26936000
                                                                        26938000
  logical                                                               26940000
                                                                        26942000
    count'was'negative                                                  26944000
      << flag that transfer log must be converted to bytes >>           26946000
                                                                        26948000
  ;                                                                     26950000
                                                                        26952000
                                                                        26954000
  double                                                                26956000
                                                                        26958000
    return'information            = b08'buffered'env'status             26960000
                                                                        26962000
  ;                                                                     26964000
                                                                        26966000
                                                                        26968000
  integer                                                               26970000
                                                                        26972000
    return'status                  = b08'buffered'env'status            26974000
      << completion status of the call >>                               26976000
                                                                        26978000
   ,transfer'log                  = b08'buffered'env'status + 1         26980000
      << byte/word count of data transferred to user >>                 26982000
                                                                        26984000
  ;                                                                     26986000
                                                                        26988000
                                                                        26990000
  integer pointer                                                       26992000
                                                                        26994000
    i'o'control                                                         26996000
      << points to control portion of record buffer area, >>            26998000
      << if one is allocated to request and receive a new >>            27000000
      << copy of the environmental status block.          >>            27002000
                                                                        27004000
  ;                                                                     27006000
                                                                        27008000
  declare'move'to'data'segment;                                         27010000
$PAGE "PROCEDURE:  B08'BUFFERED'ENV'STATUS -- PROCEDURE BODY"           27012000
  << If the caller requested a new copy of the environmental >>         27014000
  << status, allocate a record buffer, build the request,    >>         27016000
  << and get the reply back.                                 >>         27018000
                                                                        27020000
  if new'status'flag then                                               27022000
    begin                                                               27024000
                                                                        27026000
      @i'o'control := b08'get'buffer( cb'info, no'overwrite );          27028000
      if @i'o'control = nil then                                        27030000
        begin                                                           27032000
          return'status := fatal'error;                                 27034000
          return;                                                       27036000
        end;                                                            27038000
                                                                        27040000
      b08'build'header( i'o'control,                                    27042000
                        lgl'report'esb,                                 27044000
                        , << no data'type used >>              <<04422>>27046000
                        set'bit, << sob'flag >>                <<04422>>27048000
                        set'bit  << eob'flag >>   );           <<04422>>27050000
                                                                        27052000
      return'status := cpr'send'record( cb'info,                        27054000
                                        i'o'control );                  27056000
                                                                        27058000
      if return'status.general <> successful then                       27060000
        begin                                                           27062000
          b08'release'buffer(cb'info, i'o'control);                     27064000
          return;                                                       27066000
        end;                                                            27068000
                                                                        27070000
      return'status := cpr'get'record( cb'info,                         27072000
                                       i'o'control,                     27074000
                                       lgl'esb'report );                27076000
                                                                        27078000
      if return'status.general <> successful then                       27080000
        begin                                                           27082000
          b08'release'buffer(cb'info, i'o'control);                     27084000
          return;                                                       27086000
        end;                                                            27088000
                                                                        27090000
      b08'env'status( cb'info, i'o'control );                           27092000
                                                                        27094000
      b08'release'buffer(cb'info, i'o'control);                         27096000
                                                                        27098000
    end;  << of if new'status'flag >>                                   27100000
                                                                        27102000
                                                                        27104000
  << Initialize the pointer to the status info >>                       27106000
                                                                        27108000
  @env'status'info := cb'info(env'status'base)                          27110000
                    + cb'info(cds'area'base);                           27112000
                                                                        27114000
                                                                        27116000
  << First, make count into a word count if it is not >>                27118000
                                                                        27120000
  if count < 0 then                                                     27122000
    begin                                                               27124000
      count := (-count) to'word;                                        27126000
      count'was'negative := true;                                       27128000
    end                                                                 27130000
  else                                                                  27132000
    begin                                                               27134000
      count'was'negative := false;                                      27136000
    end;                                                                27138000
                                                                        27140000
                                                                        27142000
  << Now determine if the count is large enough to move all >>          27144000
  << of the status, or just a part of it.                   >>          27146000
                                                                        27148000
  if count > (cb'info(device'env'status'size) to'word) then             27150000
    begin                                                               27152000
      count := cb'info(device'env'status'size) to'word;                 27154000
    end;                                                                27156000
                                                                        27158000
                                                                        27160000
  << Move the data to the user's dst >>                                 27162000
                                                                        27164000
  if count > 0 then                                            <<04434>>27166000
    begin                                                      <<04434>>27168000
      mtds(dst'num,address,env'status'info,count);             <<04434>>27170000
    end;                                                       <<04434>>27172000
                                                                        27174000
                                                                        27176000
  << Adjust the transfer log count >>                                   27178000
                                                                        27180000
  if count'was'negative then                                            27182000
    begin                                                               27184000
      transfer'log := -(count to'byte);                                 27186000
    end                                                                 27188000
  else                                                                  27190000
    begin                                                               27192000
      transfer'log := count;                                            27194000
    end;                                                                27196000
                                                                        27198000
                                                                        27200000
  << Since we are returning the current available status, >>            27202000
  << clear the status'received and status'reported bits   >>            27204000
  << in cb'info.                                          >>            27206000
                                                                        27208000
  cb'info(status'received).env'stat'bit := clear'bit;                   27210000
  cb'info(status'reported).env'stat'bit := clear'bit;                   27212000
                                                                        27214000
                                                                        27216000
  << Set the completion code >>                                         27218000
                                                                        27220000
  return'status := no'errors;                                           27222000
                                                                        27224000
end;  << of procedure b08'buffered'env'status >>                        27226000
                                                                        27228000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS"                                27230000
double procedure b08'available'status(cb'info, dst'num,                 27232000
                                      address, count    );              27234000
                                                                        27236000
  value                               cb'info, dst'num,                 27238000
                                      address, count     ;              27240000
                                                                        27242000
  integer pointer                     cb'info            ;              27244000
                                                                        27246000
  integer                                      dst'num,                 27248000
                                      address, count     ;              27250000
                                                                        27252000
  option privileged, uncallable                          ;              27254000
                                                                        27256000
                                                                        27258000
                                                                        27260000
COMMENT                                                                 27262000
                                                                        27264000
  PURPOSE:                                                              27266000
                                                                        27268000
    This procedure will move the status'received word of                27270000
    cb'info to an array provided by the caller.  This word is           27272000
    a bit map indicating which types of status have been re-            27274000
    ceived by the logical driver and are available for the              27276000
    caller to read.                                                     27278000
                                                                        27280000
                                                                        27282000
  INPUT PARAMETERS:                                                     27284000
                                                                        27286000
    CB'INFO, which points to the control block information              27288000
      area of the logical driver.  This area contains the               27290000
      status'received word, along with other global informa-            27292000
      tion of the logical driver.                                       27294000
                                                                        27296000
    DST'NUM, a data segment number where the destination array          27298000
      is located.  This array must be at least one word long            27300000
      (a longer array would provide future expandibility and            27302000
      is recommended).                                                  27304000
                                                                        27306000
    ADDRESS, the offset within the target data segment where            27308000
      the destination array begins.                                     27310000
                                                                        27312000
    COUNT, the number of words (if positive) or bytes (if neg-          27314000
      ative) to move from the CIPER data segment to the                 27316000
      caller's data segment.  This must be at least one word            27318000
      or an error return will be made and no data will be               27320000
      moved.                                                            27322000
                                                                        27324000
                                                                        27326000
  OUTPUT PARAMETERS:                                                    27328000
                                                                        27330000
    B08'AVAILABLE'STATUS, which is a double word                        27332000
      function return.  Word 0 of this return is the comple-            27334000
      tion status of the call.  Word 1 is the transfer log,             27336000
      returned in the same sense as the input parameter count           27338000
      (+ for words, - for bytes).                                       27340000
                                                                        27342000
                                                                        27344000
  SIDE-EFFECTS:                                                         27346000
                                                                        27348000
    None.                                                               27350000
                                                                        27352000
                                                                        27354000
  SPECIAL CONSIDERATIONS:                                               27356000
                                                                        27358000
    None.                                                               27360000
                                                                        27362000
                                                                        27364000
  CHANGE HISTORY:                                                       27366000
                                                                        27368000
    As issued.                                                          27370000
                                                                        27372000
                                                                        27374000
;                                                                       27376000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS -- LOCAL VARIABLES"             27378000
begin                                                                   27380000
                                                                        27382000
  << Function return sub-parameters: >>                                 27384000
                                                                        27386000
  double                                                                27388000
                                                                        27390000
    return'information            = b08'available'status                27392000
                                                                        27394000
  ;                                                                     27396000
                                                                        27398000
                                                                        27400000
  integer                                                               27402000
                                                                        27404000
    return'status                 = b08'available'status                27406000
      << Completion status for call >>                                  27408000
                                                                        27410000
   ,transfer'log                  = b08'available'status + 1            27412000
      << Count of data moved to caller >>                               27414000
                                                                        27416000
  ;                                                                     27418000
                                                                        27420000
                                                                        27422000
  declare'move'to'data'segment;                                         27424000
$PAGE "PROCEDURE:  B08'AVAILABLE'STATUS -- PROCEDURE BODY"              27426000
                                                                        27428000
  << If the caller did not give us enough room - at least >>            27430000
  << one word -- return with an invalid request status.   >>            27432000
                                                                        27434000
  if -1 <= count <= 0 then                                              27436000
    begin                                                               27438000
      return'status := invalid'request;                                 27440000
      transfer'log := 0;                                                27442000
    end                                                                 27444000
  else                                                                  27446000
    begin                                                               27448000
      mtds(dst'num, address, cb'info(status'received), 1);              27450000
      return'status := successful;                                      27452000
      transfer'log := if count < 0 then -2 else 1;                      27454000
    end;                                                                27456000
                                                                        27458000
end;  << of procedure b08'available'status >>                           27460000
                                                                        27462000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE"                                    27464000
double procedure b08'device'close(cb'info);                             27466000
                                                                        27468000
  value                           cb'info ;                             27470000
                                                                        27472000
  integer pointer                 cb'info ;                             27474000
                                                                        27476000
  option privileged, uncallable           ;                             27478000
                                                                        27480000
                                                                        27482000
                                                                        27484000
COMMENT                                                                 27486000
                                                                        27488000
  PURPOSE:                                                              27490000
                                                                        27492000
    This procedure will tidy up all device processing prior             27494000
    to deallocating the device.  This includes such things as           27496000
    sending all pending record buffers, ending any active jobs,         27498000
    processing incoming status, etc.  When all data transfers           27500000
    are complete, the transport service will be close with a            27502000
    transport'deallocate command.                                       27504000
                                                                        27506000
                                                                        27508000
  INPUT PARAMETERS:                                                     27510000
                                                                        27512000
    CB'INFO, which points to the Level 7 control block infor-           27514000
      mation area of the appropriate logical device.                    27516000
                                                                        27518000
                                                                        27520000
  OUTPUT PARAMETERS:                                                    27522000
                                                                        27524000
    B08'DEVICE'CLOSE, which is a double word function return.           27526000
      Word 0 is the completion status of the call.                      27528000
      Word 1 is the transfer log of data moved from the caller          27530000
      to the device (currently always zero).                            27532000
                                                                        27534000
                                                                        27536000
  SIDE-EFFECTS:                                                         27538000
                                                                        27540000
    All intra-job information will be set to an initial state.          27542000
                                                                        27544000
                                                                        27546000
  SPECIAL CONSIDERATIONS:                                               27548000
                                                                        27550000
    When called, DB must be set to the base of the CIPER data           27552000
    segment.                                                            27554000
                                                                        27556000
                                                                        27558000
  CHANGE HISTORY:                                                       27560000
                                                                        27562000
    As issued.                                                          27564000
                                                                        27566000
;                                                                       27568000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE -- LOCAL VARIABLES"                 27570000
begin                                                                   27572000
                                                                        27574000
  << Completion status sub-parameters >>                                27576000
                                                                        27578000
  double                                                                27580000
                                                                        27582000
    return'information            = b08'device'close                    27584000
                                                                        27586000
  ;                                                                     27588000
                                                                        27590000
                                                                        27592000
  integer                                                               27594000
                                                                        27596000
    return'status                 = b08'device'close                    27598000
      << Contains completion code for call >>                           27600000
                                                                        27602000
   ,transfer'log                  = b08'device'close + 1                27604000
      << Total count of user data moved >>                              27606000
                                                                        27608000
  ;                                                                     27610000
                                                                        27612000
                                                                        27614000
  integer pointer                                                       27616000
                                                                        27618000
    o'r'control                                                         27620000
      << pointer to control portion of record buffer area >>            27622000
                                                                        27624000
   ,control'table                                                       27626000
      << pointer to control table for this ldev >>                      27628000
                                                                        27630000
  ;                                                                     27632000
$PAGE "PROCEDURE:  B08'DEVICE'CLOSE -- PROCEDURE BODY"                  27634000
  << First, buffer up the escape sequence for the device >>             27636000
  << close command (conditional top of form).            >>             27638000
                                                                        27640000
  return'information :=                                                 27642000
      b08'write'data( cb'info,                                          27644000
                      0,                                                27646000
                      0,                                                27648000
                      device'close,                                     27650000
                      0,                                                27652000
                      0,                                                27654000
                      0,                                                27656000
                      0,                                                27658000
                      user'data'with'mask,                              27660000
                      true,                                             27662000
                      true                  );                          27664000
                                                                        27666000
                                                                        27668000
  << If that was successful, flush out any remaining data. >>           27670000
  << This can be done two ways, by ending an active job,   >>           27672000
  << or just sending any pending record buffers.           >>           27674000
                                                                        27676000
  if return'status.general = successful then                            27678000
    begin                                                               27680000
                                                                        27682000
      if logical( cb'info(job'active) ) then                            27684000
        begin                                                           27686000
                                                                        27688000
          return'information :=                                         27690000
              b08'end'job( cb'info, 0, 0, 0, 0 );                       27692000
                                                                        27694000
        end                                                             27696000
      else                                                              27698000
        begin                                                           27700000
                                                                        27702000
          << No job active, so send any data directly. >>               27704000
                                                                        27706000
          @o'r'control := cb'info(o'r'base)                             27708000
                        + cb'info(cds'area'base);                       27710000
                                                                        27712000
          if logical( o'r'control(active) ) then                        27714000
            begin                                                       27716000
                                                                        27718000
              return'status := cpr'send'record( cb'info,                27720000
                                                o'r'control );          27722000
                                                                        27724000
            end;                                                        27726000
        end;                                                            27728000
    end;                                                                27730000
                                                                        27732000
                                                                        27734000
  << Close off the transport service >>                                 27736000
                                                                        27738000
  @control'table := cb'info(ct'ptr);                                    27740000
                                                                        27742000
  b08'network'protocol( control'table,                                  27744000
                        transport'deallocate,                           27746000
                        0,                                              27748000
                        0,                                              27750000
                        cb'info(ciper'dst),                             27752000
                        cb'info(logical'device)  );                     27754000
                                                                        27756000
                                                                        27758000
  << Mark the device as available >>                                    27760000
                                                                        27762000
  cb'info(device'allocated) := free;                                    27764000
                                                                        27766000
  cb'info(file'open'count) := 0;                                        27768000
                                                                        27770000
                                                                        27772000
end;  << of procedure b08'device'close >>                               27774000
                                                                        27776000
$PAGE "PROCEDURE:  B08'FILE'OPEN"                                       27778000
double procedure b08'file'open(cb'info);                                27780000
                                                                        27782000
  value                        cb'info ;                                27784000
                                                                        27786000
  integer pointer              cb'info ;                                27788000
                                                                        27790000
  option privileged, uncallable        ;                                27792000
                                                                        27794000
                                                                        27796000
COMMENT                                                                 27798000
                                                                        27800000
  PURPOSE:                                                              27802000
                                                                        27804000
    This procedure will perform all functions necessary to              27806000
    complete a file open call.  This includes allocating the            27808000
    transport service, buffering a conditional top of form              27810000
    command for the 2608B, and if this is the first fopen,              27812000
    also initializing certain information in the control block          27814000
    information area.                                                   27816000
                                                                        27818000
                                                                        27820000
  INPUT PARAMETERS:                                                     27822000
                                                                        27824000
    CB'INFO, which points to the control block information              27826000
      area for the logical driver.  This is a global area for           27828000
                                                                        27830000
                                                                        27832000
  OUTPUT PARAMETERS:                                                    27834000
                                                                        27836000
    B08'FILE'OPEN, a double word function return, which is de-          27838000
      fined as follows:                                                 27840000
          word 0 -- completion status of call                           27842000
          word 1 -- transfer log of data moved from caller to           27844000
                    peripheral.                                         27846000
                                                                        27848000
                                                                        27850000
  SIDE-EFFECTS:                                                         27852000
                                                                        27854000
    This procedure will pass a transport'open command down to           27856000
    the transport service.  A conditional top of form escape            27858000
    sequence will be buffered for the 2608B.  If this is the            27860000
    first fopen call from the user, certain global information          27862000
    will be initialized.                                                27864000
                                                                        27866000
                                                                        27868000
  SPECIAL CONSIDERATIONS:                                               27870000
                                                                        27872000
    When called, DB must be set to the base of the CIPER data           27874000
    segment.                                                            27876000
                                                                        27878000
                                                                        27880000
  CHANGE HISTORY:                                                       27882000
                                                                        27884000
    As issued.                                                          27886000
                                                                        27888000
                                                                        27890000
;                                                                       27892000
$PAGE "PROCEDURE:  B08'FILE'OPEN -- LOCAL VARIABLES"                    27894000
begin                                                                   27896000
                                                                        27898000
  << Completion status subparameters: >>                                27900000
                                                                        27902000
  double                                                                27904000
                                                                        27906000
    return'information            = b08'file'open                       27908000
                                                                        27910000
  ;                                                                     27912000
                                                                        27914000
                                                                        27916000
  integer                                                               27918000
                                                                        27920000
    return'status                 = b08'file'open                       27922000
      << Completion status of call >>                                   27924000
                                                                        27926000
   ,transfer'log                  = b08'file'open + 1                   27928000
      << Count of data moved from caller to device >>                   27930000
                                                                        27932000
  ;                                                                     27934000
                                                                        27936000
                                                                        27938000
  << Control table information: >>                                      27940000
                                                                        27942000
  integer pointer                                                       27944000
                                                                        27946000
    control'table                                                       27948000
      << Points to the control table for a particular ldev >>           27950000
                                                                        27952000
  ;                                                                     27954000
                                                               <<04434>>27956000
                                                               <<04434>>27958000
  << Record buffer pointer >>                                  <<04434>>27960000
                                                               <<04434>>27962000
  integer pointer                                              <<04434>>27964000
                                                               <<04434>>27966000
    o'r'control                                                <<04434>>27968000
                                                               <<04434>>27970000
  ;                                                            <<04434>>27972000
$PAGE "PROCEDURE:  B08'FILE'OPEN -- PROCEDURE BODY"                     27974000
                                                                        27976000
  << Initialize the control table pointer. >>                           27978000
                                                                        27980000
  @control'table := cb'info(ct'ptr);                                    27982000
                                                                        27984000
                                                                        27986000
  << Call the transport service with an allocation command. >>          27988000
                                                                        27990000
  return'information :=                                                 27992000
    b08'network'protocol( control'table,                                27994000
                          transport'open,                               27996000
                          0,                                            27998000
                          0,                                            28000000
                          control'table(ct'cds'dst'num),                28002000
                          cb'info(logical'device)        );             28004000
                                                                        28006000
  if return'status.general = successful then                            28008000
    begin                                                               28010000
                                                                        28012000
      << The transport opened without error, so buffer up >>            28014000
      << conditional top of form command.                 >>            28016000
                                                                        28018000
      return'information :=                                             28020000
        b08'write'data( cb'info,                                        28022000
                        0,                                              28024000
                        0,                                              28026000
                        file'open,                                      28028000
                        0,                                              28030000
                        0,                                              28032000
                        0,                                              28034000
                        0,                                              28036000
                        user'data'with'mask,                            28038000
                        true,                                           28040000
                        true                   );                       28042000
                                                                        28044000
      if return'status.general = successful then                        28046000
        begin                                                           28048000
                                                                        28050000
          << Now see if this is the first fopen call.  If >>            28052000
          << it is, then certain information should be    >>            28054000
          << initialized.                                 >>            28056000
                                                                        28058000
          cb'info(file'open'count) := cb'info(file'open'count)          28060000
                                    + 1;                                28062000
                                                                        28064000
          if not logical( cb'info(device'allocated) ) then              28066000
            begin                                                       28068000
                                                                        28070000
              cb'info(device'allocated) := in'use;                      28072000
                                                                        28074000
              << Disable any notification of incoming status >>         28076000
              << information reports.                        >>         28078000
                                                                        28080000
              cb'info(status'enabled) := 0;                             28082000
                                                               <<04434>>28084000
                                                               <<04434>>28086000
              << Send the fopen record, ignoring any errors >> <<04434>>28088000
              << (no previous data has been lost)           >> <<04434>>28090000
                                                               <<04434>>28092000
              @o'r'control := cb'info(o'r'base)                <<04434>>28094000
                            + cb'info(cds'area'base);          <<04434>>28096000
                                                               <<04434>>28098000
              return'status := cpr'send'record( cb'info        <<04434>>28100000
                                               ,o'r'control ); <<04434>>28102000
                                                               <<04434>>28104000
              if return'status <> successful then              <<04434>>28106000
                begin                                          <<04434>>28108000
                                                               <<04434>>28110000
                  if return'status = pf'error then             <<04434>>28112000
                    begin                                      <<04434>>28114000
                      return'status := successful;             <<04434>>28116000
                    end;                                       <<04434>>28118000
                                                               <<04434>>28120000
                end;                                           <<04434>>28122000
                                                                        28124000
            end;                                                        28126000
                                                                        28128000
        end;                                                            28130000
                                                                        28132000
    end;                                                                28134000
                                                                        28136000
end;  << of procedure b08'file'open >>                                  28138000
                                                                        28140000
$PAGE "PROCEDURE:  B08'END'BLOCK"                                       28142000
double procedure b08'end'block(cb'info);                                28144000
                                                                        28146000
  value                        cb'info ;                                28148000
                                                                        28150000
  integer pointer              cb'info ;                                28152000
                                                                        28154000
  option privileged, uncallable        ;                                28156000
                                                                        28158000
                                                                        28160000
COMMENT                                                                 28162000
                                                                        28164000
  PURPOSE:                                                              28166000
                                                                        28168000
    This procedure will mark an existing output data record             28170000
    as the end of block, and then send the record to the                28172000
    peripheral.  If no such record exists, then a new record            28174000
    will be created and sent.                                           28176000
                                                                        28178000
                                                                        28180000
  INPUT PARAMETERS:                                                     28182000
                                                                        28184000
    CB'INFO, which points to the control block information              28186000
      area of the logical driver.  This area is the global              28188000
      information area of the driver, and contains pointers             28190000
      to the various record buffer areas, etc.                          28192000
                                                                        28194000
                                                                        28196000
  OUTPUT PARAMETERS:                                                    28198000
                                                                        28200000
    B08'END'BLOCK, which is a double word function return.              28202000
      Word 0 indicates the completion status of the call.               28204000
      Word 1 is the transfer log of data moved from the caller          28206000
      to the peripheral.  For this procedure, transfer log is           28208000
      always zero.                                                      28210000
                                                                        28212000
                                                                        28214000
  SIDE-EFFECTS:                                                         28216000
                                                                        28218000
    Any pending output data record will be sent to the device.          28220000
                                                                        28222000
                                                                        28224000
  SPECIAL CONSIDERATIONS:                                               28226000
                                                                        28228000
    None.                                                               28230000
                                                                        28232000
                                                                        28234000
  CHANGE HISTORY:                                                       28236000
                                                                        28238000
    As issued.                                                          28240000
                                                                        28242000
                                                                        28244000
;                                                                       28246000
$PAGE "PROCEDURE:  B08'END'BLOCK -- LOCAL VARIABLES"                    28248000
begin                                                                   28250000
                                                                        28252000
  << Function return sub-parameter definitions: >>                      28254000
                                                                        28256000
  double                                                                28258000
                                                                        28260000
    return'information            = b08'end'block                       28262000
                                                                        28264000
  ;                                                                     28266000
                                                                        28268000
                                                                        28270000
  integer                                                               28272000
                                                                        28274000
    return'status                 = b08'end'block                       28276000
      << contains the completion status of the call >>                  28278000
                                                                        28280000
   ,transfer'log                  = b08'end'block + 1                   28282000
      << Count of data moved from caller to peripheral >>               28284000
                                                                        28286000
  ;                                                                     28288000
                                                                        28290000
                                                                        28292000
  << Output record pointers: >>                                         28294000
                                                                        28296000
  integer pointer                                                       28298000
                                                                        28300000
    o'r'control                                                         28302000
      << points to control portion of record buffer area >>             28304000
                                                                        28306000
   ,o'r'data                                                            28308000
      << points to data portion of record buffer area >>                28310000
                                                                        28312000
  ;                                                                     28314000
$PAGE "PROCEDURE:  B08'END'BLOCK -- PROCEDURE BODY"                     28316000
                                                                        28318000
  << First, initialize the record buffer pointers >>                    28320000
                                                                        28322000
  @o'r'control := cb'info(o'r'base)                                     28324000
                + cb'info(cds'area'base);                               28326000
                                                                        28328000
  @o'r'data := @o'r'control + o'r'control(start);                       28330000
                                                                        28332000
                                                                        28334000
  << If there is not any pending record, we will have to >>             28336000
  << build a fresh record to mark as end of block.       >>             28338000
                                                                        28340000
  if not logical( o'r'control(active) ) then                            28342000
    begin                                                               28344000
      b08'build'header( o'r'control,                                    28346000
                        lgl'write,                                      28348000
                        cb'info(o'r'data'type) );                       28350000
                                                                        28352000
    end;                                                                28354000
                                                                        28356000
                                                                        28358000
  << Mark the record as end of block >>                                 28360000
                                                                        28362000
  o'r'data(eob'flag) := set'bit;                                        28364000
                                                                        28366000
                                                                        28368000
  << Send the record to the peripheral >>                               28370000
                                                                        28372000
  return'status := cpr'send'record(cb'info, o'r'control);               28374000
                                                                        28376000
                                                                        28378000
  << The return status of cpr'send'record will serve as >>              28380000
  << the completion status of this call, so just return >>              28382000
                                                                        28384000
end;  << of procedure b08'end'block >>                                  28386000
                                                                        28388000
$PAGE "PROCEDURE:  B08'START'BLOCK"                                     28390000
double procedure b08'start'block(cb'info,                               28392000
                                 label'upper'word,                      28394000
                                 label'lower'word );                    28396000
                                                                        28398000
  value                          cb'info,                               28400000
                                 label'upper'word,                      28402000
                                 label'lower'word  ;                    28404000
                                                                        28406000
  integer pointer                cb'info             ;                  28408000
                                                                        28410000
  integer                        label'upper'word,                      28412000
                                 label'lower'word  ;                    28414000
                                                                        28416000
  option privileged, uncallable                    ;                    28418000
                                                                        28420000
                                                                        28422000
COMMENT                                                                 28424000
                                                                        28426000
  PURPOSE:                                                              28428000
                                                                        28430000
    This procedure will create a new output data record, and            28432000
    mark it as the start of a new block, and fill in the block          28434000
    label.  The block number is obtained from the parm1 and             28436000
    parm2 the caller passed in.                                         28438000
                                                                        28440000
    If an output data record already exists, it will be marked          28442000
    as end of block and sent to the peripheral before the new           28444000
    record is created.                                                  28446000
                                                                        28448000
                                                                        28450000
  INPUT PARAAMETERS:                                                    28452000
                                                                        28454000
    CB'INFO, which points to the control block information              28456000
      area of the logical driver (level 7).  This information           28458000
      block contains pointers to the record buffer areas, as            28460000
      well as other global information for the logical driver.          28462000
                                                                        28464000
    BLOCK'LABEL'WORD'1, which is the upper word of the block            28466000
      label to be created.  It, together with the lower word            28468000
      of the block label, form a double word block number that          28470000
      the user can tag data with in the event recovery is ne-           28472000
      cessary.  Refer to the CIPER working standard for more            28474000
      detail.                                                           28476000
                                                                        28478000
    BLOCK'LABEL'WORD'2, which is the lower word of the double           28480000
      word block number.                                                28482000
                                                                        28484000
                                                                        28486000
  OUTPUT PARAMETERS:                                                    28488000
                                                                        28490000
    B08'START'BLOCK, which is a double word function return             28492000
      that conveys the completion status of the call.  Word 0           28494000
      is the completion status, word 1 is the transfer log              28496000
      (currently reserved).                                             28498000
                                                                        28500000
                                                                        28502000
  SIDE-EFFECTS:                                                         28504000
                                                                        28506000
    This procedure will cause transmission of any pending data          28508000
    record, if any exists.  A new output data record will be            28510000
    created, with the appropriate header information and block          28512000
    label in place.                                                     28514000
                                                                        28516000
                                                                        28518000
  SPECIAL CONSIDERATIONS:                                               28520000
                                                                        28522000
    None.                                                               28524000
                                                                        28526000
                                                                        28528000
  CHANGE HISTORY:                                                       28530000
                                                                        28532000
    As issued.                                                          28534000
                                                                        28536000
                                                                        28538000
;                                                                       28540000
$PAGE "PROCEDURE:  B08'START'BLOCK -- LOCAL VARIABLES"                  28542000
begin                                                                   28544000
                                                                        28546000
  << Function return information >>                                     28548000
                                                                        28550000
  double                                                                28552000
                                                                        28554000
    return'information            = b08'start'block                     28556000
      << Completion status for call >>                                  28558000
                                                                        28560000
  ;                                                                     28562000
                                                                        28564000
                                                                        28566000
  integer                                                               28568000
                                                                        28570000
    return'status                 = b08'start'block                     28572000
      << Completion code returned to caller >>                          28574000
                                                                        28576000
   ,transfer'log                  = b08'start'block + 1                 28578000
      << Count of data moved from caller to peripheral >>               28580000
                                                                        28582000
  ;                                                                     28584000
                                                                        28586000
                                                                        28588000
  << Output record pointers >>                                          28590000
                                                                        28592000
  integer pointer                                                       28594000
                                                                        28596000
    o'r'control                                                         28598000
      << Points to control portion of record buffer area >>             28600000
                                                                        28602000
   ,o'r'data                                                            28604000
      << Points to data portion of record buffer area >>                28606000
                                                                        28608000
  ;                                                                     28610000
$PAGE "PROCEDURE:  B08'START'BLOCK -- PROCEDURE BODY"                   28612000
                                                                        28614000
  << Initialize the record control pointer >>                           28616000
                                                                        28618000
  @o'r'control := cb'info(o'r'base)                                     28620000
                + cb'info(cds'area'base);                               28622000
                                                                        28624000
                                                                        28626000
  << Set up the pointer to the data portion of the record >>            28628000
                                                                        28630000
  @o'r'data := @o'r'control + o'r'control(start);                       28632000
                                                                        28634000
                                                                        28636000
  << If a record is currently active, we have to mark it >>             28638000
  << as the end of block and send it to the peripheral.  >>             28640000
                                                                        28642000
  if logical( o'r'control(active) ) then                                28644000
    begin                                                               28646000
                                                                        28648000
      return'information := b08'end'block(cb'info);                     28650000
                                                                        28652000
      if return'status.general <> successful then return;               28654000
                                                                        28656000
    end;                                                                28658000
                                                                        28660000
                                                                        28662000
  << Now that we have a clean record buffer to work with, >>            28664000
  << build a record header for it.                        >>            28666000
                                                                        28668000
  b08'build'header( o'r'control,                                        28670000
                    lgl'write,                                          28672000
                    user'data'with'mask );                              28674000
                                                                        28676000
                                                                        28678000
  << Set the start of block bit in the record header >>                 28680000
                                                                        28682000
  o'r'data(sob'flag) := set'bit;                                        28684000
                                                                        28686000
                                                                        28688000
  << Put the block label length in next >>                              28690000
                                                                        28692000
  o'r'data(parm'byte'1) := block'label'length;                          28694000
  o'r'data(parm'byte'2) := 0;  << currently reserved >>                 28696000
                                                                        28698000
                                                                        28700000
  << Now put in the block number as the caller gave it >>               28702000
                                                                        28704000
  o'r'data(3) := label'upper'word;                                      28706000
  o'r'data(4) := label'lower'word;                                      28708000
                                                                        28710000
                                                                        28712000
  << Update the record control information >>                           28714000
                                                                        28716000
  o'r'control(current'position) :=                                      28718000
      o'r'control(current'position) + block'label'length;               28720000
                                                                        28722000
  o'r'control(current'length) := o'r'control(current'length)            28724000
                               + block'label'length;                    28726000
                                                                        28728000
                                                                        28730000
  << Set a good completion status >>                                    28732000
                                                                        28734000
  return'status := successful;                                          28736000
                                                                        28738000
                                                                        28740000
end;  << of procedure b08'start'block >>                                28742000
                                                                        28744000
$PAGE "PROCEDURE:  B08'SILENT'RUN"                                      28746000
double procedure b08'silent'run(cb'info, dst'num, address,              28748000
                                count, flags              );            28750000
                                                                        28752000
  value                         cb'info, dst'num, address,              28754000
                                count, flags               ;            28756000
                                                                        28758000
  integer pointer               cb'info                    ;            28760000
                                                                        28762000
  integer                                dst'num, address,              28764000
                                count, flags               ;            28766000
                                                                        28768000
  option privileged, uncallable                            ;            28770000
                                                                        28772000
                                                                        28774000
COMMENT                                                                 28776000
                                                                        28778000
   PURPOSE:                                                             28780000
                                                                        28782000
    This procedure will send the BEGIN SILENT RUN command               28784000
    record to the 2608S.  The information in this record is             28786000
    passed in by the caller, and consists of block information,         28788000
    checkpoint numbers, and peripheral status information that          28790000
    the 2608S needs to enter the silent run recovery mode.              28792000
                                                                        28794000
                                                                        28796000
  INPUT PARAMETERS:                                                     28798000
                                                                        28800000
    CB'INFO, which points to the control block information              28802000
      area of the logical driver.                                       28804000
                                                                        28806000
    DST'NUM, which is the data segment number of the DST where          28808000
      the silent run recovery block will be moved from.  Note:          28810000
      this must be a stack or extra data segment, the code does         28812000
      not support system buffers at this time.                          28814000
                                                                        28816000
    ADDRESS, which is the offset in dst'num where the silent            28818000
      run recovery block begins.                                        28820000
                                                                        28822000
    COUNT, which is the size of the silent run recovery block.          28824000
      If count is positive, it specifies words.  If count is            28826000
      negative, it specifies bytes.                                     28828000
                                                                        28830000
    FLAGS, which are the request dependent flags passed by              28832000
      attachio to the logical driver.  The bit specifying sys-          28834000
      tem buffers is in flags, and is checked to make sure the          28836000
      caller is not using system buffers.                               28838000
                                                                        28840000
                                                                        28842000
  OUTPUT PARAMETERS:                                                    28844000
                                                                        28846000
    B08'SILENT'RUN, a double word function return.  Word 0 is           28848000
      the completion status of the call.  Word 1 is the trans-          28850000
      fer log of information moved from the caller's area into          28852000
      the silent run command record.  The transfer log is re-           28854000
      turned in the same sense as the input parameter count.            28856000
                                                                        28858000
                                                                        28860000
  SIDE-EFFECTS:                                                         28862000
                                                                        28864000
    If the peripheral accepts the silent run command record,            28866000
    it will be placed in the silent run mode.  Refer to the             28868000
    CIPER document for details of this mode of operation.               28870000
                                                                        28872000
                                                                        28874000
  SPECIAL CONSIDERATIONS:                                               28876000
                                                                        28878000
    None.                                                               28880000
                                                                        28882000
                                                                        28884000
  CHANGE HISTORY:                                                       28886000
                                                                        28888000
    As issued.                                                          28890000
                                                                        28892000
;                                                                       28894000
$PAGE "PROCEDURE:  B08'SILENT'RUN -- LOCAL VARIABLES"                   28896000
begin                                                                   28898000
                                                                        28900000
  << Function return variables: >>                                      28902000
                                                                        28904000
  double                                                                28906000
                                                                        28908000
    return'information            = b08'silent'run                      28910000
                                                                        28912000
  ;                                                                     28914000
                                                                        28916000
                                                                        28918000
  integer                                                               28920000
                                                                        28922000
    return'status                 = b08'silent'run                      28924000
      << Completion status of procedure call >>                         28926000
                                                                        28928000
   ,transfer'log                  = b08'silent'run + 1                  28930000
      << Transfer count of data moved from caller to device >>          28932000
                                                                        28934000
  ;                                                                     28936000
                                                                        28938000
                                                                        28940000
  << Output record control pointers: >>                                 28942000
                                                                        28944000
  integer pointer                                                       28946000
                                                                        28948000
    o'r'control                                                         28950000
      << Points to control portion of record buffer area >>             28952000
                                                                        28954000
   ,o'r'data                                                            28956000
      << Points to base of data portion of record buffer >>             28958000
      << area.                                           >>             28960000
                                                                        28962000
  ;                                                                     28964000
                                                                        28966000
                                                                        28968000
  << Counters of how much to move, how much has been moved, >>          28970000
  << the total size of the silent run recovery block, etc.  >>          28972000
                                                                        28974000
  integer                                                               28976000
                                                                        28978000
    what'fits                                                           28980000
      << Size of the available data area of the output >>               28982000
      << record, in words                              >>               28984000
                                                                        28986000
   ,word'count                                                          28988000
      << Size of the silent run recovery block, to the >>               28990000
      << nearest word                                  >>               28992000
                                                                        28994000
   ,move'count                                                          28996000
      << Amount to be moved per record from the caller's >>             28998000
      << data area                                       >>             29000000
                                                                        29002000
   ,total'moved                                                         29004000
      << tally of how many words have been moved into >>                29006000
      << output record(s)                             >>                29008000
                                                                        29010000
  ;                                                                     29012000
                                                                        29014000
                                                                        29016000
  logical                                                               29018000
                                                                        29020000
    odd'count                                                           29022000
      << Keeps track of the fact that a negative count may >>           29024000
      << be an odd number of bytes, which causes some extra >>          29026000
      << manipulation on our part.                          >>          29028000
                                                                        29030000
  ;                                                                     29032000
  declare'move'from'data'segment;                                       29034000
                                                                        29036000
$PAGE "PROCEDURE:  B08'SILENT'RUN -- PROCEDURE BODY"                    29038000
  << If the caller specified system buffers as the source >>            29040000
  << of the data, return with an illegal function error.  >>            29042000
                                                                        29044000
  if logical( flags.system'buffers ) then                               29046000
    begin                                                               29048000
      return'status := invalid'request;                                 29050000
      return;                                                           29052000
    end;                                                                29054000
                                                                        29056000
                                                                        29058000
  << Otherwise, set up the pointers to the output record   >>           29060000
  << buffer area.  If there was any residual data pending  >>           29062000
  << in that buffer, it can be ignored, because the silent >>           29064000
  << run command essentially starts from scratch.          >>           29066000
                                                                        29068000
  @o'r'control := cb'info(o'r'base) + cb'info(cds'area'base);           29070000
                                                                        29072000
  @o'r'data := o'r'control(start) + @o'r'control;                       29074000
                                                                        29076000
                                                                        29078000
  << Now convert the caller's count into a word count >>                29080000
                                                                        29082000
  if count < 0 then                                                     29084000
    begin                                                               29086000
      word'count := (-count+1) to'word;                                 29088000
      odd'count := logical( count.bit'15 );                             29090000
    end                                                                 29092000
  else                                                                  29094000
    begin                                                               29096000
      word'count := count;                                              29098000
      odd'count := false;                                               29100000
    end;                                                                29102000
                                                                        29104000
                                                                        29106000
  << Build the initial record header and set the start of >>            29108000
  << block bit                                            >>            29110000
                                                                        29112000
  b08'build'header( o'r'control,                                        29114000
                    lgl'silent'run,                                     29116000
                    no'data'type'used );                                29118000
                                                                        29120000
  o'r'data(sob'flag) := set'bit;                                        29122000
                                                                        29124000
                                                                        29126000
  << Calculate how many words will fit into what is left >>             29128000
  << of the record buffer                                >>             29130000
                                                                        29132000
  what'fits := (o'r'control(maximum'size)                               29134000
                - o'r'control(current'length)) to'word;                 29136000
                                                                        29138000
                                                                        29140000
  << Now loop, filling the record, sending it to the device, >>         29142000
  << until the word'count is exhausted.  On the last record, >>         29144000
  << the end of block bit should be set.                     >>         29146000
                                                                        29148000
  do                                                                    29150000
    begin                                                               29152000
                                                                        29154000
      << Determine how much of the request to move into  >>             29156000
      << the record.                                     >>             29158000
                                                                        29160000
      move'count := if word'count > what'fits                           29162000
          then what'fits                                                29164000
          else word'count;                                              29166000
                                                                        29168000
      << Reduce the requested count by the amount that will >>          29170000
      << be moved this pass.                                >>          29172000
                                                                        29174000
      word'count := word'count - move'count;                            29176000
                                                                        29178000
      << Move the data from the caller's area into the >>               29180000
      << record buffer area.                           >>               29182000
                                                                        29184000
      mfds(o'r'data( o'r'data(header'length) to'word),                  29186000
           dst'num,                                                     29188000
           address,                                                     29190000
           what'fits                                  );                29192000
                                                                        29194000
                                                                        29196000
      << Adjust the source address to reflect what has >>               29198000
      << been moved                                    >>               29200000
                                                                        29202000
      address := address + what'fits;                                   29204000
                                                                        29206000
                                                                        29208000
      << Adjust the record control information >>                       29210000
                                                                        29212000
      o'r'control(current'length) :=                                    29214000
          o'r'control(current'length) + (move'count to'byte);           29216000
                                                                        29218000
                                                                        29220000
      << If the word'count is exhausted, this will be the >>            29222000
      << last record, so set the end of block bit.        >>            29224000
                                                                        29226000
      if word'count = 0 then                                            29228000
        begin                                                           29230000
          o'r'data(eob'flag) := set'bit;                                29232000
                                                                        29234000
          if odd'count then                                             29236000
            begin                                                       29238000
              o'r'control(current'length) :=                            29240000
                  o'r'control(current'length) - 1;                      29242000
            end;                                                        29244000
        end;                                                            29246000
                                                                        29248000
                                                                        29250000
      << Send the record to the peripheral >>                           29252000
                                                                        29254000
      return'status := cpr'send'record(cb'info, o'r'control);           29256000
                                                                        29258000
      if return'status = successful then                                29260000
        begin                                                           29262000
          if word'count <> 0 then                                       29264000
            begin                                                       29266000
              b08'build'header( o'r'control,                            29268000
                                lgl'silent'run,                         29270000
                                no'data'type'used );                    29272000
            end;                                                        29274000
                                                                        29276000
          total'moved := total'moved + move'count;                      29278000
                                                                        29280000
        end                                                             29282000
      else                                                              29284000
        begin                                                           29286000
          << Force the word count to zero so we will exit >>            29288000
          << with an error condition.                     >>            29290000
                                                                        29292000
          word'count := 0;                                              29294000
                                                                        29296000
        end;                                                            29298000
                                                                        29300000
    end                                                                 29302000
  until word'count = 0;                                                 29304000
                                                                        29306000
                                                                        29308000
  << Adjust the transfer'log to reflect the sense of the >>             29310000
  << input parameter count, if necessary.                >>             29312000
                                                                        29314000
  transfer'log := if count < 0 then -(total'moved to'byte)              29316000
                               else total'moved;                        29318000
                                                                        29320000
  if odd'count then transfer'log := transfer'log + 1;                   29322000
                                                                        29324000
                                                                        29326000
  << All done!! >>                                                      29328000
                                                                        29330000
end;  << of procedure b08'silent'run >>                                 29332000
                                                                        29334000
$PAGE "PROCEDURE:  B08'CONTROL'MASK"                                    29336000
double procedure b08'control'mask(cb'info, dst'num, address,            29338000
                                count, flags              );            29340000
                                                                        29342000
  value                         cb'info, dst'num, address,              29344000
                                count, flags               ;            29346000
                                                                        29348000
  integer pointer               cb'info                    ;            29350000
                                                                        29352000
  integer                                dst'num, address,              29354000
                                count, flags               ;            29356000
                                                                        29358000
  option privileged, uncallable                            ;            29360000
                                                                        29362000
                                                                        29364000
COMMENT                                                                 29366000
                                                                        29368000
  PURPOSE:                                                              29370000
                                                                        29372000
    This procedure will send the CONTROL MASK command record            29374000
    to the 2608B.  The information in this record is passed             29376000
    in by the caller, and consists of a mask that will enable/          29378000
    disable the execution of selected ASCII control codes and           29380000
    device escape sequences.  For a description of the format           29382000
    of the control mask, refer to the CIPER document.                   29384000
                                                                        29386000
                                                                        29388000
  INPUT PARAMETERS:                                                     29390000
                                                                        29392000
    CB'INFO, which points to the control block information              29394000
      area of the logical driver.                                       29396000
                                                                        29398000
    DST'NUM, which is the data segment number of the DST where          29400000
      the control mask block will be moved from.  Note:                 29402000
      this must be a stack or extra data segment, the code does         29404000
      not support system buffers at this time.                          29406000
                                                                        29408000
    ADDRESS, which is the offset in dst'num where the control           29410000
      mask block begins.                                                29412000
                                                                        29414000
    COUNT, which is the size of the control mask block.                 29416000
      If count is positive, it specifies words.  If count is            29418000
      negative, it specifies bytes.                                     29420000
                                                                        29422000
    FLAGS, which are the request dependent flags passed by              29424000
      attachio to the logical driver.  The bit specifying sys-          29426000
      tem buffers is in flags, and is checked to make sure the          29428000
      caller is not using system buffers.                               29430000
                                                                        29432000
                                                                        29434000
  OUTPUT PARAMETERS:                                                    29436000
                                                                        29438000
    B08'CONTROL'MASK, a double word function return.  Word 0 is         29440000
      the completion status of the call.  Word 1 is the trans-          29442000
      fer log of information moved from the caller's area into          29444000
      the control mask command record.  The transfer log is re-         29446000
      turned in the same sense as the input parameter count.            29448000
                                                                        29450000
                                                                        29452000
  SIDE-EFFECTS:                                                         29454000
                                                                        29456000
    If the peripheral accepts the control mask command record,          29458000
    it will be placed in the control mask mode.  Refer to the           29460000
    CIPER document for details of this mode of operation.               29462000
                                                                        29464000
                                                                        29466000
  SPECIAL CONSIDERATIONS:                                               29468000
                                                                        29470000
    None.                                                               29472000
                                                                        29474000
                                                                        29476000
  CHANGE HISTORY:                                                       29478000
                                                                        29480000
    As issued.                                                          29482000
                                                                        29484000
;                                                                       29486000
$PAGE "PROCEDURE:  B08'CONTROL'MASK -- LOCAL VARIABLES"                 29488000
begin                                                                   29490000
                                                                        29492000
  << Function return variables: >>                                      29494000
                                                                        29496000
  double                                                                29498000
                                                                        29500000
    return'information            = b08'control'mask                    29502000
                                                                        29504000
  ;                                                                     29506000
                                                                        29508000
                                                                        29510000
  integer                                                               29512000
                                                                        29514000
    return'status                 = b08'control'mask                    29516000
      << Completion status of procedure call >>                         29518000
                                                                        29520000
   ,transfer'log                  = b08'control'mask + 1                29522000
      << Transfer count of data moved from caller to device >>          29524000
                                                                        29526000
  ;                                                                     29528000
                                                                        29530000
                                                                        29532000
  << Output record control pointers: >>                                 29534000
                                                                        29536000
  integer pointer                                                       29538000
                                                                        29540000
    o'r'control                                                         29542000
      << Points to control portion of record buffer area >>             29544000
                                                                        29546000
   ,o'r'data                                                            29548000
      << Points to base of data portion of record buffer >>             29550000
      << area.                                           >>             29552000
                                                                        29554000
  ;                                                                     29556000
                                                                        29558000
                                                                        29560000
  << Counters of how much to move, how much has been moved, >>          29562000
  << the total size of the control mask block, etc.  >>                 29564000
                                                                        29566000
  integer                                                               29568000
                                                                        29570000
    what'fits                                                           29572000
      << Size of the available data area of the output >>               29574000
      << record, in words                              >>               29576000
                                                                        29578000
   ,word'count                                                          29580000
      << Size of the control mask block, to the >>                      29582000
      << nearest word                                  >>               29584000
                                                                        29586000
   ,move'count                                                          29588000
      << Amount to be moved per record from the caller's >>             29590000
      << data area                                       >>             29592000
                                                                        29594000
   ,total'moved                                                         29596000
      << tally of how many words have been moved into >>                29598000
      << output record(s)                             >>                29600000
                                                                        29602000
  ;                                                                     29604000
                                                                        29606000
                                                                        29608000
  logical                                                               29610000
                                                                        29612000
    odd'count                                                           29614000
      << Keeps track of the fact that a negative count may >>           29616000
      << be an odd number of bytes, which causes some extra >>          29618000
      << manipulation on our part.                          >>          29620000
                                                                        29622000
  ;                                                                     29624000
  declare'move'from'data'segment;                                       29626000
                                                                        29628000
$PAGE "PROCEDURE:  B08'CONTROL'MASK -- PROCEDURE BODY"                  29630000
  << If the caller specified system buffers as the source >>            29632000
  << of the data, return with an illegal function error.  >>            29634000
                                                                        29636000
  if logical( flags.system'buffers ) then                               29638000
    begin                                                               29640000
      return'status := invalid'request;                                 29642000
      return;                                                           29644000
    end;                                                                29646000
                                                                        29648000
                                                                        29650000
  << Otherwise, get the dedicated output buffer. >>                     29652000
                                                                        29654000
  @o'r'control := cb'info(o'r'base)                                     29656000
                + cb'info(cds'area'base);                               29658000
                                                                        29660000
  @o'r'data := o'r'control(start) + @o'r'control;                       29662000
                                                                        29664000
                                                                        29666000
  << If there is any pending data in the record buffer, >>              29668000
  << it must be sent before the control mask is changed >>              29670000
  << so interpretation of previous data will be proper. >>              29672000
                                                                        29674000
  if logical( o'r'control(active) ) then                                29676000
    begin                                                               29678000
                                                                        29680000
      return'status := cpr'send'record(cb'info, o'r'control);           29682000
                                                                        29684000
      if return'status.general <> successful then                       29686000
        begin                                                           29688000
          return;                                                       29690000
        end;                                                            29692000
    end;                                                                29694000
                                                                        29696000
                                                                        29698000
  << Now convert the caller's count into a word count,    >>            29700000
  << rounding up an odd byte count to the next even word. >>            29702000
                                                                        29704000
  if count < 0 then                                                     29706000
    begin                                                               29708000
      word'count := (-count+1) to'word;                                 29710000
      odd'count := logical( count.bit'15 );                             29712000
    end                                                                 29714000
  else                                                                  29716000
    begin                                                               29718000
      word'count := count;                                              29720000
      odd'count := false;                                               29722000
    end;                                                                29724000
                                                                        29726000
                                                                        29728000
  << Build the initial record header and set the start of >>            29730000
  << block bit                                            >>            29732000
                                                                        29734000
  b08'build'header( o'r'control,                                        29736000
                    lgl'configuration,                                  29738000
                    control'mask );                                     29740000
                                                                        29742000
  o'r'data(sob'flag) := set'bit;                                        29744000
                                                                        29746000
                                                                        29748000
  << Calculate how many words will fit into what is left >>             29750000
  << of the record buffer                                >>             29752000
                                                                        29754000
  what'fits := (o'r'control(maximum'size)                               29756000
                - o'r'control(current'length)) to'word;                 29758000
                                                                        29760000
                                                                        29762000
  << Now loop, filling the record, sending it to the device, >>         29764000
  << until the word'count is exhausted.  On the last record, >>         29766000
  << the end of block bit should be set.                     >>         29768000
                                                                        29770000
  do                                                                    29772000
    begin                                                               29774000
                                                                        29776000
      << Determine how much of the request to move into  >>             29778000
      << the record.                                     >>             29780000
                                                                        29782000
      move'count := if word'count > what'fits                           29784000
          then what'fits                                                29786000
          else word'count;                                              29788000
                                                                        29790000
      << Reduce the requested count by the amount that will >>          29792000
      << be moved this pass.                                >>          29794000
                                                                        29796000
      word'count := word'count - move'count;                            29798000
                                                                        29800000
      << Move the data from the caller's area into the >>               29802000
      << record buffer area.                           >>               29804000
                                                                        29806000
      mfds(o'r'data( o'r'data(header'length) to'word),                  29808000
           dst'num,                                                     29810000
           address,                                                     29812000
           what'fits                                  );                29814000
                                                                        29816000
                                                                        29818000
      << Adjust the source address to reflect what has >>               29820000
      << been moved                                    >>               29822000
                                                                        29824000
      address := address + what'fits;                                   29826000
                                                                        29828000
                                                                        29830000
      << Adjust the record control information >>                       29832000
                                                                        29834000
      o'r'control(current'length) :=                                    29836000
          o'r'control(current'length) + (move'count to'byte);           29838000
                                                                        29840000
                                                                        29842000
      << If the word'count is exhausted, this will be the >>            29844000
      << last record, so set the end of block bit.        >>            29846000
                                                                        29848000
      if word'count = 0 then                                            29850000
        begin                                                           29852000
          o'r'data(eob'flag) := set'bit;                                29854000
                                                                        29856000
          if odd'count then                                             29858000
            begin                                                       29860000
              o'r'control(current'length) :=                            29862000
                  o'r'control(current'length) - 1;                      29864000
            end;                                                        29866000
        end;                                                            29868000
                                                                        29870000
                                                                        29872000
      << Send the record to the peripheral >>                           29874000
                                                                        29876000
      return'status := cpr'send'record(cb'info, o'r'control);           29878000
                                                                        29880000
      if return'status = successful then                                29882000
        begin                                                           29884000
          if word'count <> 0 then                                       29886000
            begin                                                       29888000
              b08'build'header( o'r'control,                            29890000
                                lgl'configuration,                      29892000
                                control'mask );                         29894000
            end;                                                        29896000
                                                                        29898000
          total'moved := total'moved + move'count;                      29900000
                                                                        29902000
        end                                                             29904000
      else                                                              29906000
        begin                                                           29908000
          << Force the word count to zero so we will exit >>            29910000
          << with an error condition.                     >>            29912000
                                                                        29914000
          word'count := 0;                                              29916000
                                                                        29918000
        end;                                                            29920000
                                                                        29922000
    end                                                                 29924000
  until word'count = 0;                                                 29926000
                                                                        29928000
                                                                        29930000
  << Adjust the transfer'log to reflect the sense of the >>             29932000
  << input parameter count, if necessary.                >>             29934000
                                                                        29936000
  transfer'log := if count < 0 then -(total'moved to'byte)              29938000
                               else total'moved;                        29940000
                                                                        29942000
  if odd'count then transfer'log := transfer'log + 1;                   29944000
                                                                        29946000
                                                                        29948000
  << All done!! >>                                                      29950000
                                                                        29952000
end;  << of procedure b08'control'mask >>                               29954000
                                                                        29956000
$PAGE "PROCEDURE:  B08'SET'EXT'MODE"                                    29958000
integer procedure B08'set'ext'mode(cb'info, mode'flag);                 29960000
                                                                        29962000
  value                            cb'info, mode'flag ;                 29964000
                                                                        29966000
  integer pointer                  cb'info            ;                 29968000
                                                                        29970000
  integer                                   mode'flag ;                 29972000
                                                                        29974000
  option privileged, uncallable;                                        29976000
                                                                        29978000
                                                                        29980000
COMMENT                                                                 29982000
                                                                        29984000
  PURPOSE:                                                              29986000
                                                                        29988000
    This procedure controls the caller's access to the ex-              29990000
    tended features of the 2608B.  At the start of each job,            29992000
    the caller defaults to non-extended feature mode for                29994000
    backward compatibility of existing subsystems and appli-            29996000
    cations.  If the caller wishes to directly access the               29998000
    features of the 2608B by escape sequence control, the               30000000
    appropriate function call (fdevicecontrol) must be made             30002000
    to enable the expanded features.                                    30004000
                                                                        30006000
                                                                        30008000
  INPUT PARAMETERS:                                                     30010000
                                                                        30012000
    CB'INFO, which points to the control block information              30014000
      area of the logical driver.  The extended'features flag           30016000
      is located in this area.                                          30018000
                                                                        30020000
    MODE'FLAG, which indicates which mode the caller desires:           30022000
      a value of zero places the caller in backward compati-            30024000
      bility mode, a value of one places the caller in exten-           30026000
      ded features mode.  All other values are reserved for             30028000
      future expansion.                                                 30030000
                                                                        30032000
                                                                        30034000
  OUTPUT PARAMETERS:                                                    30036000
                                                                        30038000
    B08'SET'EXT'MODE, which is the function return indicating           30040000
      the completion status.  A value of one is returned if             30042000
      the mode'flag was an acceptable value, otherwise a value          30044000
      of %4 (invalid request) is returned.                              30046000
                                                                        30048000
                                                                        30050000
  SIDE-EFFECTS:                                                         30052000
                                                                        30054000
    None.                                                               30056000
                                                                        30058000
                                                                        30060000
  SPECIAL CONSIDERATIONS:                                               30062000
                                                                        30064000
    DB must be set to the base of the CIPER data segment                30066000
    before calling this procedure.                                      30068000
                                                                        30070000
                                                                        30072000
  CHANGE HISTORY:                                                       30074000
                                                                        30076000
    As issued.                                                          30078000
                                                                        30080000
                                                                        30082000
;                                                                       30084000
$PAGE "PROCEDURE:  B08'SET'EXT'MODE -- PROCEUDURE BODY"                 30086000
begin                                                                   30088000
                                                                        30090000
  << Determine if the mode'flag parameter is within bounds >>           30092000
                                                                        30094000
  if 0 <= mode'flag <= 1 then                                           30096000
    begin                                                               30098000
                                                                        30100000
      cb'info(expanded'features) := (mode'flag <> 0);                   30102000
                                                                        30104000
      b08'set'ext'mode := successful;                                   30106000
                                                                        30108000
    end                                                                 30110000
  else                                                                  30112000
    begin                                                               30114000
                                                                        30116000
      b08'set'ext'mode := invalid'request;                              30118000
                                                                        30120000
    end;                                                                30122000
                                                                        30124000
end;  << of procedure b08'set'ext'mode >>                               30126000
                                                                        30128000
$PAGE "PROCEDURE B08'SET'STATUS'TYPES"                                  30130000
double procedure b08'set'status'types(cb'info, dst'num,                 30132000
                                      address, count, parm1 );          30134000
                                                                        30136000
  value                               cb'info, dst'num,                 30138000
                                      address, count, parm1  ;          30140000
                                                                        30142000
  integer pointer                     cb'info                ;          30144000
                                                                        30146000
  integer                                      dst'num,                 30148000
                                      address, count, parm1  ;          30150000
                                                                        30152000
  option privileged, uncallable;                                        30154000
                                                                        30156000
                                                                        30158000
COMMENT                                                                 30160000
                                                                        30162000
  PURPOSE:                                                              30164000
                                                                        30166000
    This procedure will set the status'enabled mask contained           30168000
    in cb'info to enable/disable reporting the reception of             30170000
    certain types of status.  In addition, configuration                30172000
    parameters associated with those status types will be ex-           30174000
    tracted from a sixteen word array passed by the caller.             30176000
    This configuration information will be assembled into a             30178000
    configuration record and sent to the peripheral.                    30180000
                                                                        30182000
                                                                        30184000
  INPUT PARAMETERS:                                                     30186000
                                                                        30188000
    CB'INFO, which points to the control block information              30190000
      area of the logical driver.  The status'enabled mask is           30192000
      one of the elements of cb'info.                                   30194000
                                                                        30196000
    DST'NUM, which is the data segment number of the segment            30198000
      where the caller specified array is located.                      30200000
                                                                        30202000
    ADDRESS, which is the offset within the data segment where          30204000
      the caller's array starts.                                        30206000
                                                                        30208000
    COUNT, which is the size of the caller's array.  If posi-           30210000
      tive, the count is in words, if negative, the count is            30212000
      in bytes.  If a count of less than 16 words is given,             30214000
      any missing parameters will revert to their default               30216000
      state.                                                            30218000
                                                                        30220000
    PARM1, which is the bit map indicating which status types           30222000
      should be enabled (1) or disabled (0).  Currenly, the             30224000
      status types defined are:                                         30226000
                                                                        30228000
            .( 0:14) - Reserved.  Set to zero.                          30230000
            .(14: 1) - Device Status                                    30232000
            .(15: 1) - Environmental Status                             30234000
                                                                        30236000
      Each word of the caller's array correspond to one of the          30238000
      bits of parm1.  Currently, the only word with signifi-            30240000
      cance is word 15, which sets the frequency of environ-            30242000
      mental status report generation.                                  30244000
                                                                        30246000
                                                                        30248000
  OUTPUT PARAMETERS:                                                    30250000
                                                                        30252000
    B08'SET'STATUS'TYPES, which is a double word function re-           30254000
      turn.  Word 0 is the completion status of the call.               30256000
      Word 1 is the transfer log of data moved from the                 30258000
      caller's array.                                                   30260000
                                                                        30262000
                                                                        30264000
  SIDE-EFFECTS:                                                         30266000
                                                                        30268000
    The information contained in the caller's array will be             30270000
    used to generate a configuration record for the peripheral.         30272000
    This record will affect the manner by which the peripheral          30274000
    communicates with the logical driver.                               30276000
                                                                        30278000
                                                                        30280000
  SPECIAL CONSIDERATIONS:                                               30282000
                                                                        30284000
    The caller's array must be at least sixteen words in length         30286000
    for this function to provide the desired results.                   30288000
                                                                        30290000
                                                                        30292000
  CHANGE HISTORY:                                                       30294000
                                                                        30296000
    As issued.                                                          30298000
                                                                        30300000
                                                                        30302000
;                                                                       30304000
                                                                        30306000
$PAGE "PROCEDURE:  B08'SET'STATUS'TYPES -- LOCAL VARIABLES"             30308000
begin                                                                   30310000
                                                                        30312000
  << Function return sub-parameters: >>                                 30314000
                                                                        30316000
  double                                                                30318000
                                                                        30320000
    return'information            = b08'set'status'types                30322000
                                                                        30324000
  ;                                                                     30326000
                                                                        30328000
                                                                        30330000
  integer                                                               30332000
                                                                        30334000
    return'status                 = b08'set'status'types                30336000
      << Completion status for the call >>                              30338000
                                                                        30340000
   ,transfer'log                  = b08'set'status'types + 1            30342000
      << Count of data moved from caller's array >>                     30344000
                                                                        30346000
  ;                                                                     30348000
                                                                        30350000
  declare'move'from'data'segment;                                       30352000
                                                                        30354000
$PAGE "PROCEDURE B08'SET'STATUS'TYPES -- PROCEDURE BODY"                30356000
                                                                        30358000
  << First, move parm1 into the status'enabled field >>                 30360000
                                                                        30362000
  cb'info(status'enabled) := parm1;                                     30364000
                                                                        30366000
                                                                        30368000
  << Now pull out the information for environmental status >>           30370000
                                                                        30372000
  if count <= -32 or count >= 16 then                                   30374000
    begin                                                               30376000
      mfds(cb'info(esb'frequency),dst'num,address+15,1);                30378000
      transfer'log := if count < 0 then -32 else 16;                    30380000
    end                                                                 30382000
  else                                                                  30384000
    begin                                                               30386000
      cb'info(esb'frequency) := 0;                                      30388000
      transfer'log := 0;                                                30390000
    end;                                                                30392000
                                                                        30394000
                                                                        30396000
  << Send the configuration record to the device >>                     30398000
                                                                        30400000
  return'status := b08'configure( cb'info,                              30402000
                                  true,  << sr'enable >>                30404000
                                  cb'info(esb'frequency)  );            30406000
                                                                        30408000
                                                                        30410000
end;  << of b08'set'status'types >>                                     30412000
                                                                        30414000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS"                               30416000
integer procedure b08'flush'out'buffers( cb'info );                     30418000
                                                                        30420000
  value                                  cb'info  ;                     30422000
                                                                        30424000
  integer pointer                        cb'info  ;                     30426000
                                                                        30428000
  option privileged, uncallable                   ;                     30430000
                                                                        30432000
                                                                        30434000
COMMENT                                                                 30436000
                                                                        30438000
  PURPOSE:                                                              30440000
                                                                        30442000
    This procedure will cause any pending record buffers to             30444000
    be sent to the device.  This might be needed if the calling         30446000
    program wanted a small amount of data actually printed,             30448000
    but the amount of data was not great enough to completely           30450000
    fill a record and cause it to be sent.                              30452000
                                                                        30454000
    Currently, only the dedicated output buffer is sent, but            30456000
    later, a queuing mechanism for multiple buffers might be            30458000
    used.                                                               30460000
                                                                        30462000
                                                                        30464000
  INPUT PARAMETERS:                                                     30466000
                                                                        30468000
    CB'INFO, which points to the control block information              30470000
      area of the logical driver for this ldev.  Cb'info is             30472000
      an array of global information used by many of the pro-           30474000
      cedures that make up the logical driver.                          30476000
                                                                        30478000
                                                                        30480000
  OUTPUT PARAMETERS:                                                    30482000
                                                                        30484000
    B08'FLUSH'OUT'BUFFERS, which is a single word function              30486000
      return.  This returns the completion status of the call.          30488000
                                                                        30490000
                                                                        30492000
  SIDE-EFFECTS:                                                         30494000
                                                                        30496000
    If the pending records (if any) are successfully sent, only         30498000
    the record sequence numbers and receive ready count should          30500000
    change.  If any peripheral and/or transport service errors          30502000
    occur, then a device clear sequence could be generated.             30504000
                                                                        30506000
                                                                        30508000
  SPECIAL CONSIDERATIONS:                                               30510000
                                                                        30512000
    When called, DB should be set to the CIPER data segment.            30514000
                                                                        30516000
                                                                        30518000
  CHANGE HISTORY:                                                       30520000
                                                                        30522000
    As issued.                                                          30524000
                                                                        30526000
                                                                        30528000
;                                                                       30530000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS -- LOCAL VARIABLES"            30532000
begin                                                                   30534000
                                                                        30536000
  integer pointer                                                       30538000
                                                                        30540000
    o'r'control                                                         30542000
      << points to control portion of output record buffer >>           30544000
      << area.                                             >>           30546000
                                                                        30548000
  ;                                                                     30550000
$PAGE "PROCEDURE:  B08'FLUSH'OUT'BUFFERS -- PROCEDURE BODY"             30552000
                                                                        30554000
  << Set up the pointer to the dedicated output buffer. >>              30556000
                                                                        30558000
  @o'r'control := cb'info(o'r'base)                                     30560000
                + cb'info(cds'area'base);                               30562000
                                                                        30564000
                                                                        30566000
  << If the record is in use, send it out >>                            30568000
                                                                        30570000
  if logical( o'r'control(active) ) then                                30572000
    begin                                                               30574000
                                                                        30576000
      b08'flush'out'buffer := cpr'send'record( cb'info,                 30578000
                                               o'r'control );           30580000
                                                                        30582000
    end                                                                 30584000
  else                                                                  30586000
    begin                                                               30588000
                                                                        30590000
      b08'flush'out'buffer := successful;                               30592000
                                                                        30594000
    end;                                                                30596000
                                                                        30598000
end;  << of procedure b08'flush'out'buffers >>                          30600000
                                                                        30602000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS"                                   30604000
integer procedure b08'erase'buffers( cb'info );                         30606000
                                                                        30608000
  value                              cb'info  ;                         30610000
                                                                        30612000
  integer pointer                    cb'info  ;                         30614000
                                                                        30616000
  option privileged, uncallable               ;                         30618000
                                                                        30620000
                                                                        30622000
COMMENT                                                                 30624000
                                                                        30626000
  PURPOSE:                                                              30628000
                                                                        30630000
    This procedure will mark the dedicated input and output             30632000
    record buffer areas as free.  This essentially deletes              30634000
    any information contained in them, as the next time they            30636000
    are used, the control information will be initialized and           30638000
    a new record started.                                               30640000
                                                                        30642000
                                                                        30644000
  INPUT PARAMETERS:                                                     30646000
                                                                        30648000
    CB'INFO, which points to the control block information              30650000
      area of the logical driver (level 7) for this ldev.               30652000
      Cb'info is an array of global information used by many            30654000
      of the procedures that implement the logical driver.              30656000
                                                                        30658000
                                                                        30660000
  OUTPUT PARAMETERS:                                                    30662000
                                                                        30664000
    B08'ERASE'BUFFERS, which is a single word function return.          30666000
      This word is the completion status (will always return a          30668000
      value of one for successful completion).                          30670000
                                                                        30672000
                                                                        30674000
  SIDE-EFFECTS:                                                         30676000
                                                                        30678000
    None.                                                               30680000
                                                                        30682000
                                                                        30684000
  SPECIAL CONSIDERATIONS:                                               30686000
                                                                        30688000
    When called, DB should be set to the base of the CIPER              30690000
    data segment.                                                       30692000
                                                                        30694000
                                                                        30696000
  CHANGE HISTORY:                                                       30698000
                                                                        30700000
    As issued.                                                          30702000
                                                                        30704000
                                                                        30706000
;                                                                       30708000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS -- LOCAL VARIABLES"                30710000
begin                                                                   30712000
                                                                        30714000
  logical pointer                                                       30716000
                                                                        30718000
    record'control                                                      30720000
      << Points to control portion of record buffer areas >>            30722000
                                                                        30724000
  ;                                                                     30726000
$PAGE "PROCEDURE:  B08'ERASE'BUFFERS -- PROCEDURE BODY"                 30728000
                                                                        30730000
  << Free up the dedicated output buffer. >>                            30732000
                                                                        30734000
  @record'control := cb'info(o'r'base)                                  30736000
                   + cb'info(cds'area'base);                            30738000
                                                                        30740000
  record'control(active) := free;                                       30742000
                                                                        30744000
  record'control(current'length) := 0;                                  30746000
                                                                        30748000
  record'control(current'position) :=                                   30750000
      (record'control(start) to'byte);                                  30752000
                                                                        30754000
                                                                        30756000
  << Free up the dedicated input buffer. >>                             30758000
                                                                        30760000
  @record'control := cb'info(i'r'base)                                  30762000
                   + cb'info(cds'area'base);                            30764000
                                                                        30766000
  record'control(active) := free;                                       30768000
                                                                        30770000
  record'control(current'length) := 0;                                  30772000
                                                                        30774000
  record'control(current'position) :=                                   30776000
      (record'control(start) to'byte);                                  30778000
                                                                        30780000
                                                                        30782000
  << All done >>                                                        30784000
                                                                        30786000
  b08'erase'buffers := successful;                                      30788000
                                                                        30790000
end;  << of procedure b08'erase'buffers >>                              30792000
                                                                        30794000
$IF X9 = ON  << ON = INCLUDE DEBUGGING CODE >>                 <<04434>>30796000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH"                                  30798000
double procedure b08'set'rec'length(cb'info, record'length);            30800000
                                                                        30802000
  value                             cb'info, record'length ;            30804000
                                                                        30806000
  integer pointer                   cb'info                ;            30808000
                                                                        30810000
  integer                                    record'length ;            30812000
                                                                        30814000
  option privileged, uncallable                            ;            30816000
                                                                        30818000
                                                                        30820000
COMMENT                                                                 30822000
                                                                        30824000
  PURPOSE:                                                              30826000
                                                                        30828000
    This procedure will adjust the maximum record size for all          30830000
    records sent and received.  This is useful for performance          30832000
    measurements where record size is one of the variables.             30834000
                                                                        30836000
                                                                        30838000
  INPUT PARAMETERS:                                                     30840000
                                                                        30842000
    CB'INFO, which points to the level 7 control block informa-         30844000
      tion area of the particular LDEV.  Pointers to all of the         30846000
      record buffer areas are maintained here.                          30848000
                                                                        30850000
    RECORD'LENGTH, which indicates the maximum size, in bytes,          30852000
      that a record may be.  This value is plugged into the             30854000
      maximum'size field of each record buffer control area.            30856000
                                                                        30858000
                                                                        30860000
  OUTPUT PARAMETERS:                                                    30862000
                                                                        30864000
    B08'SET'REC'LENGTH, which is a double word function return.         30866000
      Word 0 is the completion status for the call.  Word 1 is          30868000
      the previous configured record size, in bytes.                    30870000
                                                                        30872000
                                                                        30874000
  SIDE-EFFECTS:                                                         30876000
                                                                        30878000
    None.                                                               30880000
                                                                        30882000
                                                                        30884000
  SPECIAL CONSIDERATIONS:                                               30886000
                                                                        30888000
    When called, DB must be set to the CIPER data segment.              30890000
                                                                        30892000
                                                                        30894000
  CHANGE HISTORY:                                                       30896000
                                                                        30898000
    As issued.                                                          30900000
                                                                        30902000
                                                                        30904000
;                                                                       30906000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH -- LOCAL VARIABLES"               30908000
begin                                                                   30910000
                                                                        30912000
  << Return status definitions: >>                                      30914000
                                                                        30916000
  double                                                                30918000
                                                                        30920000
    return'information            = b08'set'rec'length                  30922000
                                                                        30924000
  ;                                                                     30926000
                                                                        30928000
                                                                        30930000
  integer                                                               30932000
                                                                        30934000
    return'status                 = b08'set'rec'length                  30936000
                                                                        30938000
   ,transfer'log                  = b08'set'rec'length + 1              30940000
                                                                        30942000
  ;                                                                     30944000
                                                                        30946000
                                                                        30948000
  << Pointer to the record buffer control area: >>                      30950000
                                                                        30952000
  integer pointer                                                       30954000
                                                                        30956000
    i'o'control                                                         30958000
                                                                        30960000
  ;                                                                     30962000
$PAGE "PROCEDURE:  B08'SET'REC'LENGTH -- PROCEDURE BODY"                30964000
  << Modify the dedicated output buffer first, and let its >>           30966000
  << current size be returned as the transfer log.         >>           30968000
                                                                        30970000
  @i'o'control := cb'info(o'r'base)                                     30972000
                + cb'info(cds'area'base);                               30974000
                                                                        30976000
  transfer'log := i'o'control(maximum'size);                            30978000
                                                                        30980000
  i'o'control(maximum'size) := record'length;                           30982000
                                                                        30984000
                                                                        30986000
  << Fix up the dedicated input buffer next >>                          30988000
                                                                        30990000
  @i'o'control := cb'info(i'r'base)                                     30992000
                + cb'info(cds'area'base);                               30994000
                                                                        30996000
  i'o'control(maximum'size) := record'length;                           30998000
                                                                        31000000
                                                                        31002000
  << Fix up all of the record buffers in the free list >>               31004000
                                                                        31006000
  @i'o'control := cb'info(free'buff'list);                              31008000
                                                                        31010000
  while @i'o'control is'not'nil do                                      31012000
    begin                                                               31014000
                                                                        31016000
      @i'o'control := @i'o'control                                      31018000
                    + cb'info(cds'area'base);                           31020000
                                                                        31022000
      i'o'control(maximum'size) := record'length;                       31024000
                                                                        31026000
      @i'o'control := i'o'control(forward'link);                        31028000
                                                                        31030000
    end;                                                                31032000
                                                                        31034000
                                                                        31036000
  << All done !! >>                                                     31038000
                                                                        31040000
  return'status := successful;                                          31042000
                                                                        31044000
end;  << of procedure b08'set'rec'length >>                             31046000
                                                                        31048000
$PAGE "PROCEDURE:  CPR'TEST'SHUTDOWN"                                   31050000
double procedure cpr'test'shutdown( level, limit );                     31052000
                                                                        31054000
  value                             level, limit  ;                     31056000
                                                                        31058000
  integer                           level, limit  ;                     31060000
                                                                        31062000
  option privileged, uncallable                   ;                     31064000
                                                                        31066000
                                                                        31068000
COMMENT                                                                 31070000
                                                                        31072000
  PURPOSE:                                                              31074000
                                                                        31076000
    This procedure will provide an automated test of the shut-          31078000
    down mechanism.  It does this by recursing several times,           31080000
    each time adding an increasing amount of crap on the stack.         31082000
    When the limit is reached, it calls cpr'internal'error to           31084000
    initiate the shutdown.                                              31086000
                                                                        31088000
    In the future, it would be nice if this would test two              31090000
    other possibilities:  that of corrupted ldev parameters             31092000
    and a generally corrupted stack.                                    31094000
                                                                        31096000
                                                                        31098000
  INPUT PARAMETERS:                                                     31100000
                                                                        31102000
    LEVEL, which is used to indicate how many times we have             31104000
      recursed.                                                         31106000
                                                                        31108000
    LIMIT, which is the maximum number of times to recurse              31110000
      before calling cpr'internal'error.                                31112000
                                                                        31114000
                                                                        31116000
  OUTPUT PARAMETERS:                                                    31118000
                                                                        31120000
    None.                                                               31122000
                                                                        31124000
                                                                        31126000
  SIDE-EFFECTS:                                                         31128000
                                                                        31130000
    The LDEV that is shut down will be unavailable until either         31132000
    the ldtx entry is manually fixed up or the system is warm-          31134000
    started.                                                            31136000
                                                                        31138000
                                                                        31140000
  SPECIAL CONSIDERATIONS:                                               31142000
                                                                        31144000
    None.                                                               31146000
                                                                        31148000
                                                                        31150000
  CHANGE HISTORY:                                                       31152000
                                                                        31154000
    None.                                                               31156000
                                                                        31158000
                                                                        31160000
;                                                                       31162000
$PAGE "PROCEDURE:  CPR'TEST'SHUTDOWN -- PROCEDURE BODY"                 31164000
begin                                                                   31166000
                                                                        31168000
  x := level;                                                           31170000
  while dxbz do assemble( adds 1 );                                     31172000
                                                                        31174000
  if level < limit then cpr'test'shutdown( level + 1, limit )           31176000
                   else cpr'internal'error;                             31178000
                                                                        31180000
end;  << of procedure cpr'test'shutdown >>                              31182000
                                                                        31184000
$IF                                                            <<04434>>31186000
$PAGE "PROCEDURE:  B08'INITIALIZE"                                      31188000
double procedure b08'initialize(control'table, control'block,           31190000
                                cb'info, ldev                );         31192000
                                                                        31194000
  value                         control'table, control'block,           31196000
                                cb'info, ldev                 ;         31198000
                                                                        31200000
  logical pointer               control'table, control'block            31202000
                                                              ;         31204000
                                                                        31206000
  integer pointer                                                       31208000
                                cb'info                       ;         31210000
                                                                        31212000
  integer                                ldev                           31214000
                                                              ;         31216000
                                                                        31218000
  option privileged, uncallable                               ;         31220000
                                                                        31222000
                                                                        31224000
COMMENT                                                                 31226000
                                                                        31228000
  PURPOSE:                                                              31230000
                                                                        31232000
    This procedure will perform all initialization of the               31234000
    Level 7 control block information area and the informa-             31236000
    tion area extension.                                                31238000
                                                                        31240000
    During this process, the transport service will be initial-         31242000
    ized, and a device clear command will be sent to the per-           31244000
    ipheral.                                                            31246000
                                                                        31248000
    This procedure should only be called once per CIPER device,         31250000
    typically upon the first fopen to that device after the             31252000
    system has been brought up.                                         31254000
                                                                        31256000
                                                                        31258000
  INPUT PARAMETERS:                                                     31260000
                                                                        31262000
    CONTROL'TABLE, which points to the control table for this           31264000
      logical device.                                                   31266000
                                                                        31268000
    CONTROL'BLOCK, which points to the control block for Level          31270000
      7 for this logical device.                                        31272000
                                                                        31274000
    CB'INFO, which is a pointer to the control block informa-           31276000
      tion area of the logical driver (level 7) for this ldev.          31278000
                                                                        31280000
    LDEV, which is the logical device number of the device the          31282000
      caller is requesting.                                             31284000
                                                                        31286000
                                                                        31288000
  OUTPUT PARAMETERS:                                                    31290000
                                                                        31292000
    B08'INITIALIZE, a double word which contains the following          31294000
      information:                                                      31296000
                                                                        31298000
        word 0 - completion status of the initialization call.          31300000
                 A value of one indicates successful comple-            31302000
                 tion.  Other values indicate certain error             31304000
                 conditions have occurred while initializing.           31306000
                                                                        31308000
        word 1 - reserved.                                              31310000
                                                                        31312000
                                                                        31314000
  SIDE-EFFECTS:                                                         31316000
                                                                        31318000
    If this procedure reaches a successful completion, all              31320000
    areas of the CIPER data segment will be initialized.  In            31322000
    addition, the logical driver will be synchronized with the          31324000
    device due to the device clear command sent.                        31326000
                                                                        31328000
                                                                        31330000
  SPECIAL CONSIDERATIONS:                                               31332000
                                                                        31334000
    None.                                                               31336000
                                                                        31338000
                                                                        31340000
  CHANGE HISTORY:                                                       31342000
                                                                        31344000
    As issued.                                                          31346000
                                                                        31348000
;                                                                       31350000
$PAGE "PROCEDURE:  B08'INITIALIZE -- LOCAL VARIABLES"                   31352000
begin                                                                   31354000
                                                                        31356000
  << Sub-parameter definitions of double word return >>                 31358000
                                                                        31360000
  double                                                                31362000
                                                                        31364000
    return'information            = b08'initialize                      31366000
      << contains two words of completion status, as de- >>             31368000
      << fined below:                                    >>             31370000
                                                                        31372000
  ;                                                                     31374000
                                                                        31376000
                                                                        31378000
  integer                                                               31380000
                                                                        31382000
    return'status                 = b08'initialize                      31384000
      << completion status of the initialization call >>                31386000
                                                                        31388000
   ,transfer'log                  = b08'initialize + 1                  31390000
      << number of words/bytes transferred (reserved and >>             31392000
      << set to zero for now)                            >>             31394000
                                                                        31396000
  ;                                                                     31398000
                                                                        31400000
                                                                        31402000
  integer pointer                                                       31404000
                                                                        31406000
    release'ptr                                                         31408000
      << points to temporary area of CDS that will be re- >>            31410000
      << leased when initialization if finished.          >>            31412000
                                                                        31414000
   ,sys'lpdt                      = %10                                 31416000
      << System table pointer to the logical physical >>                31418000
      << device table.  Used to extract the device    >>                31420000
      << subtype.                                     >>                31422000
                                                                        31424000
                                                                        31426000
  ;                                                                     31428000
                                                                        31430000
                                                                        31432000
  << Constants used during initializaton >>                             31434000
                                                                        31436000
  equate                                                                31438000
                                                                        31440000
    init'record'size              = 256                                 31442000
      << size of temporary record buffer areas >>                       31444000
                                                                        31446000
   ,init'ESB'size                 = 32                                  31448000
      << size of initial environmental status block area >>             31450000
                                                                        31452000
   ,init'packet'space             = 20                                  31454000
      << size of temporary packet headers and trailers >>               31456000
                                                                        31458000
   ,fixed'overhead'size           = device'status'size                  31460000
                                  + job'report'size                     31462000
                                  + xlator'buff'size + 1                31464000
                                  + product'id'size                     31466000
                                  + log'buffer'size                     31468000
                                  + comp'status'size                    31470000
                                                                        31472000
      << amount of space in CDS that we will always need, >>            31474000
      << regardless of size of device buffers and environ- >>           31476000
      << mental status size.                               >>           31478000
                                                                        31480000
   ,debug'suptype'def             = [8/10,8/0]                          31482000
      << cds area suptype for debugging scratch areas >>                31484000
                                                                        31486000
  ;                                                                     31488000
                                                                        31490000
                                                                        31492000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE: INIT'CB'INFO"          31494000
subroutine init'cb'info;                                                31496000
                                                                        31498000
COMMENT                                                                 31500000
                                                                        31502000
  PURPOSE:                                                              31504000
    This subroutine will initialize certain variables contained         31506000
    in the control block information area of Level 7.  It is            31508000
    called once, durdata segment initialization.                        31510000
                                                                        31512000
  INPUT PARAMETERS:                                                     31514000
    None.                                                               31516000
                                                                        31518000
  OUTPUT PARAMETERS:                                                    31520000
    None.                                                               31522000
                                                                        31524000
  SIDE-EFFECTS:                                                         31526000
    Initializes parts of the control block information area             31528000
    for the logical driver.                                             31530000
                                                                        31532000
  SPECIAL CONSIDERATIONS:                                               31534000
    This procedure should only be called once, after the                31536000
    control block information area is allocated by calling              31538000
    cpr'init'cbi.  This procedure expects the variable cb'info          31540000
    to be pointing to the information area.                             31542000
                                                                        31544000
                                                                        31546000
  CHANGE HISTORY:                                                       31548000
                                                                        31550000
    As issued.                                                          31552000
                                                                        31554000
                                                                        31556000
;                                                                       31558000
begin                                                                   31560000
                                                                        31562000
  << First, initialize the logical device number >>                     31564000
                                                                        31566000
  cb'info(logical'device) := ldev;                                      31568000
                                                                        31570000
                                                                        31572000
  << Next, initialize the CIPER data segment value >>                   31574000
                                                                        31576000
  cb'info(ciper'dst) := control'table(ct'cds'dst'num);                  31578000
                                                                        31580000
                                                                        31582000
  << Initialize the device record size >>                               31584000
                                                                        31586000
  cb'info(device'buffer'size) := init'record'size;                      31588000
                                                                        31590000
                                                                        31592000
  << Initialize the environmental status tank size >>                   31594000
                                                                        31596000
  cb'info(device'env'status'size) := init'ESB'size;                     31598000
                                                                        31600000
                                                                        31602000
  << Initialize the control table pointer >>                            31604000
                                                                        31606000
  cb'info(ct'ptr) := @control'table;                                    31608000
                                                                        31610000
                                                                        31612000
  << Set ESB frequency to zero, so no ESB's will be spontan- >>         31614000
  << eously reported before anyone wants them.               >>         31616000
                                                                        31618000
  cb'info(esb'frequency) := 0;                                          31620000
                                                                        31622000
                                                                        31624000
  << Disable all logging events, unless certain events >>               31626000
  << get explicitly enabled.                           >>               31628000
                                                                        31630000
  cb'info(event'map) := %100000;                                        31632000
  cb'info(logging'dst) := nul'dseg;                                     31634000
                                                                        31636000
                                                                        31638000
  << Initialize the default access mode flag >>                         31640000
                                                                        31642000
  cb'info(default'access'mode) :=                                       31644000
     (sys'lpdt((ldev * lpdt'size) + 1).lpdt'device'subtype              31646000
      = feature'access'subtype);                                        31648000
                                                                        31650000
                                                                        31652000
  << All done! >>                                                       31654000
                                                                        31656000
end;  << init'cb'info >>                                                31658000
                                                                        31660000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE:  B08'RECORD'INIT"      31662000
logical subroutine b08'record'init(record'base);                        31664000
                                                                        31666000
  value                            record'base ;                        31668000
  integer pointer                  record'base ;                        31670000
                                                                        31672000
COMMENT                                                                 31674000
                                                                        31676000
  PURPOSE:                                                              31678000
                                                                        31680000
    This subroutine will initialize the record buffer control           31682000
    information for the record buffer area passed.  The control         31684000
    information includes the area length, record starting               31686000
    position, current position, current length, and the clean/          31688000
    dirty flag.                                                         31690000
                                                                        31692000
                                                                        31694000
  INPUT PARAMETERS:                                                     31696000
                                                                        31698000
    RECORD'BASE, which upon entry is the address of the base of         31700000
    the appropriate record buffer area (word address).                  31702000
                                                                        31704000
                                                                        31706000
  OUTPUT PARAMETERS:                                                    31708000
                                                                        31710000
    None.                                                               31712000
                                                                        31714000
                                                                        31716000
  SIDE-EFFECTS:                                                         31718000
                                                                        31720000
    None.                                                               31722000
                                                                        31724000
                                                                        31726000
  SPECIAL CONSIDERATIONS:                                               31728000
                                                                        31730000
    None.                                                               31732000
                                                                        31734000
                                                                        31736000
  CHANGE HISTORY:                                                       31738000
                                                                        31740000
    As issued.                                                          31742000
                                                                        31744000
                                                                        31746000
;                                                                       31748000
begin  << subroutine b08'record'init >>                                 31750000
  << Since the parameter passed in is really a pointer to a >>          31752000
  << pointer, chain over to the real address of the record >>           31754000
                                                                        31756000
  @record'base := @record'base;                                         31758000
                                                                        31760000
  << Plug in the overall length of the buffer area >>                   31762000
                                                                        31764000
  record'base(length) := record'overhead                                31766000
      + cb'info(packet'header'size)                                     31768000
      + cb'info(device'buffer'size) to'word                             31770000
      + cb'info(packet'trailer'size)                                    31772000
      + 1; << extra word at end may be needed during mfds >>            31774000
           << in b08'write'data                           >>            31776000
                                                                        31778000
                                                                        31780000
  << Set the record starting position past the control in- >>           31782000
  << formation and packet header space.  The amount is re- >>           31784000
  << duced by one because the record buffer is offset by   >>           31786000
  << one word (the length word at buffer(-1) )             >>           31788000
                                                                        31790000
  record'base(start) := record'overhead                                 31792000
                      + cb'info(packet'header'size) - 1;                31794000
                                                                        31796000
  << Set the current position (a byte pointer value) to      >>         31798000
  << the same position as the start.                         >>         31800000
                                                                        31802000
  record'base(current'position) := record'base(start) to'byte;          31804000
                                                                        31806000
  << Set the current length to zero >>                                  31808000
                                                                        31810000
  record'base(current'length) := 0;                                     31812000
                                                                        31814000
  << Set the maximum size equal to the reported device buf- >>          31816000
  << fer size.                                              >>          31818000
                                                                        31820000
  record'base(maximum'size) := cb'info(device'buffer'size);             31822000
                                                                        31824000
  << Link into the free-list >>                                         31826000
                                                                        31828000
  b08'release'buffer(cb'info, record'base);                             31830000
                                                                        31832000
  << Set return value equal to pointer past this new buffer >>          31834000
                                                                        31836000
  b08'record'init := @record'base + record'base(length);                31838000
                                                                        31840000
  << All done !! >>                                                     31842000
                                                                        31844000
end;  << subroutine b08'record'init >>                                  31846000
                                                                        31848000
$PAGE "PROCEDURE:  B08'INITIALIZE -- SUBROUTINE:  INIT'CDS'AREA"        31850000
subroutine init'cds'area(init'ptr, number'of'buffers);                  31852000
                                                                        31854000
  value                  init'ptr, number'of'buffers ;                  31856000
                                                                        31858000
  integer pointer        init'ptr                    ;                  31860000
                                                                        31862000
  integer                          number'of'buffers ;                  31864000
                                                                        31866000
COMMENT                                                                 31868000
                                                                        31870000
  PURPOSE:                                                              31872000
                                                                        31874000
    This subroutine will initialize a new cds area.  It will            31876000
    build all record buffer areas, status tank areas, etc.,             31878000
    and will update pointers contained in cb'info to reflect            31880000
    the new location of those areas.                                    31882000
                                                                        31884000
                                                                        31886000
  INPUT PARAMETERS:                                                     31888000
                                                                        31890000
    INIT'PTR, which upon entry is the address of the memory             31892000
      cell that contains the address of the area to initial-            31894000
      ize.                                                              31896000
                                                                        31898000
    NUMBER'OF'BUFFERS, which indicates how many record buffer           31900000
      areas to initialize in the cds area.  All of these are            31902000
      linked into the free-list, and then one is removed for            31904000
      the dedicated output buffer, and a second buffer is               31906000
      removed for the dedicated input buffer.                           31908000
                                                                        31910000
                                                                        31912000
  OUTPUT PARAMETERS:                                                    31914000
                                                                        31916000
    None.                                                               31918000
                                                                        31920000
                                                                        31922000
  SIDE-EFFECTS:                                                         31924000
                                                                        31926000
    Alters certain portions of the control block information            31928000
    area, primarily pointers to buffers and status tanks.               31930000
                                                                        31932000
                                                                        31934000
  SPECIAL CONSIDERATIONS:                                               31936000
                                                                        31938000
    This routine double checks that it has not allocated any            31940000
    memory outside of the requested cds area.  If it has, a             31942000
    call to cpr'internal'error is made.                                 31944000
                                                                        31946000
                                                                        31948000
  CHANGE HISTORY:                                                       31950000
                                                                        31952000
    As issued.                                                          31954000
                                                                        31956000
                                                                        31958000
;                                                                       31960000
$PAGE                                                                   31962000
begin  << subroutine init'cds'area >>                                   31964000
  << Calculate the storage requirements of this device >>               31966000
                                                                        31968000
  cb'info(storage'requirements) :=                                      31970000
      fixed'overhead'size                                               31972000
    + ((( cb'info(device'env'status'size)+1 ) to'word ) + 1)            31974000
    + ( number'of'buffers *                                             31976000
      ( cb'info(packet'header'size)                                     31978000
      + (cb'info(device'buffer'size) to'word)                           31980000
      + cb'info(packet'trailer'size)                                    31982000
      + record'overhead + 1 ) );                                        31984000
                                                                        31986000
  << Now get a new area of the size needed >>                           31988000
                                                                        31990000
  if cb'info(temp'area) = nil then                                      31992000
    begin                                                               31994000
      cb'info(cds'area'base) :=                                         31996000
        cpr'get'2ndary'cds'area( cb'info(storage'requirements),         31998000
                                 cbix'suptype'def lor 7,                32000000
                                 0                           );         32002000
    end                                                                 32004000
  else                                                                  32006000
    begin                                                               32008000
      cb'info(cds'area'base) :=                                         32010000
        cpr'get'cds'area( cb'info(storage'requirements),                32012000
                          cbix'suptype'def lor 7,                       32014000
                          0                              );             32016000
    end;                                                                32018000
                                                                        32020000
                                                                        32022000
  << Initialize the area pointer.  The +1 allows an offset >>           32024000
  << for the length word which is in front of each major   >>           32026000
  << area of the CBIX.                                     >>           32028000
                                                                        32030000
  @init'ptr := init'ptr + 1;                                            32032000
                                                                        32034000
  << Set up the record buffer areas >>                                  32036000
                                                                        32038000
  do                                                                    32040000
    begin                                                               32042000
      @init'ptr := b08'record'init(init'ptr);                           32044000
      number'of'buffers := number'of'buffers - 1;                       32046000
    end                                                                 32048000
  until number'of'buffers = 0;                                          32050000
                                                                        32052000
  cb'info(o'r'base) := integer( b08'get'buffer(cb'info,                 32054000
                                               no'overwrite) )          32056000
                     - cb'info(cds'area'base);                          32058000
  cb'info(i'r'base) := integer( b08'get'buffer(cb'info,                 32060000
                                               no'overwrite) )          32062000
                     - cb'info(cds'area'base);                          32064000
                                                                        32066000
                                                                        32068000
  << Set up the device status area, and move any >>                     32070000
  << old status information into the new area.   >>                     32072000
                                                                        32074000
  init'ptr(length) := device'status'size;                               32076000
                                                                        32078000
                                                                        32080000
  if cb'info(temp'area) <> 0 then                                       32082000
    begin                                                               32084000
      @release'ptr := cb'info(dev'status'base)                          32086000
                    + cb'info(temp'area);                               32088000
      move init'ptr := release'ptr,                                     32090000
         ((device'status'length+1) to'word);                            32092000
    end                                                        <<04422>>32094000
  else                                                         <<04422>>32096000
    begin                                                      <<04422>>32098000
      << Initialize the device status area so that it looks >> <<04422>>32100000
      << like the device is on-line.  That way, when the    >> <<04422>>32102000
      << first device status report is received, if the de- >> <<04422>>32104000
      << vice is off-line an operator message will get sent >> <<04422>>32106000
                                                               <<04422>>32108000
      init'ptr(on'line) := set'bit;                            <<04422>>32110000
    end;                                                       <<04422>>32112000
                                                                        32114000
  cb'info(dev'status'base) := @init'ptr                                 32116000
                            - cb'info(cds'area'base);                   32118000
  @init'ptr := @init'ptr + init'ptr(length);                            32120000
                                                                        32122000
                                                                        32124000
  << Set up the composite status area >>                                32126000
                                                                        32128000
  init'ptr(length) := comp'status'size;                                 32130000
  cb'info(composite'status'area) := @init'ptr                           32132000
                                  - cb'info(cds'area'base);             32134000
  @init'ptr := @init'ptr + init'ptr(length);                            32136000
                                                                        32138000
                                                                        32140000
  << Set up the new environmental status area. >>                       32142000
                                                                        32144000
  init'ptr(length) := 1                                                 32146000
      + ((cb'info(device'env'status'size)+1) to'word);                  32148000
                                                                        32150000
  cb'info(env'status'base) := @init'ptr                                 32152000
                            - cb'info(cds'area'base);                   32154000
  @init'ptr := @init'ptr + init'ptr(length);                            32156000
                                                                        32158000
                                                                        32160000
  << Set up the job report area >>                                      32162000
                                                                        32164000
  init'ptr(length) := job'report'size;                                  32166000
  cb'info(job'report'base) := @init'ptr                                 32168000
                            - cb'info(cds'area'base);                   32170000
  @init'ptr := @init'ptr + init'ptr(length);                            32172000
                                                                        32174000
                                                                        32176000
  << Set up the buffers for escape sequence con- >>                     32178000
  << struction by cpr'xlator.                    >>                     32180000
                                                                        32182000
  init'ptr(length) := xlator'buff'size + 1;                             32184000
  cb'info(sequence'1'buffer) := ( @init'ptr                             32186000
      - cb'info(cds'area'base) ) to'byte;                               32188000
  @init'ptr := @init'ptr + init'ptr(length);                            32190000
                                                                        32192000
                                                                        32194000
  << Finally, set up the array for the product  >>                      32196000
  << identification string.                     >>                      32198000
                                                                        32200000
  init'ptr(length) := product'id'size;                                  32202000
                                                                        32204000
  if cb'info(temp'area) <> 0 then                                       32206000
    begin                                                               32208000
      @release'ptr := cb'info(product'number) +                         32210000
                      cb'info(temp'area);                               32212000
      move init'ptr := release'ptr,(product'id'size - 1);               32214000
    end;                                                                32216000
                                                                        32218000
  cb'info(product'number) := @init'ptr                                  32220000
                           - cb'info(cds'area'base);                    32222000
  @init'ptr := @init'ptr + init'ptr(length);                            32224000
                                                                        32226000
                                                                        32228000
                                                                        32230000
  << Initialize the area used by the logging subsystem >>               32232000
                                                                        32234000
  init'ptr(length) := log'buffer'size;                                  32236000
  init'ptr := head'entry'length;                                        32238000
                                                                        32240000
  cb'info(logging'buffer) := @init'ptr                                  32242000
                           - cb'info(cds'area'base);                    32244000
                                                                        32246000
                                                                        32248000
end;  << of subroutine init'cds'area >>                                 32250000
                                                                        32252000
$PAGE "PROCEDURE:  B08'INITIALIZE -- PROCEDURE BODY"                    32254000
  init'cb'info;                                                         32256000
                                                                        32258000
  << Now tell the transport service to initialize. >>                   32260000
  << It will allocate the level dependent informa- >>                   32262000
  << tion areas it needs, and will return the size >>                   32264000
  << of headers and/or trailers it needs.          >>                   32266000
                                                                        32268000
  return'information :=                                                 32270000
    b08'network'protocol( control'table,                                32272000
                          transport'initialize,                         32274000
                          @cb'info(packet'header'size),                 32276000
                          0,                                            32278000
                          control'table(ct'cds'dst'num),                32280000
                          ldev                                          32282000
                        );                                              32284000
                                                                        32286000
  << check the return'status >>                                         32288000
  if return'status <> no'errors then return;                            32290000
                                                                        32292000
                                                                        32294000
  << Send a transport open command, to allocate the >>                  32296000
  << transport service where required.              >>                  32298000
                                                                        32300000
  return'information :=                                                 32302000
    b08'network'protocol( control'table,                                32304000
                          transport'open,                               32306000
                          0,                                            32308000
                          0,                                            32310000
                          control'table(ct'cds'dst'num),                32312000
                          ldev                                          32314000
                        );                                              32316000
                                                                        32318000
                                                                        32320000
  << Check the return'status >>                                         32322000
                                                                        32324000
  if return'status <> no'errors then return;                            32326000
                                                                        32328000
                                                                        32330000
                                                                        32332000
                                                                        32334000
  << Do minimal initialization of temporary cds area >>                 32336000
  << so we can communicate with the device.          >>                 32338000
                                                                        32340000
  init'cds'area( cb'info(cds'area'base)                                 32342000
                ,2  << # of record buffer areas >>  );                  32344000
                                                                        32346000
                                                                        32348000
  << Done with short initialization. >>                                 32350000
  << Now go through a device clear sequence, so we >>                   32352000
  << can begin communication with the peripheral.  >>                   32354000
                                                                        32356000
  return'status := b08'device'clear(cb'info,%37);                       32358000
                                                                        32360000
  << check the return'status >>                                         32362000
  if return'status <> no'errors and                                     32364000
     return'status <> pf'error then                                     32366000
    begin                                                               32368000
      << Could not complete the device clear seq- >>                    32370000
      << quence, so return with error.            >>                    32372000
                                                                        32374000
      << Deallocate the transport service. >>                           32376000
                                                                        32378000
      b08'network'protocol(control'table,                               32380000
          transport'deallocate, 0, 0,                                   32382000
          control'table(ct'cds'dst'num),ldev);                          32384000
                                                                        32386000
                                                                        32388000
                                                                        32390000
      << Set up error codes and return. >>                              32392000
      transfer'log := 0;                                                32396000
                                                                        32398000
      return;                                                           32400000
    end;                                                                32402000
                                                                        32404000
  << Now calculate, from the information the peri-   >>                 32406000
  << pheral returned, the size of the read I/O       >>                 32408000
  << record buffer areas, etc.                       >>                 32410000
                                                                        32412000
  << Save the address of the temporary area >>                          32414000
                                                                        32416000
  cb'info(temp'area) := cb'info(cds'area'base);                         32418000
                                                                        32420000
                                                                        32422000
  << Set the free'buff'list head, o'r'base, and     >>                  32424000
  << i'r'base pointers to nil, since they will not  >>                  32426000
  << be valid until init'cds'area is finished.      >>                  32428000
                                                                        32430000
  cb'info(free'buff'list) := nil;                                       32432000
  cb'info(o'r'base) := nil;                                             32434000
  cb'info(i'r'base) := nil;                                             32436000
                                                                        32438000
                                                                        32440000
  << Initialize the new cds area.  All record buf-  >>                  32442000
  << fers and status tanks will be built, and       >>                  32444000
  << cb'info will be updated accordingly.           >>                  32446000
                                                                        32448000
  init'cds'area( cb'info(cds'area'base)                                 32450000
                ,5  << # of record buffer areas >>  );                  32452000
                                                                        32454000
                                                                        32456000
  << Now that we are done with it, release the temp- >>                 32458000
  << porary area of the CIPER data segment.          >>                 32460000
                                                                        32462000
  @release'ptr := cb'info(temp'area);                                   32464000
  cpr'rel'cds'area(release'ptr);                                        32466000
  cb'info(temp'area) := nil;                                            32468000
                                                                        32470000
  << If we have gotten this far, the CIPER data seg- >>                 32472000
  << ment is initialized, so mark the initialized    >>                 32474000
  << flag true.                                      >>                 32476000
                                                                        32478000
  cb'info(initialized) := true;                                         32480000
                                                               <<04422>>32482000
                                                               <<04422>>32484000
  << Prime the status area by explicitly asking for a device >><<04422>>32486000
  << status report.  If one has already come in during the   >><<04422>>32488000
  << device clear sequence, no harm will be done in asking   >><<04422>>32490000
  << for another.                                            >><<04422>>32492000
                                                               <<04422>>32494000
  b08'buf'device'status( cb'info, 0, 0, 0, immediate );        <<04422>>32496000
                                                               <<04422>>32498000
                                                                        32500000
  << Set status return to indicate successful completion >>             32502000
                                                                        32504000
  return'status := no'errors;                                           32506000
                                                                        32508000
                                                                        32510000
end;  << of procedure b08'initialize >>                                 32512000
                                                                        32514000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR"                                     32516000
double procedure b08'logical'dvr( ldev, qmisc, dst'num,                 32518000
                                  address, function, count,             32520000
                                  parm1, parm2, flags       );          32522000
                                                                        32524000
  value                           ldev, qmisc, dst'num,                 32526000
                                  address, function, count,             32528000
                                  parm1, parm2, flags        ;          32530000
                                                                        32532000
  integer                         ldev, qmisc, dst'num,                 32534000
                                  address, function, count,             32536000
                                  parm1, parm2, flags        ;          32538000
                                                                        32540000
  option privileged, uncallable                              ;          32542000
                                                                        32544000
                                                                        32546000
COMMENT                                                                 32548000
                                                                        32550000
  PURPOSE:                                                              32552000
                                                                        32554000
    This procedure performs the functions of the CIPER logical          32556000
    driver.  Its implementation is specific to the 2608B line           32558000
    printer, however, it has been designed with the intention           32560000
    of expanding it to support the Hickory and Aspen printer            32562000
    families, as well as other future CIPER devices.                    32564000
                                                                        32566000
                                                                        32568000
  INPUT PARAMETERS:                                                     32570000
                                                                        32572000
    LDEV, the Logical DEVice number of the desired peripheral,          32574000
                                                                        32576000
    QMISC, a miscellaneous device dependent parameter,                  32578000
                                                                        32580000
    DST'NUM, which is the DST number (or zero) where the                32582000
      caller's data is located,                                         32584000
                                                                        32586000
    ADDRESS, which is the offset within a DST of the caller's           32588000
      data, or an index to a system buffer,                             32590000
                                                                        32592000
    FUNCTION, which is the function code requested by the               32594000
      caller,                                                           32596000
                                                                        32598000
    COUNT, which is a count (word or byte) describing the               32600000
      length of the caller's data buffer,                               32602000
                                                                        32604000
    PARM1, which is a request dependent flag,                           32606000
                                                                        32608000
    PARM2, which is also a request dependent flag,                      32610000
                                                                        32612000
    FLAGS, which are control and specification flags.                   32614000
                                                                        32616000
                                                                        32618000
  OUTPUT PARAMETERS:                                                    32620000
                                                                        32622000
    B08'LOGICAL'DVR is a DOUBLE procedure, and as such, returns         32624000
    the following information encoded in a double word:                 32626000
                                                                        32628000
    PCB'NUM, which is the PCB number of the calling program,            32630000
                                                                        32632000
    STATUS, which is the completion status and consists of a            32634000
      qualifier and general status fields,                              32636000
                                                                        32638000
    TRANSMISSION'LOG, which is a count of the data actually             32640000
      transferred as a result of this call.  May be in words            32642000
      (positive) or bytes (negative) depending on sense of              32644000
      COUNT parameter.                                                  32646000
                                                                        32648000
                                                                        32650000
  SIDE-EFFECTS:                                                         32652000
                                                                        32654000
    B08'LOGICAL'DVR will modify the input/output data buffers           32656000
    in the CIPER data segment.  Auxilliary information in the           32658000
    CIPER DST which describes the condition of the input/output         32660000
    buffers, peripheral state, and transport service state may          32662000
    be modified as required.                                            32664000
                                                                        32666000
                                                                        32668000
  SPECIAL CONSIDERATIONS:                                               32670000
                                                                        32672000
    When called, DB can be pointing to any data segment or the          32674000
    caller's stack (typical).  B08'logical'dvr will set DB to           32676000
    several other DST's, most notably the CIPER data segment,           32678000
    the LPDT segment, and possibly SYSGLOB.  Before returning           32680000
    to the caller, b08'logical'dvr will restore DB to the data          32682000
    segment the call was made upon.                                     32684000
                                                                        32686000
                                                                        32688000
  CHANGE HISTORY:                                                       32690000
                                                                        32692000
    As issued.                                                          32694000
                                                                        32696000
;                                                                       32698000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- LOCAL VARIABLES"                  32700000
begin                                                                   32702000
                                                                        32704000
                                                                        32706000
  logical                                                               32708000
                                                                        32710000
    exit'label'saved                                                    32712000
      << Saves exit label address in case we need it during >>          32714000
      << a cpr'shutdown.                                    >>          32716000
                                                                        32718000
  ;                                                                     32720000
                                                                        32722000
                                                                        32724000
  double                                                                32726000
                                                                        32728000
    callers'db                                                          32730000
      << Saves the DB that the caller was on upon entry >>              32732000
                                                                        32734000
  ;                                                                     32736000
                                                                        32738000
                                                                        32740000
  << CONTROL TABLE DEFINITIONS >>                                       32742000
                                                                        32744000
  logical pointer                                                       32746000
                                                                        32748000
    control'table                                                       32750000
      << points to base of control table for a particular >>            32752000
      << logical device                                   >>            32754000
                                                                        32756000
  ;                                                                     32758000
                                                                        32760000
                                                                        32762000
  integer                                                               32764000
                                                                        32766000
    callers'stk'db                                                      32768000
      << Contains DB offset from base of stack dst, if    >>            32770000
      << source of caller's data is the stack.            >>            32772000
                                                                        32774000
  ;                                                                     32776000
                                                                        32778000
                                                                        32780000
  << Declarations required for NO-WAIT I/O >>                           32782000
                                                                        32784000
  double                                                                32786000
                                                                        32788000
    current'dst                                                         32790000
      << Used by ChangeDB to save dst number that we are >>             32792000
      << leaving.                                        >>             32794000
                                                                        32796000
  ;                                                                     32798000
                                                                        32800000
  logical                                                               32802000
                                                                        32804000
    called'on'stack                                                     32806000
      << set to true if dst'num reflects a stack dst, false >>          32808000
      << otherwise (XDS or SBUF)                            >>          32810000
                                                                        32812000
  ;                                                                     32814000
                                                                        32816000
                                                                        32818000
  integer pointer                                                       32820000
                                                                        32822000
    ioqp                                                                32824000
      << contains SYSDB relative IOQ address >>                         32826000
                                                                        32828000
   ,ioq'table'base                = DB+5                                32830000
      << SYSDB relative address of IOQ table.  IS ONLY >>               32832000
      << VALID WHEN DB IS SET TO SYSDB !!!             >>               32834000
                                                                        32836000
                                                                        32838000
    ;                                                                   32840000
                                                                        32842000
                                                                        32844000
  define                                                                32846000
                                                                        32848000
    ioq'flags                     = 0 #                                 32850000
                                                                        32852000
   ,ioq'sysbuf'flag               = 0).(3:1 #                           32854000
                                                                        32856000
   ,ioq'iowake                    = 0).(4:1 #                           32858000
                                                                        32860000
   ,ioq'link                      = 1 #                                 32862000
                                                                        32864000
   ,ioq'ldev                      = 2 #                                 32866000
                                                                        32868000
   ,ioq'misc                      = 3 #                                 32870000
                                                                        32872000
   ,ioq'dstn'stack'bit            = 4).(0:1 #                           32874000
                                                                        32876000
   ,ioq'dstn                      = 4).(1:15 #                          32878000
                                                                        32880000
   ,ioq'address                   = 5 #                                 32882000
                                                                        32884000
   ,ioq'function                  = 6).(8:8 #                           32886000
                                                                        32888000
   ,ioq'transfer'log              = 7 #                                 32890000
                                                                        32892000
   ,ioq'p1                        = 8 #                                 32894000
                                                                        32896000
   ,ioq'p2                        = 9 #                                 32898000
                                                                        32900000
   ,ioq'status                    = 10 #                                32902000
                                                                        32904000
;                                                                       32906000
                                                                        32908000
                                                                        32910000
                                                                        32912000
  equate                                                                32914000
                                                                        32916000
    pcbb                          = 3                                   32918000
      << absolute base of process control block table >>                32920000
                                                                        32922000
   ,cpcb                          = 4                                   32924000
      << absolute address of current process control block >>           32926000
      << pointer.                                          >>           32928000
                                                                        32930000
  ;                                                                     32932000
                                                                        32934000
                                                                        32936000
  << CONTROL BLOCK DEFINITIONS >>                                       32938000
                                                                        32940000
  logical pointer                                                       32942000
                                                                        32944000
    control'block                                                       32946000
      << points to base of control block for Level 7 >>                 32948000
  ;                                                                     32950000
                                                                        32952000
                                                                        32954000
  << CONTROL BLOCK INFORMATION AREA DEFINITIONS >>                      32956000
                                                                        32958000
  integer pointer                                                       32960000
                                                                        32962000
    cb'info                                                             32964000
      << points to base of level dependent information area >>          32966000
  ;                                                                     32968000
                                                                        32970000
                                                                        32972000
  << MISCELLANEOUS VARIABLES >>                                         32974000
                                                                        32976000
                                                                        32978000
  double                                                                32980000
                                                                        32982000
    return'information            = b08'logical'dvr                     32984000
      << Used for completion status from all procedure   >>             32986000
      << calls.  First word is status, second word is    >>             32988000
      << transfer count (if appropriate).                >>             32990000
                                                                        32992000
  ;                                                                     32994000
                                                                        32996000
  integer                                                               32998000
                                                                        33000000
    return'status                 = return'information                  33002000
      << used for error checking from other procedures >>               33004000
                                                                        33006000
   ,transfer'log                  = return'information + 1              33008000
      << Transfer count or auxilliary information >>                    33010000
                                                                        33012000
  ;                                                                     33014000
                                                               <<04422>>33016000
                                                               <<04422>>33018000
  logical                                                      <<04422>>33020000
                                                               <<04422>>33022000
    saved'critical'value                                       <<04422>>33024000
      << Saves value returned from setcritical call.  Used >>  <<04422>>33026000
      << when calling resetcritical.                       >>  <<04422>>33028000
                                                               <<04422>>33030000
  ;                                                            <<04422>>33032000
                                                                        33034000
                                                                        33036000
                                                                        33038000
  define                                                                33040000
                                                                        33042000
    translate                     = true #                              33044000
      << indicates cpr'xlate should convert function codes >>           33046000
      << to escape sequences                               >>           33048000
                                                                        33050000
   ,no'translate                  = false #                             33052000
      << indicates cpr'xlate should not be used to convert >>           33054000
      << MPE function codes into device escape sequences   >>           33056000
                                                                        33058000
  ;                                                                     33060000
                                                                        33062000
                                                                        33064000
                                                                        33066000
$IF X7 = ON  << ON = LOGGING, OFF = NO LOGGING >>                       33068000
                                                                        33070000
  << Variables used for performance logging >>                          33072000
                                                                        33074000
  double                                                                33076000
                                                                        33078000
    entry'time                                                          33080000
      << Saves timer count at entry to logical driver >>                33082000
                                                                        33084000
  ;                                                                     33086000
                                                                        33088000
  integer array                                                         33090000
                                                                        33092000
    qm14(*)                       = q-14                                33094000
      << points to base of parameters passed to driver >>               33096000
                                                                        33098000
  ;                                                                     33100000
                                                                        33102000
                                                                        33104000
  integer                                                               33106000
                                                                        33108000
    final'time'1                  = entry'time                          33110000
   ,final'time'2                  = entry'time + 1                      33112000
      << upper and lower words of entry'time >>                         33114000
                                                                        33116000
  ;                                                                     33118000
                                                                        33120000
                                                                        33122000
  integer pointer                                                       33124000
                                                                        33126000
    log'buffer                                                          33128000
      << points to buffer area used to assemble log  >>                 33130000
      << records before they are moved to the logging dst >>            33132000
                                                                        33134000
  ;                                                                     33136000
                                                                        33138000
                                                                        33140000
double procedure timer;                                                 33142000
                                                                        33144000
  option external, privileged;                                          33146000
                                                                        33148000
$IF                                                                     33150000
                                                                        33152000
  declare'move'from'data'segment;                                       33154000
  declare'move'to'data'segment;                                         33156000
                                                                        33158000
$IF X7 = ON  << ON = INCLUDE LOGGING >>                                 33160000
$PAGE "LOGGING UTILITIES:  USER SUBROUTINES"                            33162000
logical subroutine get'log'buffer(log'buffer);                          33164000
                                                                        33166000
  value                           log'buffer ;                          33168000
                                                                        33170000
  integer pointer                 log'buffer ;                          33172000
                                                                        33174000
COMMENT                                                                 33176000
                                                                        33178000
  PURPOSE:                                                              33180000
                                                                        33182000
    This subroutine will return the address of the logging              33184000
    buffer in the CIPER data segment.                                   33186000
                                                                        33188000
                                                                        33190000
  INPUT PARAMETERS:                                                     33192000
                                                                        33194000
    LOG'BUFFER, which is a dummy parameter used solely as               33196000
      a scratch variable.                                               33198000
                                                                        33200000
                                                                        33202000
  OUTPUT PARAMETERS:                                                    33204000
                                                                        33206000
    GET'LOG'BUFFER, which returns a DB relative address to              33208000
      the logging buffer.                                               33210000
                                                                        33212000
                                                                        33214000
  SIDE-EFFECTS:                                                         33216000
                                                                        33218000
    None.                                                               33220000
                                                                        33222000
                                                                        33224000
  SPECIAL CONSIDERATIONS:                                               33226000
                                                                        33228000
    None.                                                               33230000
                                                                        33232000
                                                                        33234000
  CHANGE HISTORY:                                                       33236000
                                                                        33238000
    As issued.                                                          33240000
                                                                        33242000
;                                                                       33244000
                                                                        33246000
begin                                                                   33248000
                                                                        33250000
  @log'buffer := cb'info(logging'buffer)                                33252000
               + cb'info(cds'area'base);                                33254000
  get'log'buffer := @log'buffer + log'buffer;                           33256000
                                                                        33258000
end;                                                                    33260000
                                                                        33262000
$PAGE                                                                   33264000
subroutine get'head'entry(log'buffer);                                  33266000
                                                                        33268000
  value                   log'buffer ;                                  33270000
                                                                        33272000
  integer pointer         log'buffer ;                                  33274000
                                                                        33276000
COMMENT                                                                 33278000
                                                                        33280000
  PURPOSE:                                                              33282000
                                                                        33284000
    This subroutine will move the head entry from the current           33286000
    logging dst into the base of the logging buffer in the              33288000
    CIPER data segment.                                                 33290000
                                                                        33292000
                                                                        33294000
  INPUT PARAMETERS:                                                     33296000
                                                                        33298000
    LOG'BUFFER, which points to the logging buffer in the               33300000
      CIPER data segment.                                               33302000
                                                                        33304000
                                                                        33306000
  OUTPUT PARAMETERS:                                                    33308000
                                                                        33310000
    None.                                                               33312000
                                                                        33314000
                                                                        33316000
  SIDE-EFFECTS:                                                         33318000
                                                                        33320000
    None.                                                               33322000
                                                                        33324000
                                                                        33326000
  SPECIAL CONSIDERATIONS:                                               33328000
                                                                        33330000
    None.                                                               33332000
                                                                        33334000
  CHANGE HISTORY:                                                       33336000
                                                                        33338000
    As issued.                                                          33340000
                                                                        33342000
;                                                                       33344000
                                                                        33346000
begin                                                                   33348000
                                                                        33350000
  @log'buffer := cb'info(logging'buffer)                                33352000
               + cb'info(cds'area'base);                                33354000
  mfds(log'buffer,cb'info(logging'dst),0,1);                            33356000
  mfds(log'buffer(1),cb'info(logging'dst),1,log'buffer-1);              33358000
                                                                        33360000
end;                                                                    33362000
                                                                        33364000
$PAGE                                                                   33366000
subroutine put'head'entry(log'buffer);                                  33368000
                                                                        33370000
  value                   log'buffer ;                                  33372000
                                                                        33374000
  integer pointer         log'buffer ;                                  33376000
                                                                        33378000
COMMENT                                                                 33380000
                                                                        33382000
  PURPOSE:                                                              33384000
                                                                        33386000
    This subroutine will move the head entry from the logging           33388000
    buffer of the CIPER data segment into the base of the               33390000
    current logging dst.                                                33392000
                                                                        33394000
                                                                        33396000
  INPUT PARAMETERS:                                                     33398000
                                                                        33400000
    LOG'BUFFER, which points to the logging buffer in the               33402000
      CIPER data segment.                                               33404000
                                                                        33406000
                                                                        33408000
  OUTPUT PARAMETERS:                                                    33410000
                                                                        33412000
    None.                                                               33414000
                                                                        33416000
                                                                        33418000
  SIDE-EFFECTS:                                                         33420000
                                                                        33422000
    None.                                                               33424000
                                                                        33426000
                                                                        33428000
  SPECIAL CONSIDERATIONS:                                               33430000
                                                                        33432000
    None.                                                               33434000
                                                                        33436000
  CHANGE HISTORY:                                                       33438000
                                                                        33440000
    As issued.                                                          33442000
                                                                        33444000
;                                                                       33446000
                                                                        33448000
begin                                                                   33450000
                                                                        33452000
  @log'buffer := cb'info(logging'buffer)                                33454000
               + cb'info(cds'area'base);                                33456000
  mtds(cb'info(logging'dst),0,log'buffer,log'buffer);                   33458000
                                                                        33460000
end;                                                                    33462000
                                                                        33464000
$PAGE                                                                   33466000
subroutine put'log'entry(log'buffer);                                   33468000
                                                                        33470000
  value                  log'buffer ;                                   33472000
                                                                        33474000
  integer pointer        log'buffer ;                                   33476000
                                                                        33478000
COMMENT                                                                 33480000
                                                                        33482000
  PURPOSE:                                                              33484000
                                                                        33486000
    This subroutine will move information from the logging              33488000
    buffer of the CIPER data segment to the next available              33490000
    location in the current logging dst.                                33492000
                                                                        33494000
                                                                        33496000
  INPUT PARAMETERS:                                                     33498000
                                                                        33500000
    LOG'BUFFER, which points to the logging buffer in the               33502000
      CIPER data segment.                                               33504000
                                                                        33506000
                                                                        33508000
  OUTPUT PARAMETERS:                                                    33510000
                                                                        33512000
    None.                                                               33514000
                                                                        33516000
                                                                        33518000
  SIDE-EFFECTS:                                                         33520000
                                                                        33522000
    Can cause a new logging data segment to be allocated,               33524000
    linking the new and old together in a linked list.                  33526000
                                                                        33528000
                                                                        33530000
  SPECIAL CONSIDERATIONS:                                               33532000
                                                                        33534000
    None.                                                               33536000
                                                                        33538000
  CHANGE HISTORY:                                                       33540000
                                                                        33542000
    As issued.                                                          33544000
                                                                        33546000
;                                                                       33548000
                                                                        33550000
begin                                                                   33552000
                                                                        33554000
  if ( log'buffer(he'next'word) + log'buffer(log'entry'length) )        33556000
     > log'buffer(he'last'word) then                                    33558000
    begin                                                               33560000
      if not b08'init'log'dst(cb'info,log'dst'size) then return;        33562000
    end;                                                                33564000
                                                                        33566000
  mtds(cb'info(logging'dst),log'buffer(he'next'word),log'buffer,        33568000
       log'buffer(log'entry'length));                                   33570000
                                                                        33572000
  log'buffer(he'next'word) := log'buffer(he'next'word)                  33574000
                         + log'buffer(log'entry'length);                33576000
                                                                        33578000
end;                                                                    33580000
$PAGE                                                                   33582000
logical subroutine event'enabled(event);                                33584000
                                                                        33586000
  value                          event ;                                33588000
                                                                        33590000
  integer                        event ;                                33592000
                                                                        33594000
                                                                        33596000
COMMENT                                                                 33598000
                                                                        33600000
  PURPOSE:                                                              33602000
                                                                        33604000
    This subroutine will check the event map of cb'info to de-          33606000
    termine if logging has been enabled for this event.  If it          33608000
    has, the routine will return true.  False is returned               33610000
    otherwise.                                                          33612000
                                                                        33614000
                                                                        33616000
  INPUT PARAMETERS:                                                     33618000
                                                                        33620000
    EVENT, which indicates the event to check.  Valid events            33622000
      range from 1 to 15 (will be expanded later).  Any other           33624000
      value produces an immediate return.                               33626000
                                                                        33628000
                                                                        33630000
  OUTPUT PARAMETERS:                                                    33632000
                                                                        33634000
    EVENT'ENABLED, which is the function return of the subrou-          33636000
      tine.  If the particular event has been enabled, a value          33638000
      of true is returned.  Otherwise, a value of false is re-          33640000
      turned.                                                           33642000
                                                                        33644000
                                                                        33646000
  SIDE-EFFECTS:                                                         33648000
                                                                        33650000
    None.                                                               33652000
                                                                        33654000
                                                                        33656000
  SPECIAL CONSIDERATIONS:                                               33658000
                                                                        33660000
    None.                                                               33662000
                                                                        33664000
                                                                        33666000
  CHANGE HISTORY:                                                       33668000
                                                                        33670000
                                                                        33672000
                                                                        33674000
                                                                        33676000
;                                                                       33678000
begin                                                                   33680000
                                                                        33682000
  if event <= 0 or event > 15 then                                      33684000
    begin                                                               33686000
      event'enabled := false;                                           33688000
    end                                                                 33690000
  else                                                                  33692000
    begin                                                               33694000
      x := event;                                                       33696000
      event := %40000;                                                  33698000
      while dxbz do event := event & csr(1);                            33700000
      event := integer( logical( event ) lor %100000 );                 33702000
      event'enabled := integer                                          33704000
        (logical( cb'info(event'map) ) land logical( event ) )          33706000
        > 0;                                                            33708000
    end;                                                                33710000
                                                                        33712000
end; << of subroutine event'enabled >>                                  33714000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- SUBROUTINE:  COMPLETE'LOG'ENTRY"  33716000
subroutine complete'log'entry;                                          33718000
                                                                        33720000
COMMENT                                                                 33722000
                                                                        33724000
  PURPOSE:                                                              33726000
                                                                        33728000
    This subroutine is called just prior to exiting the logical         33730000
    driver.  It will calculate the time spent in the driver,            33732000
    and will complete a log entry if logging is enabled for             33734000
    pcal/exit time.                                                     33736000
                                                                        33738000
                                                                        33740000
  INPUT PARAMETERS:                                                     33742000
                                                                        33744000
    None.                                                               33746000
                                                                        33748000
                                                                        33750000
  OUTPUT PARAMETERS:                                                    33752000
                                                                        33754000
    None.                                                               33756000
                                                                        33758000
                                                                        33760000
  SIDE-EFFECTS:                                                         33762000
                                                                        33764000
    None.                                                               33766000
                                                                        33768000
                                                                        33770000
  SPECIAL CONSIDERATIONS:                                               33772000
                                                                        33774000
    None.                                                               33776000
                                                                        33778000
                                                                        33780000
  CHANGE HISTORY:                                                       33782000
                                                                        33784000
    As issued.                                                          33786000
                                                                        33788000
                                                                        33790000
;                                                                       33792000
$PAGE                                                                   33794000
begin                                                                   33796000
  << Determine if logging for pcal/exit is enabled.  If it >>           33798000
  << is, then complete the log entry and put it in the log- >>          33800000
  << ging dst.                                              >>          33802000
                                                                        33804000
  if event'enabled(pcal'exit'time) then                                 33806000
    begin                                                               33808000
                                                                        33810000
      << Get the logging buffer address >>                              33812000
                                                                        33814000
      @log'buffer := get'log'buffer(log'buffer);                        33816000
                                                                        33818000
                                                                        33820000
      << Calculate the total elapsed time spent in the >>               33822000
      << driver.                                                        33824000
                                                                        33826000
      entry'time := timer - entry'time;                                 33828000
                                                                        33830000
                                                                        33832000
      << Move all the appropriate info into the logging >>              33834000
      << buffer.                                        >>              33836000
                                                                        33838000
      log'buffer(log'entry'length) := 15;                               33840000
      log'buffer(log'entry'type) := execution'time;                     33842000
                                                                        33844000
      x := log'entry'data;                                              33846000
      do                                                                33848000
        begin                                                           33850000
          log'buffer(x) := qm14(x);                                     33852000
          x := x + 1;                                                   33854000
        end                                                             33856000
      until x = 11;                                                     33858000
                                                                        33860000
      log'buffer(log'entry'data+9) := return'status;                    33862000
      log'buffer(x := x + 1) := transfer'log;                           33864000
                                                                        33866000
      log'buffer(x := x + 1) := final'time'1;                           33868000
      log'buffer(x := x + 1) := final'time'2;                           33870000
                                                                        33872000
                                                                        33874000
      << Now put the log entry into the log dst >>                      33876000
                                                                        33878000
      put'log'entry(log'buffer);                                        33880000
                                                                        33882000
    end;                                                                33884000
                                                                        33886000
end;  << of subroutine complete'log'entry >>                            33888000
$IF                                                                     33890000
$PAGE "PROC:  B08'LOGICAL'DVR -- SUBROUTINE:  B08'MODIFY'RETURN'STATUS" 33892000
integer subroutine b08'modify'return'status( cb'info,                   33894000
                                             current'status );          33896000
                                                                        33898000
  value                                      cb'info,                   33900000
                                             current'status  ;          33902000
                                                                        33904000
  logical pointer                            cb'info         ;          33906000
                                                                        33908000
  integer                                    current'status  ;          33910000
                                                                        33912000
                                                                        33914000
COMMENT                                                                 33916000
                                                                        33918000
  PURPOSE:                                                              33920000
                                                                        33922000
    This subroutine will determine if the driver completion             33924000
    status should be modified to reflect the fact that some             33926000
    new type of status report has been received during the              33928000
    time the logical driver was active.  This subroutine will           33930000
    only modify a good completion (%1) to a %41 completion.             33932000
                                                                        33934000
                                                                        33936000
  INPUT PARAMETERS:                                                     33938000
                                                                        33940000
    CB'INFO, which points to the control block information              33942000
      area for the logical driver.  This area contains global           33944000
      information for the logical driver, including the bit             33946000
      mask that determines which types of status are to be              33948000
      reported.                                                         33950000
                                                                        33952000
    CURRENT'STATUS, which is the driver completion status that          33954000
      will be passed back to the caller.                                33956000
                                                                        33958000
                                                                        33960000
  OUTPUT PARAMETERS:                                                    33962000
                                                                        33964000
    B08'MODIFY'STATUS'RETURN, which is the completion status            33966000
      after modification (if any).                                      33968000
                                                                        33970000
                                                                        33972000
  SIDE-EFFECTS:                                                         33974000
                                                                        33976000
    The status'reported bit map contained in cb'info will be            33978000
    updated to reflect the latest status information reported           33980000
    to the caller.                                                      33982000
                                                                        33984000
                                                                        33986000
  SPECIAL CONSIDERATIONS:                                               33988000
                                                                        33990000
    None.                                                               33992000
                                                                        33994000
                                                                        33996000
  CHANGE HISTORY:                                                       33998000
                                                                        34000000
    As issued.                                                          34002000
                                                                        34004000
;                                                                       34006000
begin                                                                   34008000
                                                                        34010000
  if ((cb'info(status'enabled) land cb'info(status'received))           34012000
      land not cb'info(status'reported)) <> 0 then                      34014000
    begin                                                               34016000
                                                                        34018000
      cb'info(status'reported) :=                                       34020000
        cb'info(status'enabled) land cb'info(status'received);          34022000
                                                                        34024000
      b08'modify'return'status :=                                       34026000
        integer( logical( current'status ) lor %40 );                   34028000
                                                                        34030000
    end                                                                 34032000
  else                                                                  34034000
    begin                                                               34036000
                                                                        34038000
      b08'modify'return'status := current'status;                       34040000
                                                                        34042000
    end;                                                                34044000
                                                                        34046000
end;  << of subroutine b08'modify'return'status >>                      34048000
$PAGE "PROCEDURE: B08'LOGICAL'DVR -- SUBROUTINE: SET'STATUS'FOR'RETURN" 34050000
integer subroutine set'status'for'return;                               34052000
                                                                        34054000
COMMENT                                                                 34056000
                                                                        34058000
  PURPOSE:                                                              34060000
                                                                        34062000
    This subroutine determines if the caller specified no-wait          34064000
    I/O, and if so, allocates an IOQ to place the completion            34066000
    information into.  The SYSDB relative IOQ index is then             34068000
    passed back as the first word of the double word completion         34070000
    status.  If the caller specified blocked I/O, nothing is            34072000
    done, as the double word is already set up.                         34074000
                                                                        34076000
                                                                        34078000
  INPUT PARAMETERS:                                                     34080000
                                                                        34082000
    None.                                                               34084000
                                                                        34086000
                                                                        34088000
  OUTPUT PARAMETERS:                                                    34090000
                                                                        34092000
    None.                                                               34094000
                                                                        34096000
                                                                        34098000
  SIDE-EFFECTS:                                                         34100000
                                                                        34102000
    None.                                                               34104000
                                                                        34106000
                                                                        34108000
  SPECIAL CONSIDERATIONS:                                               34110000
                                                                        34112000
    None.                                                               34114000
                                                                        34116000
                                                                        34118000
  CHANGE HISTORY:                                                       34120000
                                                                        34122000
    As issued.                                                          34124000
                                                                        34126000
                                                                        34128000
;                                                                       34130000
                                                                        34132000
begin                                                                   34134000
                                                                        34136000
  << First, modify the return status (if the completion is >>           34138000
  << good) to reflect the receipt of any status reports    >>           34140000
                                                                        34142000
  if return'status.general = successful then                            34144000
    begin                                                               34146000
      return'status.overall := b08'modify'return'status                 34148000
            (cb'info, return'status);                                   34150000
    end;                                                                34152000
                                                                        34154000
                                                                        34156000
  << If the request type is 3 or 7, then it is unblocked >>             34158000
  << with no PCB.  This means that we return status of one, >>          34160000
  << transfer log of zero, and return any sytem buffers.    >>          34162000
                                                                        34164000
  if flags.request'type = 3                                             34166000
  or flags.request'type = 7                                             34168000
  then                                                                  34170000
    begin                                                               34172000
      return'status := 1;                                               34174000
      transfer'log := 0;                                                34176000
      if (flags.system'buffers = 1) and (address <> 0) then             34178000
        begin                                                           34180000
          current'dst := changeDB(sysdb);                               34182000
          returnsysbuf(address);                                        34184000
          changeDB(current'dst);                                        34186000
        end;                                                            34188000
    end                                                                 34190000
  else                                                                  34192000
    begin                                                               34194000
                                                                        34196000
      << Next, check to see if no-wait I/O was specified >>             34198000
                                                                        34200000
      if flags.request'type <> blocked then                             34202000
        begin                                                           34204000
          << First, we must change DB to SYSDB >>                       34206000
                                                                        34208000
          current'dst := changedb(sysdb);                               34210000
                                                                        34212000
          << Get an IOQ from the primary table, impeding if >>          34214000
          << none are available.                            >>          34216000
                                                                        34218000
          @ioqp := getioq(0);                                           34220000
                                                                        34222000
          << Move in all of the appropriate information >>              34224000
          << Plugging %1000 into the flags word of the IOQ >>           34226000
          << sets the completed bit.  Word 0 is flags.     >>           34228000
                                                                        34230000
          ioqp := %1000;                                                34232000
                                                                        34234000
          ioqp(ioq'sysbuf'flag) := flags.system'buffers;                34236000
          ioqp(ioq'iowake) := flags.wake'bit;                           34238000
          ioqp(ioq'link) := 0;                                          34240000
          ioqp(ioq'ldev) := ldev;                                       34242000
          ioqp(ioq'misc) := qmisc;                                      34244000
          ioqp(ioq'dstn) := dst'num;                                    34246000
          ioqp(ioq'dstn'stack'bit) := called'on'stack;                  34248000
          ioqp(ioq'address) := address;                                 34250000
          ioqp(ioq'function) := function;                               34252000
          ioqp(ioq'transfer'log) := transfer'log;                       34254000
          ioqp(ioq'p1) := parm1;                                        34256000
          ioqp(ioq'p2) := parm2;                                        34258000
          ioqp(ioq'status) := return'status;                            34260000
                                                                        34262000
          << Modify the return information so it points to  >>          34264000
          << the IOQ just obtained.                         >>          34266000
                                                                        34268000
          return'status := @ioqp - @ioq'table'base;                     34270000
          transfer'log := 0;                                            34272000
                                                                        34274000
          << Now return to the CIPER data segment >>                    34276000
                                                                        34278000
          changedb(current'dst);                                        34280000
                                                                        34282000
        end;                                                            34284000
    end;                                                                34286000
                                                                        34288000
                                                                        34290000
  << If logging is enabled, complete the pcal/exit log entry >>         34292000
                                                                        34294000
$IF X7 = ON  << ON = LOGGING, OFF = NO LOGGING >>                       34296000
                                                                        34298000
  if @control'table is'not'nil then complete'log'entry;                 34300000
                                                                        34302000
$IF                                                                     34304000
                                                                        34306000
                                                                        34308000
  << Now change back to the caller's dst >>                             34310000
                                                                        34312000
  if @control'table is'not'nil then                                     34314000
    begin                                                               34316000
                                                                        34318000
      cpr'rel'ct(control'table, callers'db);                            34320000
                                                                        34322000
    end;                                                                34324000
                                                                        34326000
                                                                        34328000
end;  << of subroutine set'status'for'return >>                         34330000
$PAGE "PROCEDURE:  B08'LOGICAL'DVR -- PROCEDURE BODY"                   34332000
  << Save entry time for later logging, if enabled >>                   34334000
                                                                        34336000
$IF X7 = ON  << LOGGING: ON = DO IT, OFF = NO LOGGING >>                34338000
  entry'time := timer;                                                  34340000
$IF                                                                     34342000
                                                                        34344000
                                                                        34346000
  << Make sure there is enough room on the stack for all of >> <<04422>>34348000
  << CIPER's local variables, as well as the rest of the IO >> <<04422>>34350000
  << system.  If there is, setcritical so we cannot get     >> <<04422>>34352000
  << aborted (which could leave behind a dirty CDS).        >> <<04422>>34354000
                                                               <<04422>>34356000
  assemble ( adds 255;   << Our stack space requirements >>    <<04422>>34358000
             adds 255;   << I/O system's requirements    >>    <<04422>>34360000
             subs 255;   << If we didn't trap, drop the  >>    <<04422>>34362000
             subs 255    << stack back.                  >>    <<04422>>34364000
           );                                                  <<04422>>34366000
                                                               <<04422>>34368000
  saved'critical'value := setcritical;                         <<04422>>34370000
                                                               <<04422>>34372000
                                                               <<04422>>34374000
  << TURN OFF INTERNAL TRAPS >>                                         34376000
                                                                        34378000
  Turnofftraps;                                                         34380000
                                                                        34382000
                                                                        34384000
  << Save the label address of the end of the procedure >>              34386000
  << in case the shutdown procedure needs it.           >>              34388000
                                                                        34390000
  exit'label'saved := @exit'label;                                      34392000
                                                                        34394000
                                                                        34396000
  << Get on the caller's stack as a reference point for >>              34398000
  << cpr'get'ct'of to use.                              >>              34400000
                                                                        34402000
  callers'db := changedb( 0D );                                         34404000
                                                                        34406000
                                                                        34408000
  << Determine if the caller gave us the stack, an extra  >>            34410000
  << data segment, or a system buffer as the source of    >>            34412000
  << the data to be sent.                                 >>            34414000
                                                                        34416000
  if not logical( flags.system'buffers ) then                           34418000
    begin                                                               34420000
      << It's not system buffers, so determine if stack or >>           34422000
      << an extra data segment.  If it is the stack, then  >>           34424000
      << we need the dst number and an adjustment for the  >>           34426000
      << DB offset.                                        >>           34428000
                                                                        34430000
      if dst'num = 0 then                                               34432000
        begin                                                           34434000
          << On the stack >>                                            34436000
                                                                        34438000
          called'on'stack := true;                                      34440000
          dst'num := abs( abs( cpcb ) + 3 ).(1:10);                     34442000
          mfds(callers'stk'db, dst'num, 1, 1);                          34444000
          address := address + callers'stk'db;                          34446000
        end                                                             34448000
      else                                                              34450000
        begin                                                           34452000
          called'on'stack := false;                                     34454000
        end;                                                            34456000
    end                                                                 34458000
  else                                                                  34460000
    begin                                                               34462000
      called'on'stack := false;                                         34464000
    end;                                                                34466000
                                                                        34468000
                                                                        34470000
  << Get the pointer to the control table for this logical >>           34472000
  << device (also switches DB to the CIPER data segment).  >>           34474000
                                                                        34476000
  @control'table := nil;                                                34478000
  @control'table := cpr'get'ct'of(ldev, callers'db);                    34480000
                                                                        34482000
  << check to make sure we were able to get into the control >>         34484000
  << table.  If we couldn't, it is a fatal error.            >>         34486000
                                                                        34488000
  if @control'table = nil then                                          34490000
    begin                                                               34492000
      << Do nothing but die >>                                          34494000
                                                                        34496000
      cpr'internal'error;                                               34498000
    end;                                                                34500000
                                                                        34502000
  << The following check is for spooler debugging. >>                   34504000
                                                                        34506000
  if @control'table < nil then                                          34508000
    begin                                                               34510000
      @control'table := -@control'table;                                34512000
      debug;                                                            34514000
    end;                                                                34516000
                                                                        34518000
                                                                        34520000
  << Get the pointer to the control block for this level. >>            34522000
                                                                        34524000
  @control'block := cpr'cb'of(control'table,7);                         34526000
                                                                        34528000
  cpr'assertion(@control'block <> nil);                                 34530000
                                                                        34532000
                                                                        34534000
  << Now check the information area pointer of the control >>           34536000
  << block.  If it is zero, we have never initialized.     >>           34538000
                                                                        34540000
  if control'block(cb'info'ptr) = nil then                              34542000
    begin                                                               34544000
      << There is no level dependent information area for  >>           34546000
      << this device, so we must need to initialize.       >>           34548000
                                                                        34550000
      @cb'info := cpr'init'cbi(control'block,cb'info'size);             34552000
                                                                        34554000
      return'information :=                                             34556000
        b08'initialize( control'table,                                  34558000
                        control'block,                                  34560000
                        cb'info,                                        34562000
                        ldev              );                            34564000
                                                                        34566000
      if return'status <> no'errors then                                34568000
        begin                                                           34570000
                                                                        34572000
          << Clean up so next call can try again >>                     34574000
                                                                        34576000
          control'block(cb'info'ptr) := nil;                            34578000
                                                                        34580000
          if cb'info(cds'area'base) <> nil then                         34582000
            begin                                                       34584000
              @control'block := cb'info(cds'area'base);                 34586000
              cpr'rel'cds'area(control'block);                          34588000
            end;                                                        34590000
                                                                        34592000
          if cb'info(temp'area) <> cb'info(cds'area'base)               34594000
          and cb'info(temp'area) <> nil then                            34596000
            begin                                                       34598000
              @control'block := cb'info(temp'area);                     34600000
              cpr'rel'cds'area(control'block);                          34602000
            end;                                                        34604000
                                                                        34606000
          cpr'rel'cds'area(cb'info);                                    34608000
                                                                        34610000
          go to exit'label;                                    <<04422>>34614000
                                                                        34616000
        end;                                                            34618000
                                                                        34620000
                                                                        34622000
                                                                        34624000
    end   << of if cb'info'ptr = 0 ... >>                               34626000
  else                                                                  34628000
    begin                                                               34630000
      << There is a cb'info area set aside, so set up  >>               34632000
      << the pointer, then check to make sure it was   >>               34634000
      << properly initialized.                         >>               34636000
                                                                        34638000
                                                                        34640000
      @cb'info := control'block(cb'info'ptr);                           34642000
                                                                        34644000
      << Check the initialization flag. >>                              34646000
                                                                        34648000
      if not logical(cb'info(initialized)) then                         34650000
        begin                                                           34652000
          << Cb'info was allocated but not completely init- >>          34654000
          << ialized, so an error must have occurred then.  >>          34656000
          << We cannot do anything but die.                 >>          34658000
                                                                        34660000
          cpr'internal'error;                                           34662000
        end;                                                            34664000
                                                                        34666000
    end;  << of if cb'info'ptr <> 0 >>                                  34668000
                                                                        34670000
                                                                        34672000
  << Now decide if the composite status area should be    >>            34674000
  << cleared.  Normally it is at the start of each call   >>            34676000
  << to the logical driver, but if this is a call to re-  >>            34678000
  << turn that information, then obviously we shouldn't   >>            34680000
  << clear it.                                            >>            34682000
                                                                        34684000
  if logical( cb'info(comp'stat'available) )                            34686000
  and function <> read'avail'status'types                      <<04422>>34688000
  and function <> environmental'status                         <<04422>>34690000
  and function <> device'status'composite then                          34692000
    begin                                                               34694000
                                                                        34696000
      b08'clean'comp'status( cb'info );                                 34698000
                                                                        34700000
    end;                                                                34702000
                                                                        34704000
                                                                        34706000
  << We are now ready to process the caller's request.  >>              34708000
  << Hash the function code into a small contiguous set >>              34710000
  << and select the appropriate case.                   >>              34712000
                                                                        34714000
  case b08'hash'function'code(function) of                              34716000
    begin                                                               34718000
                                                                        34720000
<< ----- invalid function code.  set completion code as such >>         34722000
<<>>                                                                    34724000
<<>>  begin                                                             34726000
<<>>    return'status := invalid'request;                               34728000
<<>>    transfer'log := 0;                                              34730000
<<>>  end;                                                              34732000
<<>>                                                                    34734000
<< --------------------------------------------------------- >>         34736000
                                                                        34738000
                                                                        34740000
                                                                        34742000
                                                                        34744000
<< ----- read data -- function = 0 ---------------------[ 1] >>         34746000
<<>>                                                                    34748000
<<>>  begin                                                             34750000
<<>>                                                                    34752000
<<>>    return'information :=                                           34754000
<<>>        b08'read'data( cb'info,                                     34756000
<<>>                       dst'num,                                     34758000
<<>>                       address,                                     34760000
<<>>                       count,                                       34762000
<<>>                       parm1,                                       34764000
<<>>                       parm2,                                       34766000
<<>>                       flags     );                                 34768000
<<>>                                                                    34770000
<<>>  end;                                                              34772000
<<>>                                                                    34774000
<< --------------------------------------------------------- >>         34776000
                                                                        34778000
                                                                        34780000
                                                                        34782000
                                                                        34784000
<< ----- write data -- function = 1 --------------------[ 2] >>         34786000
<<>>                                                                    34788000
<<>>  begin                                                             34790000
<<>>                                                                    34792000
<<>>    return'information :=                                           34794000
<<>>        b08'write'data(cb'info,                                     34796000
<<>>                       dst'num,                                     34798000
<<>>                       address,                                     34800000
<<>>                       function,                                    34802000
<<>>                       count,                                       34804000
<<>>                       parm1,                                       34806000
<<>>                       parm2,                                       34808000
<<>>                       flags,                                       34810000
<<>>                       user'data'with'mask,                         34812000
<<>>                       cb'info(expanded'features),                  34814000
<<>>                       translate                    );              34816000
<<>>                                                                    34818000
<<>>  end;                                                              34820000
<<>>                                                                    34822000
<< --------------------------------------------------------- >>         34824000
                                                                        34826000
                                                                        34828000
                                                                        34830000
                                                                        34832000
<< ----- file'open -- function = 2 ---------------------[ 3] >>         34834000
<<>>                                                                    34836000
<<>>  begin                                                             34838000
<<>>                                                                    34840000
<<>>    return'information := b08'file'open( cb'info );                 34842000
<<>>                                                                    34844000
<<>>  end;                                                              34846000
<<>>                                                                    34848000
<< --------------------------------------------------------- >>         34850000
                                                                        34852000
                                                                        34854000
                                                                        34856000
                                                                        34858000
<< ----- file'close -- function = 3 --------------------[ 4] >>         34860000
<<>>                                                                    34862000
<<>>  begin                                                             34864000
<<>>                                                                    34866000
<<>>    return'information :=                                           34868000
<<>>        b08'write'data( cb'info,                                    34870000
<<>>                        0,                                          34872000
<<>>                        0,                                          34874000
<<>>                        function,                                   34876000
<<>>                        0,                                          34878000
<<>>                        parm1,                                      34880000
<<>>                        parm2,                                      34882000
<<>>                        flags,                                      34884000
<<>>                        user'data'with'mask,                        34886000
<<>>                        true,                                       34888000
<<>>                        translate                  );               34890000
<<>>                                                                    34892000
<<>>    if return'status = no'errors then                               34894000
<<>>      begin                                                         34896000
<<>>                                                                    34898000
<<>>        b08'network'protocol( control'table,                        34900000
<<>>                              transport'close,                      34902000
<<>>                              0,                                    34904000
<<>>                              0,                                    34906000
<<>>                              cb'info(ciper'dst),                   34908000
<<>>                              ldev                );                34910000
<<>>                                                                    34912000
<<>>      end;                                                          34914000
<<>>                                                                    34916000
<<>>    cb'info(file'open'count) := cb'info(file'open'count)            34918000
<<>>                              - 1;                                  34920000
<<>>                                                                    34922000
<<>>    transfer'log := count;                                          34924000
<<>>                                                                    34926000
<<>>  end;                                                              34928000
<<>>                                                                    34930000
<< --------------------------------------------------------- >>         34932000
                                                                        34934000
                                                                        34936000
                                                                        34938000
                                                                        34940000
<< ----- device close -- function = 4 ------------------[ 5] >>         34942000
<<>>                                                                    34944000
<<>>  begin                                                             34946000
<<>>                                                                    34948000
<<>>    return'information := b08'device'close(cb'info);                34950000
<<>>                                                                    34952000
<<>>  end;                                                              34954000
<<>>                                                                    34956000
<< --------------------------------------------------------- >>         34958000
                                                                        34960000
                                                                        34962000
                                                                        34964000
                                                                        34966000
<< ----- device status immediate -- function = 15 ------[ 6] >>         34968000
<<>>                                                                    34970000
<<>>  begin                                                             34972000
<<>>                                                                    34974000
<<>>    return'information :=                                           34976000
<<>>        b08'buf'device'status( cb'info                              34978000
<<>>                              ,dst'num                              34980000
<<>>                              ,address                              34982000
<<>>                              ,count                                34984000
<<>>                              ,immediate );                         34986000
<<>>                                                                    34988000
<<>>  end;                                                              34990000
<<>>                                                                    34992000
<< --------------------------------------------------------- >>         34994000
                                                                        34996000
                                                                        34998000
                                                                        35000000
                                                                        35002000
<< ----- vfu download -- function = 64 -----------------[ 7] >>         35004000
<<>>                                                                    35006000
<<>>  begin                                                             35008000
<<>>                                                                    35010000
<<>>    return'information :=                                           35012000
<<>>        b08'write'data( cb'info,                                    35014000
<<>>                        dst'num,                                    35016000
<<>>                        address,                                    35018000
<<>>                        function,                                   35020000
<<>>                        count,                                      35022000
<<>>                        parm1,                                      35024000
<<>>                        parm2,                                      35026000
<<>>                        flags,                                      35028000
<<>>                        user'data'with'mask,                        35030000
<<>>                        true,                                       35032000
<<>>                        translate            );                     35034000
<<>>                                                                    35036000
<<>>  end;                                                              35038000
<<>>                                                                    35040000
<< --------------------------------------------------------- >>         35042000
                                                                        35044000
                                                                        35046000
                                                                        35048000
                                                                        35050000
<< ----- set left margin -- function = 65 --------------[ 8] >>         35052000
<<>>                                                                    35054000
<<>>  begin                                                             35056000
<<>>                                                                    35058000
<<>>    return'information :=                                           35060000
<<>>        b08'write'data(cb'info,                                     35062000
<<>>                       dst'num,                                     35064000
<<>>                       address,                                     35066000
<<>>                       function,                                    35068000
<<>>                       0, << count >>                               35070000
<<>>                       parm1,                                       35072000
<<>>                       parm2,                                       35074000
<<>>                       flags,                                       35076000
<<>>                       user'data'with'mask,                         35078000
<<>>                       true,                                        35080000
<<>>                       translate                    );              35082000
<<>>                                                                    35084000
<<>>  end;                                                              35086000
<<>>                                                                    35088000
<< --------------------------------------------------------- >>         35090000
                                                                        35092000
                                                                        35094000
                                                                        35096000
                                                                        35098000
<< ----- buffered device status -- function = 71 -------[ 9] >>         35100000
<<>>                                                                    35102000
<<>>  begin                                                             35104000
<<>>                                                                    35106000
<<>>    return'information :=                                           35108000
<<>>        b08'buf'device'status( cb'info,                             35110000
<<>>                               dst'num,                             35112000
<<>>                               address,                             35114000
<<>>                               count,                               35116000
<<>>                               buffered   );                        35118000
<<>>                                                                    35120000
<<>>  end;                                                              35122000
<<>>                                                                    35124000
<< --------------------------------------------------------- >>         35126000
                                                                        35128000
                                                                        35130000
                                                                        35132000
                                                                        35134000
<< ----- initiate self test -- function 73 -------------[10] >>         35136000
<<>>                                                                    35138000
<<>>  begin                                                             35140000
<<>>                                                                    35142000
<<>>    return'information :=                                           35144000
<<>>        b08'write'data(cb'info,                                     35146000
<<>>                       dst'num,                                     35148000
<<>>                       address,                                     35150000
<<>>                       function,                                    35152000
<<>>                       0, << count >>                               35154000
<<>>                       parm1,                                       35156000
<<>>                       parm2,                                       35158000
<<>>                       flags,                                       35160000
<<>>                       user'data'with'mask,                         35162000
<<>>                       true,                                        35164000
<<>>                       translate                    );              35166000
<<>>                                                                    35168000
<<>>  end;                                                              35170000
<<>>                                                                    35172000
<< --------------------------------------------------------- >>         35174000
                                                                        35176000
                                                                        35178000
                                                                        35180000
                                                                        35182000
<< ----- select character set -- function = 128 --------[11] >>         35184000
<<>>                                                                    35186000
<<>>  begin                                                             35188000
<<>>                                                                    35190000
<<>>    return'information :=                                           35192000
<<>>        b08'write'data(cb'info,                                     35194000
<<>>                       dst'num,                                     35196000
<<>>                       address,                                     35198000
<<>>                       function,                                    35200000
<<>>                       0, << count >>                               35202000
<<>>                       parm1,                                       35204000
<<>>                       parm2,                                       35206000
<<>>                       flags,                                       35208000
<<>>                       user'data'with'mask,                         35210000
<<>>                       true,                                        35212000
<<>>                       translate                    );              35214000
<<>>                                                                    35216000
<<>>  end;                                                              35218000
<<>>                                                                    35220000
<< --------------------------------------------------------- >>         35222000
                                                                        35224000
                                                                        35226000
                                                                        35228000
                                                                        35230000
<< ----- define physical page length -- function = 133 -[12] >>         35232000
<<>>                                                                    35234000
<<>>  begin                                                             35236000
<<>>                                                                    35238000
<<>>    return'information :=                                           35240000
<<>>        b08'write'data(cb'info,                                     35242000
<<>>                       dst'num,                                     35244000
<<>>                       address,                                     35246000
<<>>                       function,                                    35248000
<<>>                       0, << count >>                               35250000
<<>>                       parm1,                                       35252000
<<>>                       parm2,                                       35254000
<<>>                       flags,                                       35256000
<<>>                       user'data'with'mask,                         35258000
<<>>                       true,                                        35260000
<<>>                       translate                    );              35262000
<<>>                                                                    35264000
<<>>  end;                                                              35266000
<<>>                                                                    35268000
<< --------------------------------------------------------- >>         35270000
                                                                        35272000
                                                                        35274000
                                                                        35276000
                                                                        35278000
<< ----- page control -- function = 140 ----------------[13] >>         35280000
<<>>                                                                    35282000
<<>>  begin                                                             35284000
<<>>                                                                    35286000
<<>>    return'information :=                                           35288000
<<>>        b08'write'data(cb'info,                                     35290000
<<>>                       dst'num,                                     35292000
<<>>                       address,                                     35294000
<<>>                       function,                                    35296000
<<>>                       0, << count >>                               35298000
<<>>                       parm1,                                       35300000
<<>>                       parm2,                                       35302000
<<>>                       flags,                                       35304000
<<>>                       user'data'with'mask,                         35306000
<<>>                       true,                                        35308000
<<>>                       translate                    );              35310000
<<>>                                                                    35312000
<<>>  end;                                                              35314000
<<>>                                                                    35316000
<< --------------------------------------------------------- >>         35318000
                                                                        35320000
                                                                        35322000
                                                                        35324000
                                                                        35326000
<< ----- clear environment -- function = 141 -----------[14] >>         35328000
<<>>                                                                    35330000
<<>>  begin                                                             35332000
<<>>                                                                    35334000
<<>>    return'information :=                                           35336000
<<>>        b08'write'data(cb'info,                                     35338000
<<>>                       dst'num,                                     35340000
<<>>                       address,                                     35342000
<<>>                       function,                                    35344000
<<>>                       0, << count >>                               35346000
<<>>                       parm1,                                       35348000
<<>>                       parm2,                                       35350000
<<>>                       flags,                                       35352000
<<>>                       user'data'with'mask,                         35354000
<<>>                       true,                                        35356000
<<>>                       translate                    );              35358000
<<>>                                                                    35360000
<<>>  end;                                                              35362000
<<>>                                                                    35364000
<< --------------------------------------------------------- >>         35366000
                                                                        35368000
                                                                        35370000
                                                                        35372000
                                                                        35374000
<< ----- start job -- function = 142 -------------------[15] >>         35376000
<<>>                                                                    35378000
<<>>  begin                                                             35380000
<<>>    return'information := b08'start'job(cb'info, parm1);            35382000
<<>>                                                                    35384000
<<>>    transfer'log := 0;                                              35386000
<<>>  end;                                                              35388000
<<>>                                                                    35390000
<< --------------------------------------------------------- >>         35392000
                                                                        35394000
                                                                        35396000
                                                                        35398000
                                                                        35400000
<< ----- load default environment -- function = 143 ----[16] >>         35402000
<<>>                                                                    35404000
<<>>  begin                                                             35406000
<<>>                                                                    35408000
<<>>    return'information :=                                           35410000
<<>>        b08'write'data(cb'info,                                     35412000
<<>>                       dst'num,                                     35414000
<<>>                       address,                                     35416000
<<>>                       function,                                    35418000
<<>>                       0, << count >>                               35420000
<<>>                       parm1,                                       35422000
<<>>                       parm2,                                       35424000
<<>>                       flags,                                       35426000
<<>>                       user'data'with'mask,                         35428000
<<>>                       true,                                        35430000
<<>>                       translate                    );              35432000
<<>>                                                                    35434000
<<>>  end;                                                              35436000
<<>>                                                                    35438000
<< --------------------------------------------------------- >>         35440000
                                                                        35442000
                                                                        35444000
                                                                        35446000
                                                                        35448000
<< ----- function = 144 (not supported) ----------------[17] >>         35450000
                                                                        35452000
      begin                                                             35454000
                                                                        35456000
$IF X9=ON  << ON = DEBUG MODE >>                                        35458000
                                                                        35460000
        << Download debug info to terminal softkeys >>                  35462000
        b08'debug'softkeys(cb'info);                                    35464000
                                                                        35466000
                                                                        35468000
$IF X9=OFF  << OFF = NO DEBUG >>                                        35470000
                                                                        35472000
        return'status := invalid'request;                               35474000
        transfer'log := 0;                                              35476000
                                                                        35478000
$IF                                                                     35480000
      end;                                                              35482000
<<>>                                                                    35484000
<< --------------------------------------------------------- >>         35486000
                                                                        35488000
                                                                        35490000
                                                                        35492000
                                                                        35494000
<< ----- end of job -- function = 145 ------------------[18] >>         35496000
<<>>                                                                    35498000
<<>>  begin                                                             35500000
<<>>                                                                    35502000
<<>>    return'information :=                                           35504000
<<>>        b08'end'job( cb'info,                                       35506000
<<>>                     dst'num,                                       35508000
<<>>                     address,                                       35510000
<<>>                     count,                                         35512000
<<>>                     flags     );                                   35514000
<<>>                                                                    35516000
<<>>  end;                                                              35518000
<<>>                                                                    35520000
<< --------------------------------------------------------- >>         35522000
                                                                        35524000
                                                                        35526000
                                                                        35528000
                                                                        35530000
<< ----- used for any in range of 128 - 192 that are  --[19] >>         35532000
<<       not implemented for this driver.  This allows       >>         35534000
<<       spool files created for a 2680A to be printed       >>         35536000
<<       on a 2608S if necessary.                            >>         35538000
<<>>                                                                    35540000
<<>>  begin                                                             35542000
<<>>                                                                    35544000
<<>>    return'status := successful;                                    35546000
<<>>    transfer'log := count;                                          35548000
<<>>                                                                    35550000
<<>>  end;                                                              35552000
<<>>                                                                    35554000
<< --------------------------------------------------------- >>         35556000
                                                                        35558000
                                                                        35560000
                                                                        35562000
                                                                        35564000
<< ----- device clear -- function = 189 ----------------[20] >>         35566000
<<>>                                                                    35568000
<<>>  begin                                                             35570000
<<>>    return'status := b08'device'clear(cb'info,parm1);               35572000
<<>>                                                                    35574000
<<>>    transfer'log := 0;                                              35576000
<<>>  end;                                                              35578000
<<>>                                                                    35580000
<< --------------------------------------------------------- >>         35582000
                                                                        35584000
                                                                        35586000
                                                                        35588000
                                                                        35590000
<< ----- begin silent run -- function = 190 ------------[21] >>         35592000
<<>>                                                                    35594000
<<>>  begin                                                             35596000
<<>>                                                                    35598000
<<>>    return'information :=                                           35600000
<<>>        b08'silent'run( cb'info,                                    35602000
<<>>                        dst'num,                                    35604000
<<>>                        address,                                    35606000
<<>>                        count,                                      35608000
<<>>                        flags     );                                35610000
<<>>                                                                    35612000
<<>>  end;                                                              35614000
<<>>                                                                    35616000
<< --------------------------------------------------------- >>         35618000
                                                                        35620000
                                                                        35622000
                                                                        35624000
                                                                        35626000
<< ----- get environment status -- function 191 --------[22] >>         35628000
<<>>                                                                    35630000
<<>>  begin                                                             35632000
<<>>                                                                    35634000
<<>>    return'information :=                                           35636000
<<>>      b08'buffered'env'status( cb'info,                             35638000
<<>>                               dst'num,                             35640000
<<>>                               address,                             35642000
<<>>                               count,                               35644000
<<>>                               buffered    );                       35646000
<<>>                                                                    35648000
<<>>  end;                                                              35650000
<<>>                                                                    35652000
<< --------------------------------------------------------- >>         35654000
                                                                        35656000
                                                                        35658000
                                                                        35660000
                                                                        35662000
<< ----- expanded features -- function = 146 -----------[23] >>         35664000
<<>>                                                                    35666000
<<>>  begin                                                             35668000
<<>>                                                                    35670000
<<>>    return'status :=                                                35672000
<<>>        b08'set'ext'mode( cb'info,                                  35674000
<<>>                          parm1     );                              35676000
<<>>                                                                    35678000
<<>>    transfer'log := 0;                                              35680000
<<>>                                                                    35682000
<<>>  end;                                                              35684000
<<>>                                                                    35686000
<< --------------------------------------------------------- >>         35688000
                                                                        35690000
                                                                        35692000
                                                                        35694000
                                                                        35696000
<< ----- start of block -- function = 147 --------------[24] >>         35698000
<<>>                                                                    35700000
<<>>  begin                                                             35702000
<<>>                                                                    35704000
<<>>    return'information :=                                           35706000
<<>>        b08'start'block( cb'info,                                   35708000
<<>>                         parm1,                                     35710000
<<>>                         parm2    );                                35712000
<<>>                                                                    35714000
<<>>    transfer'log := 0;                                              35716000
<<>>                                                                    35718000
<<>>  end;                                                              35720000
<<>>                                                                    35722000
<< --------------------------------------------------------- >>         35724000
                                                                        35726000
                                                                        35728000
                                                                        35730000
                                                                        35732000
<< ----- end of block -- function = 148 ----------------[25] >>         35734000
<<>>                                                                    35736000
<<>>  begin                                                             35738000
<<>>                                                                    35740000
<<>>    return'information :=                                           35742000
<<>>        b08'end'block( cb'info );                                   35744000
<<>>                                                                    35746000
<<>>  end;                                                              35748000
<<>>                                                                    35750000
<< --------------------------------------------------------- >>         35752000
                                                                        35754000
                                                                        35756000
                                                                        35758000
                                                                        35760000
<< ----- Return status types -- function = 187 ---------[26] >>         35762000
<<>>                                                                    35764000
<<>>  begin                                                             35766000
<<>>                                                                    35768000
<<>>    return'information :=                                           35770000
<<>>        b08'available'status( cb'info,                              35772000
<<>>                              dst'num,                              35774000
<<>>                              address,                              35776000
<<>>                              count    );                           35778000
<<>>                                                                    35780000
<<>>  end;                                                              35782000
<<>>                                                                    35784000
<< --------------------------------------------------------- >>         35786000
                                                                        35788000
                                                                        35790000
                                                                        35792000
                                                                        35794000
<< ----- Set status types -- function = 188 ------------[27] >>         35796000
<<>>                                                                    35798000
<<>>  begin                                                             35800000
<<>>                                                                    35802000
<<>>    return'information :=                                           35804000
<<>>        b08'set'status'types( cb'info,                              35806000
<<>>                              dst'num,                              35808000
<<>>                              address,                              35810000
<<>>                              count,                                35812000
<<>>                              parm1    );                           35814000
<<>>                                                                    35816000
<<>>  end;                                                              35818000
<<>>                                                                    35820000
<< --------------------------------------------------------- >>         35822000
                                                                        35824000
                                                                        35826000
                                                                        35828000
                                                                        35830000
<< ----- Control mask -- function = 185 ----------------[28] >>         35832000
<<>>                                                                    35834000
<<>>  begin                                                             35836000
<<>>                                                                    35838000
<<>>    return'information :=                                           35840000
<<>>        b08'control'mask( cb'info,                                  35842000
<<>>                          dst'num,                                  35844000
<<>>                          address,                                  35846000
<<>>                          count,                                    35848000
<<>>                          flags    );                               35850000
<<>>                                                                    35852000
<<>>  end;                                                              35854000
<<>>                                                                    35856000
<< --------------------------------------------------------- >>         35858000
                                                                        35860000
                                                                        35862000
                                                                        35864000
                                                                        35866000
<< ----- Job report immediate -- function = 186 --------[29] >><<04422>>35868000
<<>>                                                                    35870000
<<>>  begin                                                             35872000
<<>>                                                                    35874000
<<>>    return'information :=                                           35876000
<<>>        b08'return'job'report( cb'info,                             35878000
<<>>                               dst'num,                             35880000
<<>>                               address,                             35882000
<<>>                               count,                               35884000
<<>>                               immediate  );               <<04422>>35886000
<<>>                                                                    35888000
<<>>  end;                                                              35890000
<<>>                                                                    35892000
<< --------------------------------------------------------- >>         35894000
                                                                        35896000
                                                                        35898000
                                                                        35900000
                                                                        35902000
<< ----- Flush out buffers - function = 182 ------------[30] >>         35904000
<<>>                                                                    35906000
<<>>  begin                                                             35908000
<<>>                                                                    35910000
<<>>    return'status := b08'flush'out'buffers( cb'info );              35912000
<<>>    transfer'log := 0;                                              35914000
<<>>                                                                    35916000
<<>>  end;                                                              35918000
<<>>                                                                    35920000
<< --------------------------------------------------------- >>         35922000
                                                                        35924000
                                                                        35926000
                                                                        35928000
                                                                        35930000
<< ----- Erase buffers -- function = 182 ---------------[31] >>         35932000
<<>>                                                                    35934000
<<>>  begin                                                             35936000
<<>>                                                                    35938000
<<>>    return'status := b08'erase'buffers( cb'info );                  35940000
<<>>    transfer'log := 0;                                              35942000
<<>>                                                                    35944000
<<>>  end;                                                              35946000
<<>>                                                                    35948000
<< --------------------------------------------------------- >>         35950000
                                                                        35952000
                                                                        35954000
                                                                        35956000
                                                                        35958000
<< ----- set record length -- function = 255 -----------[32] >>         35960000
<<>>                                                                    35962000
<<>>  begin                                                             35964000
<<>>                                                                    35966000
$IF X9 = ON  << INCLUDE DEBUGGING CODE >>                               35968000
<<>>                                                                    35970000
<<>>    return'information :=                                           35972000
<<>>        b08'set'rec'length( cb'info, parm1 );                       35974000
<<>>                                                                    35976000
$IF X9 = OFF  << DON'T INCLUDE DEBUGGING CODE >>                        35978000
<<>>                                                                    35980000
<<>>    return'status := invalid'function;                              35982000
<<>>                                                                    35984000
$IF                                                                     35986000
<<>>                                                                    35988000
<<>>  end;                                                              35990000
<<>>                                                                    35992000
<< --------------------------------------------------------- >>         35994000
                                                                        35996000
                                                                        35998000
                                                                        36000000
                                                                        36002000
<< ----- test CIPER shutdown -- function = 254 ---------[33] >>         36004000
<<>>                                                                    36006000
<<>>  begin                                                             36008000
<<>>                                                                    36010000
$IF X9 = ON  << INCLUDE DEBUGGING CODE >>                               36012000
<<>>                                                                    36014000
<<>>    return'information :=                                           36016000
<<>>        cpr'test'shutdown( 1, parm1 );                              36018000
<<>>                                                                    36020000
$IF X9 = OFF   << DON'T INCLUDE DEBUGGING CODE >>                       36022000
<<>>                                                                    36024000
<<>>    return'status := invalid'function;                              36026000
<<>>                                                                    36028000
$IF                                                                     36030000
<<>>  end;                                                              36032000
<<>>                                                                    36034000
<< --------------------------------------------------------- >>         36036000
                                                                        36038000
                                                                        36040000
                                                                        36042000
                                                                        36044000
<< ----- environment status immediate -- function = 180 [34] >>         36046000
<<>>                                                                    36048000
<<>>  begin                                                             36050000
<<>>                                                                    36052000
<<>>    return'information :=                                           36054000
<<>>        b08'buffered'env'status( cb'info                            36056000
<<>>                                ,dst'num                            36058000
<<>>                                ,address                            36060000
<<>>                                ,count                              36062000
<<>>                                ,immediate  );                      36064000
<<>>                                                                    36066000
<<>>  end;                                                              36068000
<<>>                                                                    36070000
<< --------------------------------------------------------- >>         36072000
                                                                        36074000
                                                                        36076000
                                                                        36078000
                                                                        36080000
<< ----- device status composite -- function = 181 -----[35] >>         36082000
<<>>                                                                    36084000
<<>>  begin                                                             36086000
<<>>                                                                    36088000
<<>>    return'information :=                                           36090000
<<>>        b08'buf'device'status( cb'info                              36092000
<<>>                              ,dst'num                              36094000
<<>>                              ,address                              36096000
<<>>                              ,count                                36098000
<<>>                              ,composite  );                        36100000
<<>>                                                                    36102000
<<>>  end;                                                              36104000
<<>>                                                                    36106000
<< --------------------------------------------------------- >>         36108000
                                                               <<04422>>36110000
                                                               <<04422>>36112000
                                                               <<04422>>36114000
                                                               <<04422>>36116000
<< ----- job report buffered -- function = 179 ---------[36] >><<04422>>36118000
<<>>                                                           <<04422>>36120000
<<>>  begin                                                    <<04422>>36122000
<<>>                                                           <<04422>>36124000
<<>>    return'information :=                                  <<04422>>36126000
<<>>        b08'return'job'report( cb'info                     <<04422>>36128000
<<>>                              ,dst'num                     <<04422>>36130000
<<>>                              ,address                     <<04422>>36132000
<<>>                              ,count                       <<04422>>36134000
<<>>                              ,buffered  );                <<04422>>36136000
<<>>                                                           <<04422>>36138000
<<>>  end;                                                     <<04422>>36140000
<<>>                                                           <<04422>>36142000
<< --------------------------------------------------------- >><<04422>>36144000
                                                                        36146000
                                                                        36148000
                                                                        36150000
                                                                        36152000
    end;  << of case compressed'function >>                             36154000
                                                                        36156000
                                                                        36158000
  exit'label:                                                           36160000
                                                                        36162000
  << Set up the function return value >>                                36164000
  set'status'for'return;                                                36166000
                                                               <<04422>>36168000
  resetcritical( saved'critical'value );                       <<04422>>36170000
                                                                        36172000
end;  << B08'LOGICAL'DVR >>                                             36174000
                                                                        36176000
$PAGE "GLOBAL SYMBOL TABLE"                                             36178000
$PAGE                                                                   36180000
$CONTROL SEGMENT= MAIN                                                  36182000
END.  << of module Softio (61) >>                                       36184000
